home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / scandeps.pl < prev    next >
Encoding:
Perl Script  |  2004-03-20  |  4.5 KB  |  199 lines
  1. #!/usr/bin/perl
  2. # $File: //member/autrijus/Module-ScanDeps/script/scandeps.pl $ $Author: joker $
  3. # $Revision: 1.2 $ $Change: 9514 $ $DateTime: 2003/12/31 12:13:05 $ vim: expandtab shiftwidth=4
  4.  
  5. $VERSION = '0.05';
  6.  
  7. use strict;
  8. use Config;
  9. use Getopt::Std;
  10. use Module::ScanDeps;
  11.  
  12. my %opts;
  13. getopts('BVxce:', \%opts);
  14.  
  15. my $modtree = eval {
  16.     require CPANPLUS::Backend;
  17.     CPANPLUS::Backend->new->module_tree;
  18. };
  19.  
  20. my (%map, %skip);
  21. my $core    = $opts{B};
  22. my $verbose = $opts{V};
  23. my $eval    = $opts{e};
  24.  
  25. if ($eval) {
  26.     require File::Temp;
  27.     my ($fh, $filename) = File::Temp::tempfile( UNLINK => 1 );
  28.     print $fh $eval, "\n" or die $!;
  29.     close $fh;
  30.     push @ARGV, $filename;
  31. }
  32.  
  33. die "Usage: $0 [ -B ] [ -V ] [ -x | -c ] [ -e STRING | FILE ... ]\n" unless @ARGV;
  34.  
  35. my @files = @ARGV;
  36. while (<>) {
  37.     next unless /^package\s+([\w:]+)/;
  38.     $skip{$1}++;
  39. }
  40.  
  41. my $map = scan_deps(
  42.     files   => \@files,
  43.     recurse => 1,
  44.     $opts{x} ? ( execute => 1 ) :
  45.     $opts{c} ? ( compile => 1 ) : (),
  46. );
  47.  
  48.  
  49. my $len = 0;
  50. my @todo;
  51. my (%seen, %dist, %core, %bin);
  52.  
  53. foreach my $key (sort keys %$map) {
  54.     my $mod  = $map->{$key};
  55.     my $name = $mod->{name} = _name($key);
  56.  
  57.     print "# $key [$mod->{type}]\n" if $verbose;
  58.  
  59.     if ($mod->{type} eq 'shared') {
  60.     $key =~ s!auto/!!;
  61.     $key =~ s!/[^/]+$!!;
  62.     $key =~ s!/!::!;
  63.     $bin{$key}++;
  64.     }
  65.  
  66.     next unless $mod->{type} eq 'module';
  67.  
  68.     next if $skip{$name};
  69.  
  70.     if ($mod->{file} eq "$Config::Config{privlib}/$key"
  71.     or $mod->{file} eq "$Config::Config{archlib}/$key") {
  72.     next unless $core;
  73.  
  74.     $core{$name}++;
  75.     }
  76.     elsif (my $dist = $modtree->{$name}) {
  77.     $seen{$name} = $dist{$dist->package}++;
  78.     }
  79.  
  80.     $len = length($name) if $len < length($name);
  81.     $mod->{used_by} ||= [];
  82.  
  83.     push @todo, $mod;
  84. }
  85.  
  86. $len += 2;
  87.  
  88. warn "# Legend: [C]ore [X]ternal [S]ubmodule [?]NotOnCPAN\n";
  89.  
  90. foreach my $mod (sort {
  91.     "@{$a->{used_by}}" cmp "@{$b->{used_by}}" or
  92.     $a->{key} cmp $b->{key}
  93. } @todo) {
  94.     printf "%-${len}s => '0', # ", "'$mod->{name}'";
  95.     my @base = map(_name($_), @{$mod->{used_by}});
  96.     print $seen{$mod->{name}}    ? 'S' : ' ';
  97.     print $bin{$mod->{name}}    ? 'X' : ' ';
  98.     print $core{$mod->{name}}    ? 'C' : ' ';
  99.     print $modtree && !$modtree->{$mod->{name}} ? '?' : ' ';
  100.     print " # ";
  101.     print "@base" if @base;
  102.     print "\n";
  103. }
  104.  
  105. warn "No modules found!\n" unless @todo;
  106.  
  107. sub _name {
  108.     my $str = shift;
  109.     $str =~ s!/!::!g;
  110.     $str =~ s!.pm$!!i;
  111.     $str =~ s!^auto::(.+)::.*!$1!;
  112.     return $str;
  113. }
  114.  
  115. 1;
  116.  
  117. __END__
  118.  
  119. =head1 NAME
  120.  
  121. scandeps.pl - Scan file prerequisites
  122.  
  123. =head1 SYNOPSIS
  124.  
  125.     % scandeps.pl *.pm        # Print PREREQ_PM section for *.pm
  126.     % scandeps.pl -e 'STRING'    # Scan an one-liner
  127.     % scandeps.pl -B *.pm    # Include core modules
  128.     % scandeps.pl -V *.pm    # Show autoload/shared/data files
  129.  
  130. =head1 DESCRIPTION
  131.  
  132. F<scandeps.pl> is a simple-minded utility that prints out the
  133. C<PREREQ_PM> section needed by modules.
  134.  
  135. If you have B<CPANPLUS> installed, modules that are part of an
  136. earlier module's distribution with be denoted with C<S>; modules
  137. without a distribution name on CPAN are marked with C<?>.
  138.  
  139. Also, if the C<-B> option is specified, module belongs to a perl
  140. distribution on CPAN (and thus uninstallable by C<CPAN.pm> or
  141. C<CPANPLUS.pm>) are marked with C<C>.
  142.  
  143. Finally, modules that has loadable shared object files (usually
  144. needing a compiler to install) are marked with C<X>; with the
  145. C<-V> flag, those files (and all other files found) will be listed
  146. before the main output.
  147.  
  148. =head1 OPTIONS
  149.  
  150. =over 4
  151.  
  152. =item -e STRING
  153.  
  154. Scan I<STRING> as a string containing perl code.
  155.  
  156. =item -c
  157.  
  158. Compiles the code and inspects its C<%INC>, in addition to static scanning.
  159.  
  160. =item -x
  161.  
  162. Executes the code and inspects its C<%INC>, in addition to static scanning.
  163.  
  164. =item -B
  165.  
  166. Include core modules in the output and the recursive search list.
  167.  
  168. =item -V
  169.  
  170. Verbose mode: Output all files found during the process.
  171.  
  172. =head1 CAVEATS
  173.  
  174. All version numbers are set to C<0> in the output, despite explicit
  175. C<use Module VERSION> statements.
  176.  
  177. =head1 SEE ALSO
  178.  
  179. L<Module::ScanDeps>, L<CPANPLUS::Backend>, L<PAR>
  180.  
  181. =head1 ACKNOWLEDGMENTS
  182.  
  183. Simon Cozens, for suggesting this script to be written.
  184.  
  185. =head1 AUTHORS
  186.  
  187. Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>
  188.  
  189. =head1 COPYRIGHT
  190.  
  191. Copyright 2003 by Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>.
  192.  
  193. This program is free software; you can redistribute it and/or modify it
  194. under the same terms as Perl itself.
  195.  
  196. See L<http://www.perl.com/perl/misc/Artistic.html>
  197.  
  198. =cut
  199.