dh_perl

   1 #!/usr/bin/perl -w
   2
   3 =head1 NAME
   4
   5 dh_perl - calculates perl scripts & modules dependencies
   6
   7 =cut
   8
   9 use strict;
  10 use Debian::Debhelper::Dh_Lib;
  11
  12 =head1 SYNOPSIS
  13
  14   dh_perl [debhelper options] [-k] [-d] [library dirs ...]
  15
  16 =head1 DESCRIPTION
  17
  18 dh_perl is a debhelper program that is responsible for generating
  19 the perl:Depends substitutions and adding them to substvars files.
  20
  21 The program will look for the location of installed modules and will
  22 use this information to generate a dependency (at the present time
  23 it can only be perl5, perl5-thread, perl-5.X or perl-5.X-thread).
  24 The dependancy will be substituted into your package's control file
  25 wherever you place the token "${perl:Depends}".
  26
  27 It will also look at #! lines of perl scripts in order to be able
  28 to calculate a dependency for perl scripts and not only perl modules.
  29
  30 In addition it will automatically remove .packlist file and will
  31 remove the directory in which it was if it's empty. You can
  32 switch off this option by passing -k.
  33
  34 =head1 OPTIONS
  35
  36 =over 4
  37
  38 =item B<-k>
  39
  40 Keep .packlist files.
  41
  42 =item B<-d>
  43
  44 In some specific cases you may want to depend on a -base package
  45 (ie perl-5.6-base or perl5-base). If so, you can pass
  46 the -d option to make dh_perl generate a dependency on the correct base
  47 package. This is only necessary for some packages that are included in the
  48 base system.
  49
  50 =item I<library dirs>
  51
  52 If your package installs perl modules in non-standard
  53 directories, you can make dh_perl check those directories by passing their
  54 names on the command line. It will only check usr/lib/perl5 by default.
  55
  56 =back
  57
  58 =head1 CONFORMS TO
  59
  60 Debian policy, version 3.0.1
  61
  62 Perl policy, version 1.0
  63
  64 =cut
  65
  66 init();
  67
  68 my $perlext = '';
  69 my $lib_dir = 'usr/lib/perl5';
  70
  71 # Figure out the version of perl. If $ENV{PERL} is set, query the perl binary
  72 # it points to, otherwise query perl directly.
  73 #
  74 # This is pretty gawd-aweful ugly, because we need "5.00[45]"
  75 # and "5.[6789]" to be returned depending on perl version.
  76 my $version;
  77 if (defined $ENV{PERL}) {
  78         $version=`$ENV{PERL} -e '\$] < 5.006 ? printf "%.3f", \$] : printf "%vd", substr \$^V, 0, -1'`;
  79 }
  80 else {
  81         $version=$] < 5.006 ? sprintf "%.3f", $] : sprintf "%vd", substr $^V, 0, -1;
  82 }
  83
  84 # Cleaning the paths given on the command line
  85 foreach (@ARGV) {
  86         s#/$##;
  87         s#^/##;
  88 }
  89
  90 # If -d is given, then we'll try to depend on one of the perl-5.00X-base
  91 # package instead of perl-5.00X
  92 $perlext='-base' if ($dh{'D_FLAG'});
  93
  94 foreach my $package (@{$dh{DOPACKAGES}}) {
  95         my $tmp=tmpdir($package);
  96         my $ext=pkgext($package);
  97
  98         my ($file, $v, $arch);
  99         my $dep_arch = '';
 100         my $dep = '';
 101         my $found = 0;
 102
 103         # Check also for alternate locations given on the command line
 104         my $dirs = '';
 105         foreach ($lib_dir, @ARGV) {
 106                 $dirs .= "$tmp/$_ " if (-d "$tmp/$_");
 107         }
 108         my $re = '(?:' . join('|', ($lib_dir, @ARGV)) . ')';
 109
 110         # Look for perl modules and check where they are installed
 111         if ($dirs) {
 112             foreach $file (split(/\n/,`find $dirs -type f \\( -name "*.pm" -or -name "*.so" \\)`)) {
 113                 $found++;
 114                 if ($file =~ m<^$tmp/$re/(\d\.\d+)/([^/]+)/>) {
 115                         $v = $1;
 116                         $arch = $2;
 117                         check_module_version ($v, $version);
 118                         $v .= '-thread' if ($arch =~ /-thread/);
 119                         $dep_arch = add_deps ($dep_arch, "perl-$v");
 120                 } elsif ($file =~ m<^$tmp/$re/(\d.\d+)/>) {
 121                         $v = $1;
 122                         check_module_version ($v, $version);
 123                         $dep_arch = add_deps ($dep_arch, "perl-$v");
 124                 }
 125             }
 126         }
 127
 128         if ($found and not $dep_arch) {
 129                 $dep = "perl5$perlext";
 130         } elsif ($dep_arch) {
 131                 $dep = $dep_arch;
 132         }
 133
 134         # Look for perl scripts
 135         my ($ff, $newdep);
 136         foreach $file (split(/\n/,`find $tmp -type f \\( -name "*.pl" -or -perm +111 \\)`)) {
 137                 $ff=`file -b $file`;
 138                 if ($ff =~ /perl/) {
 139                         $newdep = dep_from_script ($file);
 140                         $dep = add_deps ($dep, $newdep) if $newdep;
 141                 }
 142         }
 143
 144         # Remove .packlist files and eventually some empty directories
 145         if (not $dh{'K_FLAG'}) {
 146                 foreach $file (split(/\n/,`find $tmp -type f -name .packlist`))
 147                 {
 148                         unlink($file);
 149                         # Get the directory name
 150                         while ($file =~ s#/[^/]+$##){
 151                                 last if (not -d $file);
 152                                 last if (not rmdir $file);
 153                         }
 154                 }
 155         }
 156
 157         next unless $dep;
 158
 159         if (-e "debian/${ext}substvars") {
 160                 open (IN, "<debian/${ext}substvars");
 161                 my @lines=grep { ! /^perl:Depends=/ } <IN>;
 162                 close IN;
 163                 open (OUT, ">debian/${ext}substvars");
 164                 print OUT @lines;
 165         } else {
 166                 open (OUT, ">debian/${ext}substvars");
 167         }
 168         print OUT "perl:Depends=$dep\n";
 169         close OUT;
 170 }
 171
 172 sub add_deps {
 173         my ($dep, $new) = @_;
 174
 175         # If the $new-base package can exist then add $perlext to $new
 176         $new = "$new$perlext" if ($new =~ m/^(?:perl5|perl-\d\.\d+)$/);
 177
 178         # If $new = perl5 or perl5-thread check if perl-X.XXX(-thread)?
 179         # is not already in the dependencies
 180         if ($new eq "perl5") {
 181                 return $dep if ($dep =~ m/(^|\s)perl-5\.\d+(\s|,|$)/);
 182         } elsif ($new eq "perl5-thread") {
 183                 return $dep if ($dep =~ m/(^|\s)perl-5\.\d+-thread(\s|,|$)/);
 184         }
 185
 186         if (not $dep) {
 187                 $dep = $new;
 188         } else {
 189                 $dep .= ", $new" unless ($dep =~ m/(^|\s)$new(\s|,|$)/);
 190         }
 191
 192         return $dep;
 193 }
 194
 195 sub check_module_version {
 196         my ($v1, $v2) = @_;
 197         unless ($v1 eq $v2) {
 198                 warning("A module has been found in perl-$v1 arch directory. But perl-$v2 is the perl currently used ...\n");
 199         }
 200 }
 201
 202 sub dep_from_script {
 203         my $file = shift;
 204         my ($line, $perl, $dep);
 205         open (SCRIPT, "<$file") || die "Can't open $file: $!\n";
 206         $line = <SCRIPT>;
 207         close (SCRIPT);
 208         if ($line =~ m<^#!\s*/usr/bin/(perl\S*)(?:\s+|$)>) {
 209                 $perl = $1;
 210                 if ($perl eq "perl") {
 211                         $dep = "perl5";
 212                 } elsif ($perl eq "perl-thread") {
 213                         $dep = "perl5-thread";
 214                 } elsif ($perl =~ m/^perl-\d\.\d+(?:-thread)?$/) {
 215                         $dep = $perl;
 216                 } elsif ($perl =~ m/^perl(\d\.\d+)(\d\d)$/) {
 217                         # Should never happen but ...
 218                         $dep = "perl-$1 (=$1.$2)";
 219                 }
 220         }
 221         return $dep;
 222 }
 223
 224 =head1 SEE ALSO
 225
 226 L<debhelper(1)>
 227
 228 This program is a part of debhelper.
 229
 230 =head1 AUTHOR
 231
 232 Joey Hess <joeyh@debian.org>
 233
 234 =cut