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