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.pm < prev    next >
Encoding:
Perl POD Document  |  2003-12-17  |  2.3 KB  |  73 lines
  1. # $File: //depot/cpan/Module-Install/lib/Module/Install/Admin/ScanDeps.pm $ $Author: autrijus $
  2. # $Revision: #16 $ $Change: 1815 $ $DateTime: 2003/12/14 20:41:23 $ vim: expandtab shiftwidth=4
  3.  
  4. package Module::Install::Admin::ScanDeps;
  5. use Module::Install::Base; @ISA = qw(Module::Install::Base);
  6.  
  7. sub scan_dependencies {
  8.     my ($self, $pkg, $perl_version) = @_;
  9.  
  10.     return if $pkg eq 'perl';
  11.  
  12.     $perl_version ||= $self->perl_version or die << '.';
  13. Please first specify a required perl version, like this:
  14.     requires( perl => '5.004' );
  15. .
  16.     $perl_version =~ s{^(\d+)\.(\d+)\.(\d+)}{$1 + $2/1_000 + $3/1_000_000}e;
  17.  
  18.     require Module::ScanDeps;
  19.     require Module::CoreList;
  20.  
  21.     die "Module::CoreList has no information on perl $perl_version"
  22.         unless exists $Module::CoreList::version{$perl_version};
  23.  
  24.     if (my $min_version = Module::CoreList->first_release($pkg)) {
  25.         return if $min_version <= $perl_version;
  26.     }
  27.  
  28.     my @files = scalar $self->admin->find_in_inc($pkg)
  29.         or die "Cannot find $pkg in \@INC";
  30.     my %result = ($pkg => $files[0]);
  31.  
  32.     while (@files) {
  33.         my $deps = Module::ScanDeps::scan_deps(
  34.             files   => \@files,
  35.             recurse => 0,
  36.         );
  37.  
  38.         @files = ();
  39.  
  40.         foreach my $key (keys %$deps) {
  41.             if ($deps->{$key}{type} eq 'shared') {
  42.                 foreach my $used_by (@{$deps->{$key}{used_by}}) {
  43.                     $used_by =~ s!/!::!;
  44.                     $used_by =~ s!\.pm\Z!!i or next;
  45.                     next if exists $result{$used_by};
  46.                     $result{$used_by} = undef;
  47.                     print "skipped $used_by (needs shared library)\n";
  48.                 }
  49.             }
  50.  
  51.             my $dep_pkg = $key;
  52.             $dep_pkg =~ s!/!::!;
  53.             $dep_pkg =~ s!\.pm\Z!!i or next;
  54.  
  55.             if (my $min_version = Module::CoreList->first_release($dep_pkg)) {
  56.                 next if $min_version <= $perl_version;
  57.             }
  58.             next if $dep_pkg =~ /^(?:DB|(?:Auto|Dyna|XS)Loader|threads|warnings)\b/i;
  59.             next if exists $result{$dep_pkg};
  60.  
  61.             $result{$dep_pkg} = $deps->{$key}{file};
  62.             push @files, $deps->{$key}{file};
  63.         }
  64.     }
  65.  
  66.     while (my($k,$v) = each %result) {
  67.         delete $result{$k} unless defined $v;
  68.     }
  69.     return \%result;
  70. }
  71.  
  72. 1;
  73.