dh_perl

   1 #!/usr/bin/perl -w
   2 #
   3 # Find dependencies on perl stuff
   4 # Remove .packlist files
   5
   6 use Debian::Debhelper::Dh_Lib;
   7 init();
   8
   9 my $ext = '';
  10 my $lib_dir = 'usr/lib/perl5';
  11
  12 # Figure out the version of perl. If $ENV{PERL} is set, query the perl binary
  13 # it points to, otherwise query perl directly.
  14 #
  15 # This is pretty gawd-aweful ugly, because we need "5.00[45]"
  16 # and "5.[6789]" to be returned depending on perl version.
  17 my $version;
  18 if (defined $ENV{PERL}) {
  19         $version=`$ENV{PERL} -e '\$] < 5.006 ? printf "%.3f", \$] : printf "%vd", substr \$^V, 0, -1'`;
  20 }
  21 else {
  22         $version=$] < 5.006 ? sprintf "%.3f", $] : sprintf "%vd", substr $^V, 0, -1;
  23 }
  24
  25 # Cleaning the paths given on the command line
  26 foreach (@ARGV) {
  27         s#/$##;
  28         s#^/##;
  29 }
  30
  31 # If -d is given, then we'll try to depend on one of the perl-5.00X-base
  32 # package instead of perl-5.00X
  33 $ext='-base' if ($dh{'D_FLAG'});
  34
  35 foreach $PACKAGE (@{$dh{DOPACKAGES}}) {
  36         $TMP=tmpdir($PACKAGE);
  37         $EXT=pkgext($PACKAGE);
  38
  39         my ($file, $v, $arch);
  40         my $dep_arch = '';
  41         my $dep = '';
  42         my $found = 0;
  43
  44         # Check also for alternate locations given on the command line
  45         my $dirs = '';
  46         foreach ($lib_dir, @ARGV) {
  47                 $dirs .= "$TMP/$_ " if (-d "$TMP/$_");
  48         }
  49         my $re = '(?:' . join('|', ($lib_dir, @ARGV)) . ')';
  50
  51         # Look for perl modules and check where they are installed
  52         if ($dirs) {
  53             foreach $file (split(/\n/,`find $dirs -type f \\( -name "*.pm" -or -name "*.so" \\)`)) {
  54                 $found++;
  55                 if ($file =~ m<^$TMP/$re/(\d\.\d+)/([^/]+)/>) {
  56                         $v = $1;
  57                         $arch = $2;
  58                         check_module_version ($v, $version);
  59                         $v .= '-thread' if ($arch =~ /-thread/);
  60                         $dep_arch = add_deps ($dep_arch, "perl-$v");
  61                 } elsif ($file =~ m<^$TMP/$re/(\d.\d+)/>) {
  62                         $v = $1;
  63                         check_module_version ($v, $version);
  64                         $dep_arch = add_deps ($dep_arch, "perl-$v");
  65                 }
  66             }
  67         }
  68
  69         if ($found and not $dep_arch) {
  70                 $dep = "perl5$ext";
  71         } elsif ($dep_arch) {
  72                 $dep = $dep_arch;
  73         }
  74
  75         # Look for perl scripts
  76         my ($ff, $newdep);
  77         foreach $file (split(/\n/,`find $TMP -type f \\( -name "*.pl" -or -perm +111 \\)`)) {
  78                 $ff=`file -b $file`;
  79                 if ($ff =~ /perl/) {
  80                         $newdep = dep_from_script ($file);
  81                         $dep = add_deps ($dep, $newdep) if $newdep;
  82                 }
  83         }
  84
  85         # Remove .packlist files and eventually some empty directories
  86         if (not $dh{'K_FLAG'}) {
  87                 foreach $file (split(/\n/,`find $TMP -type f -name .packlist`))
  88                 {
  89                         unlink($file);
  90                         # Get the directory name
  91                         while ($file =~ s#/[^/]+$##){
  92                                 last if (not -d $file);
  93                                 last if (not rmdir $file);
  94                         }
  95                 }
  96         }
  97
  98         next unless $dep;
  99
 100         if (-e "debian/${EXT}substvars") {
 101                 open (IN, "<debian/${EXT}substvars");
 102                 my @lines=grep { ! /^perl:Depends=/ } <IN>;
 103                 close IN;
 104                 open (OUT, ">debian/${EXT}substvars");
 105                 print OUT @lines;
 106         } else {
 107                 open (OUT, ">debian/${EXT}substvars");
 108         }
 109         print OUT "perl:Depends=$dep\n";
 110         close OUT;
 111 }
 112
 113 sub add_deps {
 114         my ($dep, $new) = @_;
 115
 116         # If the $new-base package can exist then add $ext to $new
 117         $new = "$new$ext" if ($new =~ m/^(?:perl5|perl-\d\.\d+)$/);
 118
 119         # If $new = perl5 or perl5-thread check if perl-X.XXX(-thread)?
 120         # is not already in the dependencies
 121         if ($new eq "perl5") {
 122                 return $dep if ($dep =~ m/(^|\s)perl-5\.\d+(\s|,|$)/);
 123         } elsif ($new eq "perl5-thread") {
 124                 return $dep if ($dep =~ m/(^|\s)perl-5\.\d+-thread(\s|,|$)/);
 125         }
 126
 127         if (not $dep) {
 128                 $dep = $new;
 129         } else {
 130                 $dep .= ", $new" unless ($dep =~ m/(^|\s)$new(\s|,|$)/);
 131         }
 132
 133         return $dep;
 134 }
 135
 136 sub check_module_version {
 137         my ($v1, $v2) = @_;
 138         unless ($v1 eq $v2) {
 139                 warning("A module has been found in perl-$v1 arch directory. But perl-$v2 is the perl currently used ...\n");
 140         }
 141 }
 142
 143 sub dep_from_script {
 144         my $file = shift;
 145         my ($line, $perl, $dep);
 146         open (SCRIPT, "<$file") || die "Can't open $file: $!\n";
 147         $line = <SCRIPT>;
 148         close (SCRIPT);
 149         if ($line =~ m<^#!\s*/usr/bin/(perl\S*)(?:\s+|$)>) {
 150                 $perl = $1;
 151                 if ($perl eq "perl") {
 152                         $dep = "perl5";
 153                 } elsif ($perl eq "perl-thread") {
 154                         $dep = "perl5-thread";
 155                 } elsif ($perl =~ m/^perl-\d\.\d+(?:-thread)?$/) {
 156                         $dep = $perl;
 157                 } elsif ($perl =~ m/^perl(\d\.\d+)(\d\d)$/) {
 158                         # Should never happen but ...
 159                         $dep = "perl-$1 (=$1.$2)";
 160                 }
 161         }
 162         return $dep;
 163 }