summaryrefslogtreecommitdiff
path: root/dh_perl
blob: d77554215b98e147163df9d85f402962abd168b3 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
#!/usr/bin/perl -w

=head1 NAME

dh_perl - calculates perl scripts & modules dependencies

=cut

use strict;
use Debian::Debhelper::Dh_Lib;

=head1 SYNOPSIS

  dh_perl [debhelper options] [-k] [-d] [library dirs ...]

=head1 DESCRIPTION

dh_perl is a debhelper program that is responsible for generating
the perl:Depends substitutions and adding them to substvars files.

The program will look for the location of installed modules and will
use this information to generate a dependency (at the present time
it can only be perl5, perl5-thread, perl-5.X or perl-5.X-thread).
The dependancy will be substituted into your package's control file
wherever you place the token "${perl:Depends}".

It will also look at #! lines of perl scripts in order to be able
to calculate a dependency for perl scripts and not only perl modules.

In addition it will automatically remove .packlist file and will
remove the directory in which it was if it's empty. You can
switch off this option by passing -k.

=head1 OPTIONS

=over 4

=item B<-k>

Keep .packlist files.

=item B<-d>

In some specific cases you may want to depend on a -base package
(ie perl-5.6-base or perl5-base). If so, you can pass
the -d option to make dh_perl generate a dependency on the correct base
package. This is only necessary for some packages that are included in the
base system.

=item I<library dirs>

If your package installs perl modules in non-standard
directories, you can make dh_perl check those directories by passing their
names on the command line. It will only check usr/lib/perl5 by default.

=back

=head1 CONFORMS TO

Debian policy, version 3.0.1

Perl policy, version 1.0

=cut

init();

my $perlext = '';
my $lib_dir = 'usr/lib/perl5';

# Figure out the version of perl. If $ENV{PERL} is set, query the perl binary
# it points to, otherwise query perl directly.
#
# This is pretty gawd-aweful ugly, because we need "5.00[45]"
# and "5.[6789]" to be returned depending on perl version.
my $version;
if (defined $ENV{PERL}) {
	$version=`$ENV{PERL} -e '\$] < 5.006 ? printf "%.3f", \$] : printf "%vd", substr \$^V, 0, -1'`;
}
else {
	$version=$] < 5.006 ? sprintf "%.3f", $] : sprintf "%vd", substr $^V, 0, -1;
}

# Cleaning the paths given on the command line
foreach (@ARGV) {
	s#/$##;
	s#^/##;
}

# If -d is given, then we'll try to depend on one of the perl-5.00X-base 
# package instead of perl-5.00X
$perlext='-base' if ($dh{'D_FLAG'});

foreach my $package (@{$dh{DOPACKAGES}}) {
	my $tmp=tmpdir($package);
	my $ext=pkgext($package);

	my ($file, $v, $arch);
	my $dep_arch = '';
	my $dep = '';
	my $found = 0;

	# Check also for alternate locations given on the command line
	my $dirs = '';
	foreach ($lib_dir, @ARGV) {
		$dirs .= "$tmp/$_ " if (-d "$tmp/$_");
	}
	my $re = '(?:' . join('|', ($lib_dir, @ARGV)) . ')';

	# Look for perl modules and check where they are installed
	if ($dirs) {
	    foreach $file (split(/\n/,`find $dirs -type f \\( -name "*.pm" -or -name "*.so" \\)`)) {
	        $found++;
		if ($file =~ m<^$tmp/$re/(\d\.\d+)/([^/]+)/>) {
			$v = $1;
			$arch = $2;
			check_module_version ($v, $version);
			$v .= '-thread' if ($arch =~ /-thread/); 
			$dep_arch = add_deps ($dep_arch, "perl-$v");
		} elsif ($file =~ m<^$tmp/$re/(\d.\d+)/>) {
			$v = $1;
			check_module_version ($v, $version);
			$dep_arch = add_deps ($dep_arch, "perl-$v");
		}
	    }
	}

	if ($found and not $dep_arch) {
		$dep = "perl5$perlext";
	} elsif ($dep_arch) {
		$dep = $dep_arch;
	}

	# Look for perl scripts
	my ($ff, $newdep);
	foreach $file (split(/\n/,`find $tmp -type f \\( -name "*.pl" -or -perm +111 \\)`)) {
		$ff=`file -b $file`;
		if ($ff =~ /perl/) {
			$newdep = dep_from_script ($file);
			$dep = add_deps ($dep, $newdep) if $newdep;
		}
	}

	# Remove .packlist files and eventually some empty directories
	if (not $dh{'K_FLAG'}) {
		foreach $file (split(/\n/,`find $tmp -type f -name .packlist`))
		{
			unlink($file);
			# Get the directory name
			while ($file =~ s#/[^/]+$##){
				last if (not -d $file);
				last if (not rmdir $file);
			}
		}
	}

	next unless $dep;

	if (-e "debian/${ext}substvars") {
		open (IN, "<debian/${ext}substvars");
		my @lines=grep { ! /^perl:Depends=/ } <IN>;
		close IN;
		open (OUT, ">debian/${ext}substvars");
		print OUT @lines;
	} else {
		open (OUT, ">debian/${ext}substvars");
	}
	print OUT "perl:Depends=$dep\n";
	close OUT;
}

sub add_deps {
	my ($dep, $new) = @_;
	
        # If the $new-base package can exist then add $perlext to $new
	$new = "$new$perlext" if ($new =~ m/^(?:perl5|perl-\d\.\d+)$/);
	
	# If $new = perl5 or perl5-thread check if perl-X.XXX(-thread)?
	# is not already in the dependencies
	if ($new eq "perl5") {
		return $dep if ($dep =~ m/(^|\s)perl-5\.\d+(\s|,|$)/);
	} elsif ($new eq "perl5-thread") {
		return $dep if ($dep =~ m/(^|\s)perl-5\.\d+-thread(\s|,|$)/);
	}
	
	if (not $dep) {
		$dep = $new;
	} else {
		$dep .= ", $new" unless ($dep =~ m/(^|\s)$new(\s|,|$)/);
	}

	return $dep;
}

sub check_module_version {
	my ($v1, $v2) = @_;
	unless ($v1 eq $v2) {
		warning("A module has been found in perl-$v1 arch directory. But perl-$v2 is the perl currently used ...\n");
	}
}

sub dep_from_script {
	my $file = shift;
	my ($line, $perl, $dep);
	open (SCRIPT, "<$file") || die "Can't open $file: $!\n";
	$line = <SCRIPT>;
	close (SCRIPT);
	if ($line =~ m<^#!\s*/usr/bin/(perl\S*)(?:\s+|$)>) {
		$perl = $1;
		if ($perl eq "perl") {
			$dep = "perl5";
		} elsif ($perl eq "perl-thread") {
			$dep = "perl5-thread";
		} elsif ($perl =~ m/^perl-\d\.\d+(?:-thread)?$/) {
			$dep = $perl;
		} elsif ($perl =~ m/^perl(\d\.\d+)(\d\d)$/) {
			# Should never happen but ...
			$dep = "perl-$1 (=$1.$2)";
		}
	}
	return $dep;
}

=head1 SEE ALSO

L<debhelper(1)>

This program is a part of debhelper.

=head1 AUTHOR

Joey Hess <joeyh@debian.org>

=cut