1 package Module::ScanDeps;
5 use vars qw( $VERSION @EXPORT @EXPORT_OK $CurrentPackage );
8 @EXPORT = qw( scan_deps scan_deps_runtime );
9 @EXPORT_OK = qw( scan_line scan_chunk add_deps scan_deps_runtime );
14 use constant dl_ext => ".$Config{dlext}";
15 use constant lib_ext => $Config{lib_ext};
16 use constant is_insensitive_fs => (
18 and (-s lc($0) || -1) == (-s uc($0) || -1)
19 and (-s lc($0) || -1) == -s $0
25 use File::Basename ();
30 Module::ScanDeps - Recursively scan Perl code for dependencies
34 This document describes version 0.61 of Module::ScanDeps, released
39 Via the command-line program L<scandeps.pl>:
41 % scandeps.pl *.pm # Print PREREQ_PM section for *.pm
42 % scandeps.pl -e "use utf8" # Read script from command line
43 % scandeps.pl -B *.pm # Include core modules
44 % scandeps.pl -V *.pm # Show autoload/shared/data files
51 my $hash_ref = scan_deps(
52 files => [ 'a.pl', 'b.pl' ],
56 # shorthand; assume recurse == 1
57 my $hash_ref = scan_deps( 'a.pl', 'b.pl' );
59 # App::Packer::Frontend compatible interface
60 # see App::Packer::Frontend for the structure returned by get_files
61 my $scan = Module::ScanDeps->new;
62 $scan->set_file( 'a.pl' );
63 $scan->set_options( add_modules => [ 'Test::More' ] );
64 $scan->calculate_info;
65 my $files = $scan->get_files;
69 This module scans potential modules used by perl programs, and returns a
70 hash reference; its keys are the module names as appears in C<%INC>
71 (e.g. C<Test/More.pm>); the values are hash references with this structure:
74 file => '/usr/local/lib/perl5/5.8.0/Test/More.pm',
75 key => 'Test/More.pm',
76 type => 'module', # or 'autoload', 'data', 'shared'
77 used_by => [ 'Test/Simple.pm', ... ],
80 One function, C<scan_deps>, is exported by default. Three other
81 functions (C<scan_line>, C<scan_chunk>, C<add_deps>) are exported upon
84 Users of B<App::Packer> may also use this module as the dependency-checking
85 frontend, by tweaking their F<p2e.pl> like below:
89 my $packer = App::Packer->new( frontend => 'Module::ScanDeps' );
92 Please see L<App::Packer::Frontend> for detailed explanation on
93 the structure returned by C<get_files>.
98 files => \@files, recurse => $recurse,
99 rv => \%rv, skip => \%skip,
100 compile => $compile, execute => $execute,
102 $rv_ref = scan_deps(@files); # shorthand, with recurse => 1
104 This function scans each file in C<@files>, registering their
105 dependencies into C<%rv>, and returns a reference to the updated
106 C<%rv>. The meaning of keys and values are explained above.
108 If C<$recurse> is true, C<scan_deps> will call itself recursively,
109 to perform a breadth-first search on text files (as defined by the
110 -T operator) found in C<%rv>.
112 If the C<\%skip> is specified, files that exists as its keys are
113 skipped. This is used internally to avoid infinite recursion.
115 If C<$compile> or C<$execute> is true, runs C<files> in either
116 compile-only or normal mode, then inspects their C<%INC> after
117 termination to determine additional runtime dependencies.
119 If C<$execute> is an array reference, runs the files contained
120 in it instead of C<@files>.
122 =head2 B<scan_deps_runtime>
124 Like B<scan_deps>, but skips the static scanning part.
128 @modules = scan_line($line);
130 Splits a line into chunks (currently with the semicolon characters), and
131 return the union of C<scan_chunk> calls of them.
133 If the line is C<__END__> or C<__DATA__>, a single C<__END__> element is
134 returned to signify the end of the program.
136 Similarly, it returns a single C<__POD__> if the line matches C</^=\w/>;
137 the caller is responsible for skipping appropriate number of lines
138 until C<=cut>, before calling C<scan_line> again.
142 $module = scan_chunk($chunk);
143 @modules = scan_chunk($chunk);
145 Apply various heuristics to C<$chunk> to find and return the module
146 name(s) it contains. In scalar context, returns only the first module
151 $rv_ref = add_deps( rv => \%rv, modules => \@modules );
152 $rv_ref = add_deps( @modules ); # shorthand, without rv
154 Resolves a list of module names to its actual on-disk location, by
155 finding in C<@INC>; modules that cannot be found are skipped.
157 This function populates the C<%rv> hash with module/filename pairs, and
158 returns a reference to it.
162 This module intentially ignores the B<BSDPAN> hack on FreeBSD -- the
163 additional directory is removed from C<@INC> altogether.
165 The static-scanning heuristic is not likely to be 100% accurate, especially
166 on modules that dynamically load other modules.
168 Chunks that span multiple lines are not handled correctly. For example,
173 But this one does not:
182 # Pre-loaded module dependencies {{{
184 'AnyDBM_File.pm' => [qw( SDBM_File.pm )],
185 'Authen/SASL.pm' => 'sub',
186 'Bio/AlignIO.pm' => 'sub',
187 'Bio/Assembly/IO.pm' => 'sub',
188 'Bio/Biblio/IO.pm' => 'sub',
189 'Bio/ClusterIO.pm' => 'sub',
190 'Bio/CodonUsage/IO.pm' => 'sub',
191 'Bio/DB/Biblio.pm' => 'sub',
192 'Bio/DB/Flat.pm' => 'sub',
193 'Bio/DB/GFF.pm' => 'sub',
194 'Bio/DB/Taxonomy.pm' => 'sub',
195 'Bio/Graphics/Glyph.pm' => 'sub',
196 'Bio/MapIO.pm' => 'sub',
197 'Bio/Matrix/IO.pm' => 'sub',
198 'Bio/Matrix/PSM/IO.pm' => 'sub',
199 'Bio/OntologyIO.pm' => 'sub',
200 'Bio/PopGen/IO.pm' => 'sub',
201 'Bio/Restriction/IO.pm' => 'sub',
202 'Bio/Root/IO.pm' => 'sub',
203 'Bio/SearchIO.pm' => 'sub',
204 'Bio/SeqIO.pm' => 'sub',
205 'Bio/Structure/IO.pm' => 'sub',
206 'Bio/TreeIO.pm' => 'sub',
207 'Bio/LiveSeq/IO.pm' => 'sub',
208 'Bio/Variation/IO.pm' => 'sub',
209 'Crypt/Random.pm' => sub {
210 _glob_in_inc('Crypt/Random/Provider', 1);
212 'Crypt/Random/Generator.pm' => sub {
213 _glob_in_inc('Crypt/Random/Provider', 1);
216 grep !/\bProxy\b/, _glob_in_inc('DBD', 1);
218 'DBIx/SearchBuilder.pm' => 'sub',
219 'DBIx/ReportBuilder.pm' => 'sub',
220 'Device/ParallelPort.pm' => 'sub',
221 'Device/SerialPort.pm' => [ qw(
222 termios.ph asm/termios.ph sys/termiox.ph sys/termios.ph sys/ttycom.ph
224 'ExtUtils/MakeMaker.pm' => sub {
225 grep /\bMM_/, _glob_in_inc('ExtUtils', 1);
227 'File/Basename.pm' => [qw( re.pm )],
228 'File/Spec.pm' => sub {
230 map { my $name = $_; $name =~ s!::!/!g; "$name.pm" } @File::Spec::ISA;
232 'HTTP/Message.pm' => [ qw(
236 IO/Handle.pm IO/Seekable.pm IO/File.pm
237 IO/Pipe.pm IO/Socket.pm IO/Dir.pm
239 'IO/Socket.pm' => [qw( IO/Socket/UNIX.pm )],
240 'LWP/UserAgent.pm' => [ qw(
241 URI/URL.pm URI/http.pm LWP/Protocol/http.pm
242 LWP/Protocol/https.pm
243 ), _glob_in_inc("LWP/Authen", 1) ],
244 'Locale/Maketext/Lexicon.pm' => 'sub',
245 'Locale/Maketext/GutsLoader.pm' => [qw( Locale/Maketext/Guts.pm )],
246 'Mail/Audit.pm' => 'sub',
247 'Math/BigInt.pm' => 'sub',
248 'Math/BigFloat.pm' => 'sub',
249 'Math/Symbolic.pm' => 'sub',
250 'Module/Build.pm' => 'sub',
251 'Module/Pluggable.pm' => sub {
252 _glob_in_inc('$CurrentPackage/Plugin', 1);
254 'MIME/Decoder.pm' => 'sub',
255 'Net/DNS/RR.pm' => 'sub',
256 'Net/FTP.pm' => 'sub',
257 'Net/SSH/Perl.pm' => 'sub',
258 'PDF/API2/Resource/Font.pm' => 'sub',
259 'PDF/API2/Basic/TTF/Font.pm' => sub {
260 _glob_in_inc('PDF/API2/Basic/TTF', 1);
262 'PDF/Writer.pm' => 'sub',
264 POE/Kernel.pm POE/Session.pm
267 map "POE/Resource/$_.pm", qw(
268 Aliases Events Extrefs FileHandles
269 SIDs Sessions Signals Statistics
272 'Parse/AFP.pm' => 'sub',
273 'Parse/Binary.pm' => 'sub',
274 'Regexp/Common.pm' => 'sub',
275 'SerialJunk.pm' => [ qw(
276 termios.ph asm/termios.ph sys/termiox.ph sys/termios.ph sys/ttycom.ph
278 'SOAP/Lite.pm' => sub {
279 (($] >= 5.008 ? ('utf8.pm') : ()), _glob_in_inc('SOAP/Transport', 1));
281 'SQL/Parser.pm' => sub {
282 _glob_in_inc('SQL/Dialects', 1);
284 'SVK/Command.pm' => sub {
285 _glob_in_inc('SVK', 1);
287 'SVN/Core.pm' => sub {
288 _glob_in_inc('SVN', 1),
289 map "auto/SVN/$_->{name}", _glob_in_inc('auto/SVN'),
291 'Template.pm' => 'sub',
292 'Term/ReadLine.pm' => 'sub',
293 'Test/Deep.pm' => 'sub',
296 qw( Tk/FileSelect.pm Encode/Unicode.pm );
298 'Tk/Balloon.pm' => [qw( Tk/balArrow.xbm )],
299 'Tk/BrowseEntry.pm' => [qw( Tk/cbxarrow.xbm Tk/arrowdownwin.xbm )],
300 'Tk/ColorEditor.pm' => [qw( Tk/ColorEdit.xpm )],
301 'Tk/DragDrop/Common.pm' => sub {
302 _glob_in_inc('Tk/DragDrop', 1),
304 'Tk/FBox.pm' => [qw( Tk/folder.xpm Tk/file.xpm )],
305 'Tk/Getopt.pm' => [qw( Tk/openfolder.xpm Tk/win.xbm )],
306 'Tk/Toplevel.pm' => [qw( Tk/Wm.pm )],
308 grep !/.\b[_A-Z]/, _glob_in_inc('URI', 1);
310 'Win32/EventLog.pm' => [qw( Win32/IPC.pm )],
311 'Win32/Exe.pm' => 'sub',
312 'Win32/TieRegistry.pm' => [qw( Win32API/Registry.pm )],
313 'Win32/SystemInfo.pm' => [qw( Win32/cpuspd.dll )],
314 'XML/Parser.pm' => sub {
315 _glob_in_inc('XML/Parser/Style', 1),
316 _glob_in_inc('XML/Parser/Encodings', 1),
318 'XML/Parser/Expat.pm' => sub {
319 ($] >= 5.008) ? ('utf8.pm') : ();
321 'XML/SAX.pm' => [qw( XML/SAX/ParserDetails.ini ) ],
322 'XMLRPC/Lite.pm' => sub {
323 _glob_in_inc('XMLRPC/Transport', 1),;
325 'diagnostics.pm' => sub {
326 # shamelessly taken and adapted from diagnostics.pm
328 my($privlib, $archlib) = @Config{qw(privlibexp archlibexp)};
330 require VMS::Filespec;
331 $privlib = VMS::Filespec::unixify($privlib);
332 $archlib = VMS::Filespec::unixify($archlib);
338 "pod/perldiag-$Config{version}.pod",
339 "Pod/perldiag-$Config{version}.pod",
341 "pods/perldiag-$Config{version}.pod",
343 return $_ if _find_in_inc($_);
347 "$archlib/pods/perldiag.pod",
348 "$privlib/pods/perldiag-$Config{version}.pod",
349 "$privlib/pods/perldiag.pod",
354 return 'pod/perldiag.pod';
357 'utf8_heavy.pl', do {
359 my @subdirs = qw( To );
360 my @files = map "$dir/lib/$_->{name}", _glob_in_inc("$dir/lib");
364 push @files, (map "$dir/$_.pl", qw( Exact Canonical ));
369 @files = map "$dir/Is/$_->{name}", _glob_in_inc("$dir/Is")
374 foreach my $subdir (@subdirs) {
375 foreach (_glob_in_inc("$dir/$subdir")) {
376 push @files, "$dir/$subdir/$_->{name}";
383 _find_in_inc('unicore/Name.pl') ? 'unicore/Name.pl' : 'unicode/Name.pl'
389 my $Keys = 'files|keys|recurse|rv|skip|first|execute|compile';
393 (@_ and $_[0] =~ /^(?:$Keys)$/o) ? @_ : (files => [@_], recurse => 1)
396 scan_deps_static(\%args);
398 if ($args{execute} or $args{compile}) {
401 files => $args{files},
402 execute => $args{execute},
403 compile => $args{compile},
411 sub scan_deps_static {
413 my ($files, $keys, $recurse, $rv, $skip, $first, $execute, $compile) =
414 @$args{qw( files keys recurse rv skip first execute compile )};
419 foreach my $file (@{$files}) {
420 my $key = shift @{$keys};
421 next if $skip->{$file}++;
422 next if is_insensitive_fs()
423 and $file ne lc($file) and $skip->{lc($file)}++;
426 open FH, $file or die "Cannot open $file: $!";
430 # Line-by-line scanning
433 chomp(my $line = $_);
434 foreach my $pm (scan_line($line)) {
435 last LINE if $pm eq '__END__';
437 if ($pm eq '__POD__') {
438 while (<FH>) { last if (/^=cut/) }
442 $pm = 'CGI/Apache.pm' if /^Apache(?:\.pm)$/;
451 my $preload = $Preload{$pm} or next;
452 if ($preload eq 'sub') {
453 $pm =~ s/\.p[mh]$//i;
454 $preload = [ _glob_in_inc($pm, 1) ];
456 elsif (UNIVERSAL::isa($preload, 'CODE')) {
457 $preload = [ $preload->($pm) ];
473 # Top-level recursion handling {{{
475 my $count = keys %$rv;
476 my @files = sort grep -T $_->{file}, values %$rv;
478 files => [ map $_->{file}, @files ],
479 keys => [ map $_->{key}, @files ],
483 }) or ($args->{_deep} and return);
484 last if $count == keys %$rv;
492 sub scan_deps_runtime {
496 (@_ and $_[0] =~ /^(?:$Keys)$/o) ? @_ : (files => [@_], recurse => 1)
498 my ($files, $rv, $execute, $compile, $skip, $perl) =
499 @args{qw( files rv execute compile skip perl )};
501 $files = (ref($files)) ? $files : [$files];
503 my ($inchash, $incarray, $dl_shared_objects) = ({}, [], []);
507 foreach $file (@$files) {
508 ($inchash, $dl_shared_objects, $incarray) = ({}, [], []);
509 _compile($perl, $file, $inchash, $dl_shared_objects, $incarray);
511 my $rv_sub = _make_rv($inchash, $dl_shared_objects, $incarray);
512 _merge_rv($rv_sub, $rv);
516 my $excarray = (ref($execute)) ? $execute : [@$files];
519 foreach $exc (@$excarray) {
520 ($inchash, $dl_shared_objects, $incarray) = ({}, [], []);
522 $perl, $exc, $inchash, $dl_shared_objects, $incarray,
528 my $rv_sub = _make_rv($inchash, $dl_shared_objects, $incarray);
529 _merge_rv($rv_sub, $rv);
539 return '__END__' if $line =~ /^__(?:END|DATA)__$/;
540 return '__POD__' if $line =~ /^=\w/;
542 $line =~ s/\s*#.*$//;
543 $line =~ s/[\\\/]+/\//g;
545 foreach (split(/;/, $line)) {
546 if (/^\s*package\s+(\w+)/) {
547 $CurrentPackage = $1;
548 $CurrentPackage =~ s{::}{/}g;
551 return if /^\s*(use|require)\s+[\d\._]+/;
552 if (my ($autouse) = /^\s*use\s+autouse\s+(["'].*?["']|\w+)/)
554 $autouse =~ s/["']//g;
555 $autouse =~ s{::}{/}g;
556 return ("autouse.pm", "$autouse.pm");
559 if (my ($libs) = /\b(?:use\s+lib\s+|(?:unshift|push)\W+\@INC\W+)(.+)/)
562 defined($Config{archname}) ? $Config{archname} : '';
563 my $ver = defined($Config{version}) ? $Config{version} : '';
564 foreach (grep(/\w/, split(/["';() ]/, $libs))) {
565 unshift(@INC, "$_/$ver") if -d "$_/$ver";
566 unshift(@INC, "$_/$archname") if -d "$_/$archname";
567 unshift(@INC, "$_/$ver/$archname") if -d "$_/$ver/$archname";
572 $found{$_}++ for scan_chunk($_);
575 return sort keys %found;
581 # Module name extraction heuristics {{{
586 map { s{::}{/}g; "$_.pm" }
587 grep { length and !/^q[qw]?$/ } split(/[^\w:]+/, $1) ]
588 if /^\s* use \s+ base \s+ (.*)/sx;
590 return [ 'Class/Autouse.pm',
591 map { s{::}{/}g; "$_.pm" }
592 grep { length and !/^:|^q[qw]?$/ } split(/[^\w:]+/, $1) ]
593 if /^\s* use \s+ Class::Autouse \s+ (.*)/sx
594 or /^\s* Class::Autouse \s* -> \s* autouse \s* (.*)/sx;
597 map { s{::}{/}g; "POE/$_.pm" }
598 grep { length and !/^q[qw]?$/ } split(/[^\w:]+/, $1) ]
599 if /^\s* use \s+ POE \s+ (.*)/sx;
601 return [ 'encoding.pm',
602 map { _find_encoding($_) }
603 grep { length and !/^q[qw]?$/ } split(/[^\w:-]+/, $1) ]
604 if /^\s* use \s+ encoding \s+ (.*)/sx;
606 return $1 if /(?:^|\s)(?:use|no|require)\s+([\w:\.\-\\\/\"\']+)/;
608 if /(?:^|\s)(?:use|no|require)\s+\(\s*([\w:\.\-\\\/\"\']+)\s*\)/;
610 if ( s/(?:^|\s)eval\s+\"([^\"]+)\"/$1/
611 or s/(?:^|\s)eval\s*\(\s*\"([^\"]+)\"\s*\)/$1/)
613 return $1 if /(?:^|\s)(?:use|no|require)\s+([\w:\.\-\\\/\"\']*)/;
616 return "File/Glob.pm" if /<[^>]*[^\$\w>][^>]*>/;
617 return "DBD/$1.pm" if /\b[Dd][Bb][Ii]:(\w+):/;
618 if (/(?:(:encoding)|\b(?:en|de)code)\(\s*['"]?([-\w]+)/) {
619 my $mod = _find_encoding($2);
620 return [ 'PerlIO.pm', $mod ] if $1 and $mod;
623 return $1 if /(?:^|\s)(?:do|require)\s+[^"]*"(.*?)"/;
624 return $1 if /(?:^|\s)(?:do|require)\s+[^']*'(.*?)'/;
625 return $1 if /[^\$]\b([\w:]+)->\w/ and $1 ne 'Tk';
626 return $1 if /\b(\w[\w:]*)::\w+\(/;
630 while (/->\s*([A-Z]\w+)/g) {
631 push @modules, "Tk/$1.pm";
633 while (/->\s*Scrolled\W+([A-Z]\w+)/g) {
634 push @modules, "Tk/$1.pm";
635 push @modules, "Tk/Scrollbar.pm";
644 return unless defined($module);
645 return wantarray ? @$module : $module->[0] if ref($module);
647 $module =~ s/^['"]//;
648 return unless $module =~ /^\w/;
651 $module =~ s/::/\//g;
652 return if $module =~ /^(?:[\d\._]+|'.*[^']|".*[^"])$/;
654 $module .= ".pm" unless $module =~ /\./;
659 return unless $] >= 5.008 and eval { require Encode; %Encode::ExtModule };
661 my $mod = $Encode::ExtModule{ Encode::find_encoding($_[0])->name }
668 my ($rv, $module, $file, $used_by, $type) = @_;
669 return unless defined($module) and defined($file);
677 push @{ $rv->{$module}{used_by} }, $used_by
679 and $used_by ne $module
680 and !grep { $_ eq $used_by } @{ $rv->{$module}{used_by} };
685 ((@_ and $_[0] =~ /^(?:modules|rv|used_by)$/)
687 : (rv => (ref($_[0]) ? shift(@_) : undef), modules => [@_]));
689 my $rv = $args{rv} || {};
690 my $skip = $args{skip} || {};
691 my $used_by = $args{used_by};
693 foreach my $module (@{ $args{modules} }) {
694 if (exists $rv->{$module}) {
695 _add_info($rv, undef, undef, $used_by, undef);
699 my $file = _find_in_inc($module) or next;
700 next if $skip->{$file};
701 next if is_insensitive_fs() and $skip->{lc($file)};
704 $type = 'data' unless $file =~ /\.p[mh]$/i;
705 _add_info($rv, $module, $file, $used_by, $type);
707 if ($module =~ /(.*?([^\/]*))\.p[mh]$/i) {
708 my ($path, $basename) = ($1, $2);
710 foreach (_glob_in_inc("auto/$path")) {
711 next if $skip->{$_->{file}};
712 next if is_insensitive_fs() and $skip->{lc($_->{file})};
713 next if $_->{file} =~ m{\bauto/$path/.*/}; # weed out subdirs
714 next if $_->{name} =~ m/(?:^|\/)\.(?:exists|packlist)$/;
715 my $ext = lc($1) if $_->{name} =~ /(\.[^.]+)$/;
716 next if $ext eq lc(lib_ext());
717 my $type = 'shared' if $ext eq lc(dl_ext());
718 $type = 'autoload' if $ext eq '.ix' or $ext eq '.al';
721 _add_info($rv, "auto/$path/$_->{name}", $_->{file}, $module,
733 # absolute file names
734 return $file if -f $file;
736 foreach my $dir (grep !/\bBSDPAN\b/, @INC) {
737 return "$dir/$file" if -f "$dir/$file";
749 $subdir =~ s/\$CurrentPackage/$CurrentPackage/;
751 foreach my $dir (map "$_/$subdir", grep !/\bBSDPAN\b/, @INC) {
755 my $name = $File::Find::name;
756 $name =~ s!^\Q$dir\E/!!;
757 return if $pm_only and lc($name) !~ /\.p[mh]$/i;
758 push @files, $pm_only
760 : { file => $File::Find::name,
772 # App::Packer compatibility functions
775 my ($class, $self) = @_;
776 return bless($self ||= {}, $class);
781 foreach my $script (@_) {
782 my $basename = $script;
783 $basename =~ s/.*\///;
794 foreach my $module (@{ $args{add_modules} }) {
795 $module =~ s/::/\//g;
796 $module .= '.pm' unless $module =~ /\.p[mh]$/i;
797 my $file = _find_in_inc($module) or next;
798 $self->{files}{$module} = $file;
805 keys => [ $self->{main}{key}, sort keys %{ $self->{files} }, ],
806 files => [ $self->{main}{file},
807 map { $self->{files}{$_} } sort keys %{ $self->{files} },
813 main => { file => $self->{main}{file},
814 store_as => $self->{main}{key},
818 my %cache = ($self->{main}{key} => $info->{main});
819 foreach my $key (sort keys %{ $self->{files} }) {
820 my $file = $self->{files}{$key};
822 $cache{$key} = $info->{modules}{$key} = {
825 used_by => [ $self->{main}{key} ],
829 foreach my $key (sort keys %{$rv}) {
830 my $val = $rv->{$key};
831 if ($cache{ $val->{key} }) {
832 push @{ $info->{ $val->{type} }->{ $val->{key} }->{used_by} },
833 @{ $val->{used_by} };
836 $cache{ $val->{key} } = $info->{ $val->{type} }->{ $val->{key} } =
837 { file => $val->{file},
838 store_as => $val->{key},
839 used_by => $val->{used_by},
844 $self->{info} = { main => $info->{main} };
846 foreach my $type (sort keys %{$info}) {
847 next if $type eq 'main';
850 if (UNIVERSAL::isa($info->{$type}, 'HASH')) {
851 foreach my $val (sort values %{ $info->{$type} }) {
852 @{ $val->{used_by} } = map $cache{$_} || "!!$_!!",
853 @{ $val->{used_by} };
858 $type = 'modules' if $type eq 'module';
859 $self->{info}{$type} = \@val;
865 return $self->{info};
868 # scan_deps_runtime utility functions
871 my ($perl, $file, $inchash, $dl_shared_objects, $incarray) = @_;
873 my ($fhout, $fname) = File::Temp::tempfile("XXXXXX");
874 my $fhin = FileHandle->new($file) or die "Couldn't open $file\n";
876 my $line = do { local $/; <$fhin> };
877 $line =~ s/use Module::ScanDeps::DataFeed.*?\n//sg;
878 $line =~ s/^(.*?)((?:[\r\n]+__(?:DATA|END)__[\r\n]+)|$)/
879 use Module::ScanDeps::DataFeed '$fname.out';
884 $fhout->print($line);
888 system($perl, $fname);
890 _extract_info("$fname.out", $inchash, $dl_shared_objects, $incarray);
892 unlink("$fname.out");
896 my ($perl, $file, $inchash, $dl_shared_objects, $incarray, $firstflag) = @_;
898 $DB::single = $DB::single = 1;
899 my ($fhout, $fname) = File::Temp::tempfile("XXXXXX");
900 $fname = _abs_path($fname);
901 my $fhin = FileHandle->new($file) or die "Couldn't open $file";
903 my $line = do { local $/; <$fhin> };
904 $line =~ s/use Module::ScanDeps::DataFeed.*?\n//sg;
905 $line = "use Module::ScanDeps::DataFeed '$fname.out';\n" . $line;
906 $fhout->print($line);
910 File::Path::rmtree( ['_Inline'], 0, 1); # XXX hack
911 system($perl, $fname) == 0 or die "SYSTEM ERROR in executing $file: $?";
913 _extract_info("$fname.out", $inchash, $dl_shared_objects, $incarray);
915 unlink("$fname.out");
919 my ($inchash, $dl_shared_objects, $inc_array) = @_;
922 my @newinc = map(quotemeta($_), @$inc_array);
923 my $inc = join('|', sort { length($b) <=> length($a) } @newinc);
928 foreach $key (keys(%$inchash)) {
930 $newkey =~ s"^(?:(?:$inc)/?)""sg if File::Spec->file_name_is_absolute($newkey);
934 'file' => $inchash->{$key},
935 'type' => _gettype($inchash->{$key}),
941 foreach $dl_file (@$dl_shared_objects) {
943 $key =~ s"^(?:(?:$inc)/?)""s;
957 my ($fname, $inchash, $dl_shared_objects, $incarray) = @_;
959 use vars qw(%inchash @dl_shared_objects @incarray);
960 my $fh = FileHandle->new($fname) or die "Couldn't open $fname";
961 my $line = do { local $/; <$fh> };
966 $inchash->{$_} = $inchash{$_} for keys %inchash;
967 @$dl_shared_objects = @dl_shared_objects;
968 @$incarray = @incarray;
973 my $dlext = quotemeta(dl_ext());
975 return 'autoload' if $name =~ /(?:\.ix|\.al|\.bs)$/i;
976 return 'module' if $name =~ /\.p[mh]$/i;
977 return 'shared' if $name =~ /\.$dlext$/i;
982 my ($rv_sub, $rv) = @_;
985 foreach $key (keys(%$rv_sub)) {
987 if ($rv->{$key} and _not_dup($key, $rv, $rv_sub)) {
988 warn "Different modules for file '$key' were found.\n"
989 . " -> Using '" . _abs_path($rv_sub->{$key}{file}) . "'.\n"
990 . " -> Ignoring '" . _abs_path($rv->{$key}{file}) . "'.\n";
991 $rv->{$key}{used_by} = [
993 @{ $rv->{$key}{used_by} },
994 @{ $rv_sub->{$key}{used_by} })
996 @{ $rv->{$key}{used_by} } = grep length, @{ $rv->{$key}{used_by} };
997 $rv->{$key}{file} = $rv_sub->{$key}{file};
999 elsif ($rv->{$key}) {
1000 $rv->{$key}{used_by} = [
1002 @{ $rv->{$key}{used_by} },
1003 @{ $rv_sub->{$key}{used_by} })
1005 @{ $rv->{$key}{used_by} } = grep length, @{ $rv->{$key}{used_by} };
1009 used_by => [ @{ $rv_sub->{$key}{used_by} } ],
1010 file => $rv_sub->{$key}{file},
1011 key => $rv_sub->{$key}{key},
1012 type => $rv_sub->{$key}{type}
1015 @{ $rv->{$key}{used_by} } = grep length, @{ $rv->{$key}{used_by} };
1021 my ($key, $rv1, $rv2) = @_;
1022 (_abs_path($rv1->{$key}{file}) ne _abs_path($rv2->{$key}{file}));
1028 Cwd::abs_path(File::Basename::dirname($_[0])),
1029 File::Basename::basename($_[0]),
1039 L<scandeps.pl> is a bundled utility that writes C<PREREQ_PM> section
1040 for a number of files.
1042 An application of B<Module::ScanDeps> is to generate executables from
1043 scripts that contains prerequisite modules; this module supports two
1044 such projects, L<PAR> and L<App::Packer>. Please see their respective
1045 documentations on CPAN for further information.
1049 Audrey Tang E<lt>autrijus@autrijus.orgE<gt>
1051 Parts of heuristics were deduced from:
1057 B<PerlApp> by ActiveState Tools Corp L<http://www.activestate.com/>
1061 B<Perl2Exe> by IndigoStar, Inc L<http://www.indigostar.com/>
1065 The B<scan_deps_runtime> function is contributed by Edward S. Peschko.
1067 L<http://par.perl.org/> is the official website for this module. You
1068 can write to the mailing list at E<lt>par@perl.orgE<gt>, or send an empty
1069 mail to E<lt>par-subscribe@perl.orgE<gt> to participate in the discussion.
1071 Please submit bug reports to E<lt>bug-Module-ScanDeps@rt.cpan.orgE<gt>.
1075 Copyright 2002, 2003, 2004, 2005, 2006 by
1076 Audrey Tang E<lt>autrijus@autrijus.orgE<gt>.
1078 This program is free software; you can redistribute it and/or modify it
1079 under the same terms as Perl itself.
1081 See L<http://www.perl.com/perl/misc/Artistic.html>