line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DhMakePerl::Command::make; |
2
|
|
|
|
|
|
|
|
3
|
3
|
|
|
3
|
|
26449353
|
use warnings; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
185
|
|
4
|
3
|
|
|
3
|
|
21
|
use strict; |
|
3
|
|
|
|
|
12
|
|
|
3
|
|
|
|
|
161
|
|
5
|
|
|
|
|
|
|
our $VERSION = '0.84'; |
6
|
3
|
|
|
3
|
|
166
|
use 5.010; # we use smart matching |
|
3
|
|
|
|
|
10
|
|
7
|
|
|
|
|
|
|
|
8
|
3
|
|
|
3
|
|
24
|
use base 'DhMakePerl::Command::Packaging'; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
2492
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors( |
11
|
|
|
|
|
|
|
qw( |
12
|
|
|
|
|
|
|
cfg apt_contents main_dir debian_dir meta |
13
|
|
|
|
|
|
|
perlname version pkgversion |
14
|
|
|
|
|
|
|
copyright author |
15
|
|
|
|
|
|
|
extrasfields extrapfields |
16
|
|
|
|
|
|
|
docs examples |
17
|
|
|
|
|
|
|
) |
18
|
|
|
|
|
|
|
); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=head1 NAME |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
DhMakePerl::Command::make - implementation of 'dh-make-perl make' |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=cut |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=head1 SYNOPSIS |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
TO BE FILLED |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
use DhMakePerl; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
my $foo = DhMakePerl->new(); |
33
|
|
|
|
|
|
|
... |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=head1 METHODS |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=over |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=cut |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
use AptPkg::Cache (); |
42
|
|
|
|
|
|
|
use CPAN (); |
43
|
|
|
|
|
|
|
use Cwd qw( realpath ); |
44
|
|
|
|
|
|
|
use Debian::Dependencies (); |
45
|
|
|
|
|
|
|
use Debian::Dependency (); |
46
|
|
|
|
|
|
|
use Debian::WNPP::Query; |
47
|
|
|
|
|
|
|
use DhMakePerl::Utils qw( |
48
|
|
|
|
|
|
|
find_cpan_module find_cpan_distribution |
49
|
|
|
|
|
|
|
is_core_module ); |
50
|
|
|
|
|
|
|
use Email::Date::Format qw(email_date); |
51
|
|
|
|
|
|
|
use File::Basename qw( basename dirname ); |
52
|
|
|
|
|
|
|
use File::Copy qw( copy move ); |
53
|
|
|
|
|
|
|
use File::Path (); |
54
|
|
|
|
|
|
|
use File::Spec::Functions qw( catdir catfile updir ); |
55
|
|
|
|
|
|
|
use Module::Depends (); |
56
|
|
|
|
|
|
|
use Module::Metadata; |
57
|
|
|
|
|
|
|
use Text::Wrap qw( wrap ); |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
sub check_deprecated_overrides { |
60
|
|
|
|
|
|
|
my $self = shift; |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
my $overrides = catfile( $self->cfg->data_dir, 'overrides' ); |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
if ( -e $overrides ) { |
65
|
|
|
|
|
|
|
warn "*** deprecated overrides file ignored\n"; |
66
|
|
|
|
|
|
|
warn "***\n"; |
67
|
|
|
|
|
|
|
warn "*** Overrides mechanism is deprecated in dh-make-perl 0.65\n"; |
68
|
|
|
|
|
|
|
warn "*** You may want to remove $overrides\n"; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
sub execute { |
73
|
|
|
|
|
|
|
my ( $self, $already_done ) = @_; |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
die "CPANPLUS support disabled, sorry" if $self->cfg->cpanplus; |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
$self->check_deprecated_overrides; |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
my $tarball = $self->setup_dir(); |
80
|
|
|
|
|
|
|
$self->process_meta; |
81
|
|
|
|
|
|
|
$self->findbin_fix(); |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
$self->extract_basic(); |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
$tarball //= $self->guess_debian_tarball if $self->cfg->{vcs} eq 'git'; |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
unless ( defined $self->cfg->version ) { |
88
|
|
|
|
|
|
|
$self->pkgversion( $self->version . '-1' ); |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
else { |
91
|
|
|
|
|
|
|
$self->pkgversion( $self->cfg->version ); |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
$self->fill_maintainer; |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
my $bin = $self->control->binary_tie->Values(0); |
97
|
|
|
|
|
|
|
$bin->short_description( $self->cfg->desc ) |
98
|
|
|
|
|
|
|
if $self->cfg->desc; |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
if ( $tarball and $tarball =~ /(?:\.tar\.gz|\.tgz)$/ ) { |
101
|
|
|
|
|
|
|
my $dest = sprintf( "%s/%s_%s.orig.tar.gz", |
102
|
|
|
|
|
|
|
dirname($tarball), $self->pkgname, $self->version ); |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
move( $tarball, $dest ) or die "move($tarball, $dest): $!"; |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
$tarball = $dest; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
# Here I init the git repo. If the upstream has a debian/ directory, this is |
110
|
|
|
|
|
|
|
# removed in a separate git commit |
111
|
|
|
|
|
|
|
$self->git_import_upstream__init_debian |
112
|
|
|
|
|
|
|
if $self->cfg->{vcs} eq 'git'; |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
# if the upstream has a debian/ directory, rename it to debian.bak so that |
115
|
|
|
|
|
|
|
# dh-make-perl can create its own debian/ directory. If we're creating a git |
116
|
|
|
|
|
|
|
# repo, the original debian/ directory was already dealt with by |
117
|
|
|
|
|
|
|
# git_import_upstream__init_debian() |
118
|
|
|
|
|
|
|
if ( -d $self->debian_dir ) { |
119
|
|
|
|
|
|
|
$self->warning( $self->debian_dir . ' already exists' ); |
120
|
|
|
|
|
|
|
my $bak = $self->debian_dir . '.bak'; |
121
|
|
|
|
|
|
|
$self->warning( "moving to $bak" ); |
122
|
|
|
|
|
|
|
if ( -d $bak ) { |
123
|
|
|
|
|
|
|
$self->warning("overwriting existing $bak"); |
124
|
|
|
|
|
|
|
File::Path::rmtree($bak); |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
rename $self->debian_dir, $bak or die $!; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
my $apt_contents = $self->get_apt_contents; |
130
|
|
|
|
|
|
|
my $src = $self->control->source; |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
$src->Testsuite('autopkgtest-pkg-perl') if $self->cfg->{pkg_perl}; |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
my @missing = $self->discover_dependencies; |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
$bin->Depends->add( $self->cfg->depends ) |
137
|
|
|
|
|
|
|
if $self->cfg->depends; |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
$src->Build_Depends->add( $self->cfg->bdepends ) |
140
|
|
|
|
|
|
|
if $self->cfg->bdepends; |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
$src->Build_Depends_Indep->add( $self->cfg->bdependsi ) |
143
|
|
|
|
|
|
|
if $self->cfg->bdependsi; |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
$self->extract_docs; |
146
|
|
|
|
|
|
|
$self->extract_examples; |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
die "Cannot find a description for the package: use the --desc switch\n" |
149
|
|
|
|
|
|
|
unless $bin->short_description; |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
print "Package does not provide a long description - ", |
152
|
|
|
|
|
|
|
" Please fill it in manually.\n" |
153
|
|
|
|
|
|
|
if ( !defined $bin->long_description |
154
|
|
|
|
|
|
|
or $bin->long_description =~ /^\s*\.?\s*$/ ) |
155
|
|
|
|
|
|
|
and $self->cfg->verbose; |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
printf( "Using maintainer: %s\n", $src->Maintainer ) |
158
|
|
|
|
|
|
|
if $self->cfg->verbose; |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
print "Found docs: @{ $self->docs }\n" if $self->cfg->verbose; |
161
|
|
|
|
|
|
|
print "Found examples: @{ $self->examples }\n" |
162
|
|
|
|
|
|
|
if @{ $self->examples } and $self->cfg->verbose; |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# start writing out the data |
165
|
|
|
|
|
|
|
mkdir( $self->debian_dir, 0755 ) |
166
|
|
|
|
|
|
|
|| die "Cannot create " . $self->debian_dir . " dir: $!\n"; |
167
|
|
|
|
|
|
|
$self->write_source_format( |
168
|
|
|
|
|
|
|
catfile( $self->debian_dir, 'source', 'format' ) ); |
169
|
|
|
|
|
|
|
$self->create_changelog( $self->debian_file('changelog'), |
170
|
|
|
|
|
|
|
$self->cfg->closes // $self->get_wnpp( $self->pkgname ) ); |
171
|
|
|
|
|
|
|
$self->create_rules; |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
# now that rules are there, see if we need some dependency for them |
174
|
|
|
|
|
|
|
$self->discover_utility_deps( $self->control ); |
175
|
|
|
|
|
|
|
$self->control->prune_perl_deps; |
176
|
|
|
|
|
|
|
$self->prune_deps; |
177
|
|
|
|
|
|
|
$src->Standards_Version( $self->debstdversion ); |
178
|
|
|
|
|
|
|
$src->Homepage( $self->upsurl ); |
179
|
|
|
|
|
|
|
if ( $self->cfg->pkg_perl ) { |
180
|
|
|
|
|
|
|
my $vcs = lc( $self->cfg->vcs ); |
181
|
|
|
|
|
|
|
if ( $vcs eq 'svn' ) { |
182
|
|
|
|
|
|
|
$self->control->source->Vcs_Svn( |
183
|
|
|
|
|
|
|
sprintf( "svn://svn.debian.org/pkg-perl/trunk/%s/", |
184
|
|
|
|
|
|
|
$self->pkgname ) |
185
|
|
|
|
|
|
|
); |
186
|
|
|
|
|
|
|
$self->control->source->Vcs_Browser( |
187
|
|
|
|
|
|
|
sprintf( "http://anonscm.debian.org/viewvc/pkg-perl/trunk/%s/", |
188
|
|
|
|
|
|
|
$self->pkgname ) |
189
|
|
|
|
|
|
|
); |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
elsif ( $vcs eq 'git' ) { |
192
|
|
|
|
|
|
|
$self->control->source->Vcs_Git( |
193
|
|
|
|
|
|
|
sprintf( "git://anonscm.debian.org/pkg-perl/packages/%s.git", |
194
|
|
|
|
|
|
|
$self->pkgname ) |
195
|
|
|
|
|
|
|
); |
196
|
|
|
|
|
|
|
$self->control->source->Vcs_Browser( |
197
|
|
|
|
|
|
|
sprintf( "https://anonscm.debian.org/cgit/pkg-perl/packages/%s.git", |
198
|
|
|
|
|
|
|
$self->pkgname ) |
199
|
|
|
|
|
|
|
); |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
else { |
202
|
|
|
|
|
|
|
warn "Version control system '$vcs' not known. Please submit a patch :)\n"; |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
$self->control->write( $self->debian_file('control') ); |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
$self->create_compat( $self->debian_file('compat') ); |
208
|
|
|
|
|
|
|
$self->create_watch( $self->debian_file('watch') ); |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
#create_readme("$debiandir/README.Debian"); |
211
|
|
|
|
|
|
|
$self->create_copyright( $self->debian_file('copyright') ); |
212
|
|
|
|
|
|
|
$self->update_file_list( docs => $self->docs, examples => $self->examples ); |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
$self->create_upstream_metadata; |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
if ( $self->cfg->recursive ) { |
217
|
|
|
|
|
|
|
$already_done //= {}; |
218
|
|
|
|
|
|
|
my $mod_name = $self->perlname; |
219
|
|
|
|
|
|
|
$mod_name =~ s/-/::/g; |
220
|
|
|
|
|
|
|
$already_done->{$mod_name} = 1; |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
for my $m (@missing) { |
223
|
|
|
|
|
|
|
next if exists $already_done->{$m}; |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
if ( $self->cfg->verbose ) { |
226
|
|
|
|
|
|
|
print "\n"; |
227
|
|
|
|
|
|
|
print "==================================\n"; |
228
|
|
|
|
|
|
|
print " recursively building $m\n"; |
229
|
|
|
|
|
|
|
print "==================================\n"; |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
my $new_cfg |
233
|
|
|
|
|
|
|
= DhMakePerl::Config->new( { %{ $self->cfg }, cpan => $m, } ); |
234
|
|
|
|
|
|
|
my $maker = $self->new( { cfg => $new_cfg } ); |
235
|
|
|
|
|
|
|
$maker->execute($already_done) |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
$self->git_add_debian($tarball) |
240
|
|
|
|
|
|
|
if $self->cfg->{vcs} eq 'git'; |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
$self->build_source_package |
243
|
|
|
|
|
|
|
if $self->cfg->build_source; |
244
|
|
|
|
|
|
|
$self->build_package |
245
|
|
|
|
|
|
|
if $self->cfg->build or $self->cfg->install; |
246
|
|
|
|
|
|
|
$self->install_package if $self->cfg->install; |
247
|
|
|
|
|
|
|
print "--- Done\n" if $self->cfg->verbose; |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
$self->package_already_exists($apt_contents) |
250
|
|
|
|
|
|
|
or $self->modules_already_packaged($apt_contents); |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
# explicitly call Debian::Rules destroy |
253
|
|
|
|
|
|
|
# this is needed because after the rename the object's |
254
|
|
|
|
|
|
|
# destroy method would update a file on a stale path |
255
|
|
|
|
|
|
|
$self->rules( undef ); |
256
|
|
|
|
|
|
|
$self->rename_to_debian_package_dir; |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
return(0); |
259
|
|
|
|
|
|
|
} |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
sub guess_debian_tarball { |
262
|
|
|
|
|
|
|
my $self = shift; |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
my $prefix = catfile( $self->main_dir, '..', |
265
|
|
|
|
|
|
|
$self->control->source->Source . '_' |
266
|
|
|
|
|
|
|
. $self->version |
267
|
|
|
|
|
|
|
. '.orig' ); |
268
|
|
|
|
|
|
|
$self->guess_tarball($prefix); |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
sub guess_tarball { |
272
|
|
|
|
|
|
|
my $self = shift; |
273
|
|
|
|
|
|
|
my $prefix = shift; |
274
|
|
|
|
|
|
|
die "guess_tarball(): Needs everything except the file type suffix as parameter" |
275
|
|
|
|
|
|
|
unless defined $prefix; |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
foreach my $compression_suffix (qw(gz bz2 xz lzma)) { |
278
|
|
|
|
|
|
|
my $try = "$prefix.tar.$compression_suffix"; |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
print "Trying $try..."; |
281
|
|
|
|
|
|
|
if ( -f $try ) { |
282
|
|
|
|
|
|
|
print " found!\n"; |
283
|
|
|
|
|
|
|
return $try; |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
else { |
286
|
|
|
|
|
|
|
print " not found.\n"; |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
return undef; |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
sub setup_dir { |
293
|
|
|
|
|
|
|
my ($self) = @_; |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
my ( $tarball ); |
296
|
|
|
|
|
|
|
if ( $self->cfg->cpan ) { |
297
|
|
|
|
|
|
|
my ( $new_maindir, $orig_pwd, $mod, $dist ); |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
# CPAN::Distribution::get() sets $ENV{'PWD'} to $CPAN::Config->{build_dir} |
300
|
|
|
|
|
|
|
# so we have to save it here |
301
|
|
|
|
|
|
|
$orig_pwd = $ENV{'PWD'}; |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
# Is the module a core module? |
304
|
|
|
|
|
|
|
if ( is_core_module( $self->cfg->cpan ) ) { |
305
|
|
|
|
|
|
|
die $self->cfg->cpan |
306
|
|
|
|
|
|
|
. " is a standard module. Will not build without --core-ok.\n" |
307
|
|
|
|
|
|
|
unless $self->cfg->core_ok; |
308
|
|
|
|
|
|
|
} |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
$self->configure_cpan; |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
if ( $mod = find_cpan_module( $self->cfg->cpan ) ) { |
313
|
|
|
|
|
|
|
$self->mod_cpan_version( $mod->cpan_version ); |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
$dist = $CPAN::META->instance( 'CPAN::Distribution', |
316
|
|
|
|
|
|
|
$mod->cpan_file ); |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
elsif ( $dist = find_cpan_distribution( $self->cfg->cpan ) ) { |
319
|
|
|
|
|
|
|
my $ver; |
320
|
|
|
|
|
|
|
if ( $dist->base_id =~ /-v?(\d[\d._]*)\./ ) { |
321
|
|
|
|
|
|
|
$self->mod_cpan_version($1); |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
else { |
324
|
|
|
|
|
|
|
die "Unable to determine the version of " |
325
|
|
|
|
|
|
|
. $dist->base_id . "\n"; |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
} |
328
|
|
|
|
|
|
|
else { |
329
|
|
|
|
|
|
|
die "Can't find '" |
330
|
|
|
|
|
|
|
. $self->cfg->cpan |
331
|
|
|
|
|
|
|
. "' module or distribution on CPAN\n"; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
$dist->get; # <- here $ENV{'PWD'} gets set to $HOME/.cpan/build |
335
|
|
|
|
|
|
|
chdir $orig_pwd; # so set it back |
336
|
|
|
|
|
|
|
$dist->pretty_id =~ /^(.)(.)/; |
337
|
|
|
|
|
|
|
$tarball = $CPAN::Config->{'keep_source_where'} . "/authors/id/$1/$1$2/"; |
338
|
|
|
|
|
|
|
# the file is under authors/id/A/AU/AUTHOR directory |
339
|
|
|
|
|
|
|
# how silly there is no $dist->filename method |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
$tarball .= $dist->pretty_id; |
342
|
|
|
|
|
|
|
$self->main_dir( $dist->dir ); |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
copy( $tarball, $orig_pwd ) or die "copy($tarball, $orig_pwd): $!"; |
345
|
|
|
|
|
|
|
$tarball = $orig_pwd . "/" . basename($tarball); |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
# build_dir contains a random part since 1.88_59 |
348
|
|
|
|
|
|
|
# use the new CPAN::Distribution::base_id (introduced in 1.91_53) |
349
|
|
|
|
|
|
|
$new_maindir = $orig_pwd . "/" . $dist->base_id; |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
# rename existing directory |
352
|
|
|
|
|
|
|
my $new_inc; |
353
|
|
|
|
|
|
|
my $rename_to = "$new_maindir.$$"; |
354
|
|
|
|
|
|
|
while (-d $rename_to) |
355
|
|
|
|
|
|
|
{ |
356
|
|
|
|
|
|
|
$new_inc++; |
357
|
|
|
|
|
|
|
$rename_to = "$new_maindir.$$-$new_inc"; |
358
|
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
|
if ( -d $new_maindir |
360
|
|
|
|
|
|
|
&& rename $new_maindir, $rename_to) |
361
|
|
|
|
|
|
|
{ |
362
|
|
|
|
|
|
|
print '=' x 70, "\n"; |
363
|
|
|
|
|
|
|
print |
364
|
|
|
|
|
|
|
"Unpacked tarball already existed, directory renamed to $rename_to\n"; |
365
|
|
|
|
|
|
|
print '=' x 70, "\n"; |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
system( "mv", $self->main_dir, "$new_maindir" ) == 0 |
368
|
|
|
|
|
|
|
or die "Failed to move " . $self->main_dir . " to $new_maindir: $!"; |
369
|
|
|
|
|
|
|
$self->main_dir($new_maindir); |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
} |
372
|
|
|
|
|
|
|
elsif ( $self->cfg->cpanplus ) { |
373
|
|
|
|
|
|
|
die "CPANPLUS support is b0rken at the moment."; |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
# my ($cb, $href, $file); |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
# eval "use CPANPLUS 0.045;"; |
378
|
|
|
|
|
|
|
# $cb = CPANPLUS::Backend->new(conf => {debug => 1, verbose => 1}); |
379
|
|
|
|
|
|
|
# $href = $cb->fetch( modules => [ $self->cfg->cpanplus ], fetchdir => $ENV{'PWD'}); |
380
|
|
|
|
|
|
|
# die "Cannot get " . $self->cfg->cpanplus . "\n" if keys(%$href) != 1; |
381
|
|
|
|
|
|
|
# $file = (values %$href)[0]; |
382
|
|
|
|
|
|
|
# print $file, "\n\n"; |
383
|
|
|
|
|
|
|
# $self->main_dir( |
384
|
|
|
|
|
|
|
# $cb->extract( files => [ $file ], extractdir => $ENV{'PWD'} )->{$file} |
385
|
|
|
|
|
|
|
# ); |
386
|
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
else { |
388
|
|
|
|
|
|
|
my $maindir = realpath( shift(@ARGV) || '.' ); |
389
|
|
|
|
|
|
|
$maindir =~ s/\/$//; |
390
|
|
|
|
|
|
|
$self->main_dir($maindir); |
391
|
|
|
|
|
|
|
my $guessed_tarball_prefix = catfile( $self->main_dir, "..", |
392
|
|
|
|
|
|
|
basename( $self->main_dir ) ); |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
$tarball = $self->guess_tarball($guessed_tarball_prefix); |
395
|
|
|
|
|
|
|
} |
396
|
|
|
|
|
|
|
return $tarball; |
397
|
|
|
|
|
|
|
} |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
sub build_package { |
400
|
|
|
|
|
|
|
my ( $self ) = @_; |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
my $main_dir = $self->main_dir; |
403
|
|
|
|
|
|
|
# uhmf! dpkg-genchanges doesn't cope with the deb being in another dir.. |
404
|
|
|
|
|
|
|
#system("dpkg-buildpackage -b -us -uc " . $self->cfg->dbflags) == 0 |
405
|
|
|
|
|
|
|
system("fakeroot make -C $main_dir -f debian/rules clean"); |
406
|
|
|
|
|
|
|
system("make -C $main_dir -f debian/rules build") == 0 |
407
|
|
|
|
|
|
|
|| die "Cannot create deb package: 'debian/rules build' failed.\n"; |
408
|
|
|
|
|
|
|
system("fakeroot make -C $main_dir -f debian/rules binary") == 0 |
409
|
|
|
|
|
|
|
|| die "Cannot create deb package: 'fakeroot debian/rules binary' failed.\n"; |
410
|
|
|
|
|
|
|
} |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
sub build_source_package { |
413
|
|
|
|
|
|
|
my ( $self ) = @_; |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
my $main_dir = $self->main_dir; |
416
|
|
|
|
|
|
|
# uhmf! dpkg-genchanges doesn't cope with the deb being in another dir.. |
417
|
|
|
|
|
|
|
#system("dpkg-buildpackage -S -us -uc " . $self->cfg->dbflags) == 0 |
418
|
|
|
|
|
|
|
system("fakeroot make -C $main_dir -f debian/rules clean"); |
419
|
|
|
|
|
|
|
system("dpkg-source -b $main_dir") == 0 |
420
|
|
|
|
|
|
|
|| die "Cannot create source package: 'dpkg-source -b' failed.\n"; |
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
sub install_package { |
424
|
|
|
|
|
|
|
my ($self) = @_; |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
my ( $archspec, $debname ); |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
my $arch = $self->control->binary_tie->Values(0)->Architecture; |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
if ( !defined $arch || $arch eq 'any' ) { |
431
|
|
|
|
|
|
|
$archspec = `dpkg --print-architecture`; |
432
|
|
|
|
|
|
|
chomp($archspec); |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
else { |
435
|
|
|
|
|
|
|
$archspec = $arch; |
436
|
|
|
|
|
|
|
} |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
$debname = sprintf( "%s_%s-1_%s.deb", $self->pkgname, $self->version, |
439
|
|
|
|
|
|
|
$archspec ); |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
my $deb = $self->main_dir . "/../$debname"; |
442
|
|
|
|
|
|
|
my $dpkg_cmd = "dpkg -i $deb"; |
443
|
|
|
|
|
|
|
$dpkg_cmd = "sudo $dpkg_cmd" if $>; |
444
|
|
|
|
|
|
|
$self->info("Running '$dpkg_cmd'..."); |
445
|
|
|
|
|
|
|
system($dpkg_cmd) == 0 |
446
|
|
|
|
|
|
|
|| die "Cannot install package $deb\n"; |
447
|
|
|
|
|
|
|
} |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
sub findbin_fix { |
450
|
|
|
|
|
|
|
my ($self) = @_; |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
# FindBin requires to know the name of the invoker - and requires it to be |
453
|
|
|
|
|
|
|
# Makefile.PL to function properly :-/ |
454
|
|
|
|
|
|
|
$0 = $self->makefile_pl(); |
455
|
|
|
|
|
|
|
if ( exists $FindBin::{Bin} ) { |
456
|
|
|
|
|
|
|
FindBin::again(); |
457
|
|
|
|
|
|
|
} |
458
|
|
|
|
|
|
|
} |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
# finds the list of modules that the distribution depends on |
461
|
|
|
|
|
|
|
# if $build_deps is true, returns build-time dependencies, otherwise |
462
|
|
|
|
|
|
|
# returns run-time dependencies |
463
|
|
|
|
|
|
|
sub run_depends { |
464
|
|
|
|
|
|
|
my ( $self, $depends_module, $build_deps ) = @_; |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
no warnings; |
467
|
|
|
|
|
|
|
local *STDERR; |
468
|
|
|
|
|
|
|
open( STDERR, ">/dev/null" ); |
469
|
|
|
|
|
|
|
my $mod_dep = $depends_module->new(); |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
$mod_dep->dist_dir( $self->main_dir ); |
472
|
|
|
|
|
|
|
$mod_dep->find_modules(); |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
my $deps = $build_deps ? $mod_dep->build_requires : $mod_dep->requires; |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
my $error = $mod_dep->error(); |
477
|
|
|
|
|
|
|
die "Error: $error\n" if $error; |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
return $deps; |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
# filter @deps to contain only one instance of each package |
483
|
|
|
|
|
|
|
# say we have te following list of dependencies: |
484
|
|
|
|
|
|
|
# libppi-perl, libppi-perl (>= 3.0), libarm-perl, libalpa-perl, libarm-perl (>= 2) |
485
|
|
|
|
|
|
|
# we want a clean list instead: |
486
|
|
|
|
|
|
|
# libalpa-perl, libarm-perl (>= 2), libppi-perl (>= 3.0) |
487
|
|
|
|
|
|
|
sub prune_deps(@) { |
488
|
|
|
|
|
|
|
my $self = shift; |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
my %deps; |
491
|
|
|
|
|
|
|
for (@_) { |
492
|
|
|
|
|
|
|
my $p = $_->pkg; |
493
|
|
|
|
|
|
|
my $v = $_->ver; |
494
|
|
|
|
|
|
|
if ( exists $deps{$p} ) { |
495
|
|
|
|
|
|
|
my $cur_ver = $deps{$p}; |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
$deps{$p} = $v |
498
|
|
|
|
|
|
|
if defined($v) |
499
|
|
|
|
|
|
|
and ( not defined($cur_ver) |
500
|
|
|
|
|
|
|
or $cur_ver < $v ); |
501
|
|
|
|
|
|
|
} |
502
|
|
|
|
|
|
|
else { |
503
|
|
|
|
|
|
|
$deps{$p} = $v; |
504
|
|
|
|
|
|
|
} |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
} |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
return map( Debian::Dependency->new( $_, $deps{$_} ), sort( keys(%deps) ) ); |
509
|
|
|
|
|
|
|
} |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
sub create_changelog { |
512
|
|
|
|
|
|
|
my ( $self, $file, $bug ) = @_; |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
my $fh = $self->_file_w($file); |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
my $closes = $bug ? " (Closes: #$bug)" : ''; |
517
|
|
|
|
|
|
|
my $changelog_dist = $self->cfg->pkg_perl ? "UNRELEASED" : "unstable"; |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
$fh->printf( "%s (%s) %s; urgency=low\n", |
520
|
|
|
|
|
|
|
$self->srcname, $self->pkgversion, $changelog_dist ); |
521
|
|
|
|
|
|
|
$fh->print("\n * Initial Release.$closes\n\n"); |
522
|
|
|
|
|
|
|
$fh->printf( " -- %s %s\n", $self->get_developer, |
523
|
|
|
|
|
|
|
email_date(time) ); |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
#$fh->print("Local variables:\nmode: debian-changelog\nEnd:\n"); |
526
|
|
|
|
|
|
|
$fh->close; |
527
|
|
|
|
|
|
|
} |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
sub create_readme { |
530
|
|
|
|
|
|
|
my ( $self, $filename ) = @_; |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
my $fh = $self->_file_w($filename); |
533
|
|
|
|
|
|
|
$fh->printf( |
534
|
|
|
|
|
|
|
"This is the debian package for the %s module. |
535
|
|
|
|
|
|
|
It was created by %s using dh-make-perl. |
536
|
|
|
|
|
|
|
", $self->perlname, $self->maintainer, |
537
|
|
|
|
|
|
|
); |
538
|
|
|
|
|
|
|
$fh->close; |
539
|
|
|
|
|
|
|
} |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
sub create_watch { |
542
|
|
|
|
|
|
|
my ( $self, $filename ) = @_; |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
my $fh = $self->_file_w($filename); |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
my $version_re = 'v?(\d[\d.-]*)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip)'; |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
$fh->printf( "version=3\n%s .*/%s-%s\$\n", |
549
|
|
|
|
|
|
|
$self->upsurl, $self->perlname, $version_re ); |
550
|
|
|
|
|
|
|
$fh->close; |
551
|
|
|
|
|
|
|
} |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
sub search_pkg_perl { |
554
|
|
|
|
|
|
|
my $self = shift; |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
return undef unless $self->cfg->network; |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
my $pkg = $self->pkgname; |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
require LWP::UserAgent; |
561
|
|
|
|
|
|
|
require LWP::ConnCache; |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
my ( $ua, $resp ); |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
$ua = LWP::UserAgent->new; |
566
|
|
|
|
|
|
|
$ua->env_proxy; |
567
|
|
|
|
|
|
|
$ua->conn_cache( LWP::ConnCache->new ); |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
$resp = $ua->get( |
570
|
|
|
|
|
|
|
"https://anonscm.debian.org/cgit/pkg-perl/packages/$pkg.git"); |
571
|
|
|
|
|
|
|
return { url => $resp->request->uri } |
572
|
|
|
|
|
|
|
if $resp->is_success; |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
$resp = $ua->get( |
575
|
|
|
|
|
|
|
"https://anonscm.debian.org/cgit/pkg-perl/attic/$pkg.git"); |
576
|
|
|
|
|
|
|
return { url => $resp->request->uri } |
577
|
|
|
|
|
|
|
if $resp->is_success; |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
return undef; |
580
|
|
|
|
|
|
|
} |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
sub rename_to_debian_package_dir { |
583
|
|
|
|
|
|
|
my( $self ) = @_; |
584
|
|
|
|
|
|
|
return unless $self->cfg->cpan; |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
my $maindir = $self->main_dir; |
587
|
|
|
|
|
|
|
my $newmaindir = catdir( $maindir, updir(), $self->pkgname ); |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
if( -d $newmaindir ) { |
590
|
|
|
|
|
|
|
warn "$newmaindir already exists, skipping rename"; |
591
|
|
|
|
|
|
|
return; |
592
|
|
|
|
|
|
|
} |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
rename $maindir, $newmaindir or die "rename failed: $self->main_dir to $newmaindir"; |
595
|
|
|
|
|
|
|
$self->main_dir( $newmaindir ); |
596
|
|
|
|
|
|
|
return; |
597
|
|
|
|
|
|
|
} |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
sub package_already_exists { |
600
|
|
|
|
|
|
|
my( $self, $apt_contents ) = @_; |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
my $found; |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
eval { |
605
|
|
|
|
|
|
|
my $apt_cache = AptPkg::Cache->new; |
606
|
|
|
|
|
|
|
$found = $apt_cache->packages->lookup( $self->pkgname ) |
607
|
|
|
|
|
|
|
if $apt_cache; |
608
|
|
|
|
|
|
|
}; |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
warn "Error initializing AptPkg::Cache: $@" if $@; |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
if ($found) { |
613
|
|
|
|
|
|
|
warn "**********\n"; |
614
|
|
|
|
|
|
|
warn "WARNING: a package named\n"; |
615
|
|
|
|
|
|
|
warn " '" . $self->pkgname ."'\n"; |
616
|
|
|
|
|
|
|
warn " is already available in APT repositories\n"; |
617
|
|
|
|
|
|
|
warn "Maintainer: ", $found->{Maintainer}, "\n"; |
618
|
|
|
|
|
|
|
my $short_desc = (split( /\n/, $found->{LongDesc} ))[0]; |
619
|
|
|
|
|
|
|
warn "Description: $short_desc\n"; |
620
|
|
|
|
|
|
|
} |
621
|
|
|
|
|
|
|
elsif ($apt_contents) { |
622
|
|
|
|
|
|
|
$found = $apt_contents->find_perl_module_package( $self->perlname ); |
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
if ($found) { |
625
|
|
|
|
|
|
|
( my $mod_name = $self->perlname ) =~ s/-/::/g; |
626
|
|
|
|
|
|
|
warn "**********\n"; |
627
|
|
|
|
|
|
|
warn "NOTICE: the package '$found', available in APT repositories\n"; |
628
|
|
|
|
|
|
|
warn " already contains a module named " |
629
|
|
|
|
|
|
|
. $self->perlname . "\n"; |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
elsif ( $found = $self->search_pkg_perl ) { |
632
|
|
|
|
|
|
|
warn "********************\n"; |
633
|
|
|
|
|
|
|
warn sprintf( |
634
|
|
|
|
|
|
|
"The Debian Perl Group has a repository for the %s package\n at %s\n", |
635
|
|
|
|
|
|
|
$self->pkgname, $found->{url} ); |
636
|
|
|
|
|
|
|
warn "You may want to contact them to avoid duplication of effort.\n"; |
637
|
|
|
|
|
|
|
warn "More information is available at https://wiki.debian.org/Teams/DebianPerlGroup\n"; |
638
|
|
|
|
|
|
|
} |
639
|
|
|
|
|
|
|
} |
640
|
|
|
|
|
|
|
else { |
641
|
|
|
|
|
|
|
( my $mod_name = $self->perlname ) =~ s/-/::/g; |
642
|
|
|
|
|
|
|
require Debian::DpkgLists; |
643
|
|
|
|
|
|
|
my @found = Debian::DpkgLists->scan_perl_mod($mod_name); |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
if (@found) { |
646
|
|
|
|
|
|
|
warn "**********\n"; |
647
|
|
|
|
|
|
|
warn "NOTICE: the following locally installed package(s) already\n"; |
648
|
|
|
|
|
|
|
warn " contain $mod_name\n"; |
649
|
|
|
|
|
|
|
warn " ", join ( ', ', @found ), "\n"; |
650
|
|
|
|
|
|
|
$found = 1; |
651
|
|
|
|
|
|
|
} |
652
|
|
|
|
|
|
|
} |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
return $found ? 1 : 0; |
655
|
|
|
|
|
|
|
} |
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
sub modules_already_packaged { |
658
|
|
|
|
|
|
|
my( $self, $apt_contents ) = @_; |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
my @modules; |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
File::Find::find( |
663
|
|
|
|
|
|
|
sub { |
664
|
|
|
|
|
|
|
if (basename($File::Find::dir) |
665
|
|
|
|
|
|
|
=~ /^(?: |
666
|
|
|
|
|
|
|
\.(?:git|svn|hg|) |
667
|
|
|
|
|
|
|
|CVS |
668
|
|
|
|
|
|
|
|eg|samples?|examples? |
669
|
|
|
|
|
|
|
|t|xt |
670
|
|
|
|
|
|
|
|inc|privinc |
671
|
|
|
|
|
|
|
)$/x |
672
|
|
|
|
|
|
|
) |
673
|
|
|
|
|
|
|
{ |
674
|
|
|
|
|
|
|
$File::Find::prune = 1; |
675
|
|
|
|
|
|
|
return; |
676
|
|
|
|
|
|
|
} |
677
|
|
|
|
|
|
|
if (/.+\.pm$/) { |
678
|
|
|
|
|
|
|
my $mi = Module::Metadata->new_from_file($_); |
679
|
|
|
|
|
|
|
push @modules, $mi->packages_inside; |
680
|
|
|
|
|
|
|
} |
681
|
|
|
|
|
|
|
}, |
682
|
|
|
|
|
|
|
$self->main_dir, |
683
|
|
|
|
|
|
|
); |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
my $found; |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
sub show_notice($$) { |
688
|
|
|
|
|
|
|
warn $_[0] unless $_[1]; |
689
|
|
|
|
|
|
|
$_[1] = 1; |
690
|
|
|
|
|
|
|
} |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
my $notice = <
|
693
|
|
|
|
|
|
|
*** Notice *** |
694
|
|
|
|
|
|
|
Some of the modules in the newly created package are already present |
695
|
|
|
|
|
|
|
in other packages. |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
EOF |
698
|
|
|
|
|
|
|
my $notice_shown = 0; |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
for my $mod (@modules) { |
701
|
|
|
|
|
|
|
if ($apt_contents) { |
702
|
|
|
|
|
|
|
$found = $apt_contents->find_perl_module_package($mod); |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
if ($found) { |
705
|
|
|
|
|
|
|
show_notice( $notice, $notice_shown ); |
706
|
|
|
|
|
|
|
warn " $mod is in '$found' (APT)\n"; |
707
|
|
|
|
|
|
|
} |
708
|
|
|
|
|
|
|
} |
709
|
|
|
|
|
|
|
if ( !$found ) { |
710
|
|
|
|
|
|
|
require Debian::DpkgLists; |
711
|
|
|
|
|
|
|
my @found = Debian::DpkgLists->scan_perl_mod($mod); |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
if (@found) { |
714
|
|
|
|
|
|
|
show_notice( $notice, $notice_shown ); |
715
|
|
|
|
|
|
|
warn " $mod is in " . join( ', ', @found ), " (local .deb)\n"; |
716
|
|
|
|
|
|
|
$found = 1; |
717
|
|
|
|
|
|
|
} |
718
|
|
|
|
|
|
|
} |
719
|
|
|
|
|
|
|
} |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
warn "\n" if $notice_shown; |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
return $found ? 1 : 0; |
724
|
|
|
|
|
|
|
} |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
sub reset_git_environment { |
727
|
|
|
|
|
|
|
# The Git environment variables may be set from previous iterations |
728
|
|
|
|
|
|
|
# of this program being run. In this case, it's possible that the |
729
|
|
|
|
|
|
|
# Git module will use these to point to the wrong source tree. |
730
|
|
|
|
|
|
|
delete $ENV{'GIT_DIR'}; |
731
|
|
|
|
|
|
|
delete $ENV{'GIT_WORK_TREE'}; |
732
|
|
|
|
|
|
|
} |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
sub git_import_upstream__init_debian { |
735
|
|
|
|
|
|
|
my ( $self ) = @_; |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
require Git; |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
$self->reset_git_environment(); |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
Git::command( 'init', $self->main_dir ); |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
my $git = Git->repository( $self->main_dir ); |
744
|
|
|
|
|
|
|
$git->command( qw(symbolic-ref HEAD refs/heads/upstream) ); |
745
|
|
|
|
|
|
|
$git->command( 'add', '.' ); |
746
|
|
|
|
|
|
|
$git->command( 'commit', '-m', |
747
|
|
|
|
|
|
|
"Import original source of " |
748
|
|
|
|
|
|
|
. $self->perlname . ' ' |
749
|
|
|
|
|
|
|
. $self->version ); |
750
|
|
|
|
|
|
|
$git->command( 'tag', "upstream/".$self->version, 'upstream' ); |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
$git->command( qw( checkout -b master upstream ) ); |
753
|
|
|
|
|
|
|
if ( -d $self->debian_dir ) { |
754
|
|
|
|
|
|
|
# remove debian/ directory if the upstream ships it. This goes into the |
755
|
|
|
|
|
|
|
# 'master' branch, so the 'upstream' branch contains the original debian/ |
756
|
|
|
|
|
|
|
# directory, and thus matches the pristine-tar. Here I also remove the |
757
|
|
|
|
|
|
|
# debian/ directory from the working tree; git has the history, so I don't |
758
|
|
|
|
|
|
|
# need the debian.bak |
759
|
|
|
|
|
|
|
$git->command( 'rm', '-r', $self->debian_dir ); |
760
|
|
|
|
|
|
|
$git->command( 'commit', '-m', |
761
|
|
|
|
|
|
|
'Removed debian directory embedded in upstream source' ); |
762
|
|
|
|
|
|
|
} |
763
|
|
|
|
|
|
|
} |
764
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
sub git_add_debian { |
766
|
|
|
|
|
|
|
my ( $self, $tarball ) = @_; |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
require Git; |
769
|
|
|
|
|
|
|
require File::Which; |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
$self->reset_git_environment; |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
my $git = Git->repository( $self->main_dir ); |
774
|
|
|
|
|
|
|
$git->command( 'add', 'debian' ); |
775
|
|
|
|
|
|
|
$git->command( 'commit', '-m', |
776
|
|
|
|
|
|
|
"Initial packaging by dh-make-perl $VERSION" ); |
777
|
|
|
|
|
|
|
$git->command( |
778
|
|
|
|
|
|
|
qw( remote add origin ), |
779
|
|
|
|
|
|
|
sprintf( "ssh://git.debian.org/git/pkg-perl/packages/%s.git", |
780
|
|
|
|
|
|
|
$self->pkgname ), |
781
|
|
|
|
|
|
|
) if $self->cfg->pkg_perl; |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
if ( File::Which::which('pristine-tar') ) { |
784
|
|
|
|
|
|
|
if ( $tarball and -f $tarball ) { |
785
|
|
|
|
|
|
|
$ENV{GIT_DIR} = File::Spec->catdir( $self->main_dir, '.git' ); |
786
|
|
|
|
|
|
|
system( 'pristine-tar', 'commit', $tarball, "upstream/".$self->version ) >= 0 |
787
|
|
|
|
|
|
|
or warn "error running pristine-tar: $!\n"; |
788
|
|
|
|
|
|
|
} |
789
|
|
|
|
|
|
|
else { |
790
|
|
|
|
|
|
|
die "No tarball found to handle with pristine-tar. Bailing out." |
791
|
|
|
|
|
|
|
} |
792
|
|
|
|
|
|
|
} |
793
|
|
|
|
|
|
|
else { |
794
|
|
|
|
|
|
|
warn "W: pristine-tar not available. Please run\n"; |
795
|
|
|
|
|
|
|
warn "W: apt-get install pristine-tar\n"; |
796
|
|
|
|
|
|
|
warn "W: followed by\n"; |
797
|
|
|
|
|
|
|
warn "W: pristine-tar commit $tarball upstream/" |
798
|
|
|
|
|
|
|
. $self->version . "\n"; |
799
|
|
|
|
|
|
|
} |
800
|
|
|
|
|
|
|
} |
801
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
=item warning I ... |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
In verbose mode, prints supplied arguments on STDERR, prepended with C and |
805
|
|
|
|
|
|
|
suffixed with a new line. |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
Does nothing in non-verbose mode. |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
=cut |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
sub warning { |
812
|
|
|
|
|
|
|
my $self = shift; |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
return unless $self->cfg->verbose; |
815
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
warn "W: ", @_, "\n"; |
817
|
|
|
|
|
|
|
} |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
=item info I ... |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
In verbose mode, prints supplied arguments on STDERR, prepended with C and |
822
|
|
|
|
|
|
|
suffixed with a new line. |
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
Does nothing in non-verbose mode. |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
=cut |
827
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
sub info { |
829
|
|
|
|
|
|
|
my $self = shift; |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
return unless $self->cfg->verbose; |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
warn "I: ", @_, "\n"; |
834
|
|
|
|
|
|
|
} |
835
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
=back |
837
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
=head1 AUTHOR |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
dh-make-perl was created by Paolo Molaro. |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
It is currently maintained by Gunnar Wolf and others, under the umbrella of the |
843
|
|
|
|
|
|
|
Debian Perl Group |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
=head1 BUGS |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
Please report any bugs or feature requests to the Debian Bug Tracking System |
848
|
|
|
|
|
|
|
(L, use I as package name) or to the |
849
|
|
|
|
|
|
|
L mailing list. |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
=head1 SUPPORT |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
perldoc DhMakePerl |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
You can also look for information at: |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
=over 4 |
860
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
=item * Debian Bugtracking System |
862
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
L |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
=back |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
=over 4 |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
=item Copyright (C) 2000, 2001 Paolo Molaro |
874
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
=item Copyright (C) 2002, 2003, 2008 Ivan Kohler |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
=item Copyright (C) 2003, 2004 Marc 'HE' Brockschmidt |
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
=item Copyright (C) 2005-2007 Gunnar Wolf |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
=item Copyright (C) 2006 Frank Lichtenheld |
882
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
=item Copyright (C) 2007-2014 Gregor Herrmann |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
=item Copyright (C) 2007,2008,2009,2010,2011,2012,2015 Damyan Ivanov |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
=item Copyright (C) 2008, Roberto C. Sanchez |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
=item Copyright (C) 2009-2010, Salvatore Bonaccorso |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
=item Copyright (C) 2013, Axel Beckert |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
=back |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it under |
896
|
|
|
|
|
|
|
the terms of the GNU General Public License version 2 as published by the Free |
897
|
|
|
|
|
|
|
Software Foundation. |
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful, but WITHOUT ANY |
900
|
|
|
|
|
|
|
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A |
901
|
|
|
|
|
|
|
PARTICULAR PURPOSE. See the GNU General Public License for more details. |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
You should have received a copy of the GNU General Public License along with |
904
|
|
|
|
|
|
|
this program; if not, write to the Free Software Foundation, Inc., 51 Franklin |
905
|
|
|
|
|
|
|
Street, Fifth Floor, Boston, MA 02110-1301 USA. |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
=cut |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
1; # End of DhMakePerl |