dh_perl

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