local-lib5/lib/perl5/Module/Install/Admin/ScanDeps.pm

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