|
27
by Ubuntu Archive
add chdist from devscripts 2.11.1ubuntu5 |
1 |
#!/usr/bin/perl
|
2 |
||
3 |
# Debian GNU/Linux chdist. Copyright (C) 2007 Lucas Nussbaum and Luk Claes.
|
|
4 |
#
|
|
5 |
# This program is free software; you can redistribute it and/or modify
|
|
6 |
# it under the terms of the GNU General Public License as published by
|
|
7 |
# the Free Software Foundation; either version 2 of the License, or
|
|
8 |
# (at your option) any later version.
|
|
9 |
#
|
|
10 |
# This program is distributed in the hope that it will be useful,
|
|
11 |
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
12 |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
13 |
# GNU General Public License for more details.
|
|
14 |
#
|
|
15 |
# You should have received a copy of the GNU General Public License
|
|
16 |
# along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
17 |
||
18 |
=head1 NAME
|
|
19 |
||
20 |
chdist - script to easily play with several distributions
|
|
21 |
||
22 |
=head1 SYNOPSIS
|
|
23 |
||
24 |
B<chdist> [I<options>] [I<command>] [I<command parameters>]
|
|
25 |
||
26 |
=head1 DESCRIPTION
|
|
27 |
||
28 |
B<chdist> is a rewrite of what used to be known as 'MultiDistroTools'
|
|
29 |
(or mdt). Its use is to create 'APT trees' for several distributions,
|
|
30 |
making it easy to query the status of packages in other distribution
|
|
31 |
without using chroots, for instance.
|
|
32 |
||
33 |
=head1 OPTIONS
|
|
34 |
||
35 |
=over 4
|
|
36 |
||
37 |
=item B<-h>, B<--help>
|
|
38 |
||
39 |
Provide a usage message.
|
|
40 |
||
41 |
=item B<-d>, B<--data-dir> I<DIR>
|
|
42 |
||
43 |
Choose data directory (default: F<$HOME/.chdist/>).
|
|
44 |
||
45 |
=item B<-a>, B<--arch> I<ARCH>
|
|
46 |
||
47 |
Choose architecture (default: `B<dpkg --print-architecture>`).
|
|
48 |
||
49 |
=item B<--version>
|
|
50 |
||
51 |
Display version information.
|
|
52 |
||
53 |
=back
|
|
54 |
||
55 |
=head1 COMMANDS
|
|
56 |
||
57 |
=over 4
|
|
58 |
||
59 |
=item B<create> I<DIST> [I<URL> I<RELEASE> I<SECTIONS>]
|
|
60 |
||
61 |
Prepare a new tree named I<DIST>
|
|
62 |
||
63 |
=item B<apt-get> I<DIST> <B<update>|B<source>|...>
|
|
64 |
||
65 |
Run B<apt-get> inside I<DIST>
|
|
66 |
||
67 |
=item B<apt-cache> I<DIST> <B<show>|B<showsrc>|...>
|
|
68 |
||
69 |
Run B<apt-cache> inside I<DIST>
|
|
70 |
||
71 |
=item B<apt-rdepends> I<DIST> [...]
|
|
72 |
||
73 |
Run B<apt-rdepends> inside I<DIST>
|
|
74 |
||
75 |
=item B<src2bin> I<DIST SRCPKG>
|
|
76 |
||
77 |
List binary packages for I<SRCPKG> in I<DIST>
|
|
78 |
||
79 |
=item B<bin2src> I<DIST BINPKG>
|
|
80 |
||
81 |
List source package for I<BINPKG> in I<DIST>
|
|
82 |
||
83 |
=item B<compare-packages> I<DIST1 DIST2> [I<DIST3>, ...]
|
|
84 |
||
85 |
=item B<compare-bin-packages> I<DIST1 DIST2> [I<DIST3>, ...]
|
|
86 |
||
87 |
List versions of packages in several I<DIST>ributions
|
|
88 |
||
89 |
=item B<compare-versions> I<DIST1 DIST2>
|
|
90 |
||
91 |
=item B<compare-bin-versions> I<DIST1 DIST2>
|
|
92 |
||
93 |
Same as B<compare-packages>/B<compare-bin-packages>, but also runs
|
|
94 |
B<dpkg --compare-versions> and display where the package is newer.
|
|
95 |
||
96 |
=item B<compare-src-bin-packages> I<DIST>
|
|
97 |
||
98 |
Compare sources and binaries for I<DIST>
|
|
99 |
||
100 |
=item B<compare-src-bin-versions> I<DIST>
|
|
101 |
||
102 |
Same as B<compare-src-bin-packages>, but also run B<dpkg --compare-versions>
|
|
103 |
and display where the package is newer
|
|
104 |
||
105 |
=item B<grep-dctrl-packages> I<DIST> [...]
|
|
106 |
||
107 |
Run B<grep-dctrl> on F<*_Packages> inside I<DIST>
|
|
108 |
||
109 |
=item B<grep-dctrl-sources> I<DIST> [...]
|
|
110 |
||
111 |
Run B<grep-dctrl> on F<*_Sources> inside I<DIST>
|
|
112 |
||
113 |
=item B<list>
|
|
114 |
||
115 |
List available I<DIST>s
|
|
116 |
||
117 |
=back
|
|
118 |
||
119 |
=head1 COPYRIGHT
|
|
120 |
||
121 |
This program is copyright 2007 by Lucas Nussbaum and Luk Claes. This
|
|
122 |
program comes with ABSOLUTELY NO WARRANTY.
|
|
123 |
||
124 |
It is licensed under the terms of the GPL, either version 2 of the
|
|
125 |
License, or (at your option) any later version.
|
|
126 |
||
127 |
=cut
|
|
128 |
||
129 |
use strict; |
|
130 |
use warnings; |
|
131 |
use feature 'switch'; |
|
132 |
use File::Copy qw(cp); |
|
133 |
use File::Path qw(make_path); |
|
134 |
use File::Basename; |
|
135 |
use Getopt::Long qw(:config require_order); |
|
136 |
use Cwd qw(abs_path cwd); |
|
137 |
use Dpkg::Version; |
|
138 |
use Pod::Usage; |
|
|
254
by Adam Conrad
chdist: Commit production hack to avoid perl warnings. |
139 |
# Stop warning about 'when' and 'given':
|
140 |
no warnings 'experimental::smartmatch'; |
|
|
27
by Ubuntu Archive
add chdist from devscripts 2.11.1ubuntu5 |
141 |
|
142 |
# Redefine Pod::Text's cmd_i so pod2usage converts I<...> to <...> instead of
|
|
143 |
# *...*
|
|
144 |
{
|
|
145 |
package Pod::Text; |
|
146 |
no warnings qw(redefine); |
|
147 |
||
148 |
sub cmd_i { '<'. $_[2] . '>' } |
|
149 |
}
|
|
150 |
||
151 |
my $progname = basename($0); |
|
152 |
||
153 |
sub usage { |
|
154 |
pod2usage(-verbose => 99, |
|
155 |
-exitval => $_[0], |
|
156 |
-sections => 'SYNOPSIS|OPTIONS|ARGUMENTS|COMMANDS'); |
|
157 |
}
|
|
158 |
||
159 |
# specify the options we accept and initialize
|
|
160 |
# the option parser
|
|
161 |
my $help = ''; |
|
162 |
||
163 |
my $version = ''; |
|
164 |
my $versioninfo = <<"EOF"; |
|
165 |
This is $progname, from the Debian devscripts package, version
|
|
166 |
2.11.1ubuntu5 This code is copyright 2007 by Lucas Nussbaum and Luk
|
|
167 |
Claes. This program comes with ABSOLUTELY NO WARRANTY. You are free
|
|
168 |
to redistribute this code under the terms of the GNU General Public
|
|
169 |
License, version 2 or (at your option) any later version.
|
|
170 |
EOF
|
|
171 |
||
172 |
my $arch; |
|
173 |
my $datadir = $ENV{'HOME'} . '/.chdist'; |
|
174 |
||
175 |
GetOptions( |
|
176 |
"help" => \$help, |
|
177 |
"data-dir=s" => \$datadir, |
|
178 |
"arch=s" => \$arch, |
|
179 |
"version" => \$version, |
|
180 |
);
|
|
181 |
||
182 |
# Fix-up relative paths
|
|
183 |
$datadir = cwd() . "/$datadir" if $datadir !~ m!^/!; |
|
184 |
$datadir = abs_path($datadir); |
|
185 |
||
186 |
if ($help) { |
|
187 |
usage(0); |
|
188 |
}
|
|
189 |
||
190 |
if ($version) { |
|
191 |
print $versioninfo; |
|
192 |
exit 0; |
|
193 |
}
|
|
194 |
||
195 |
||
196 |
########################################################
|
|
197 |
### Functions
|
|
198 |
########################################################
|
|
199 |
||
200 |
sub fatal |
|
201 |
{
|
|
202 |
my ($msg) = @_; |
|
203 |
print STDERR "$progname: $msg"; |
|
204 |
exit 1; |
|
205 |
}
|
|
206 |
||
207 |
sub uniq (@) { |
|
208 |
my %hash; |
|
209 |
map { $hash{$_}++ == 0 ? $_ : () } @_; |
|
210 |
}
|
|
211 |
||
212 |
sub dist_check { |
|
213 |
# Check that dist exists in $datadir
|
|
214 |
my ($dist) = @_; |
|
215 |
if ($dist) { |
|
216 |
my $dir = "$datadir/$dist"; |
|
217 |
return 0 if (-d $dir); |
|
218 |
fatal("Could not find $dist in $datadir. Run `$progname create $dist` first."); |
|
219 |
}
|
|
220 |
else { |
|
221 |
fatal('No dist provided.'); |
|
222 |
}
|
|
223 |
}
|
|
224 |
||
225 |
sub type_check { |
|
226 |
my ($type) = @_; |
|
227 |
if (($type ne 'Sources') && ($type ne 'Packages')) { |
|
228 |
fatal("Unknown type $type."); |
|
229 |
}
|
|
230 |
}
|
|
231 |
||
232 |
sub aptopts |
|
233 |
{
|
|
234 |
# Build apt options
|
|
235 |
my ($dist) = @_; |
|
236 |
my @opts = (); |
|
237 |
if ($arch) { |
|
238 |
print "W: Forcing arch $arch for this command only.\n"; |
|
239 |
push(@opts, '-o', "Apt::Architecture=$arch"); |
|
240 |
}
|
|
241 |
return @opts; |
|
242 |
}
|
|
243 |
||
244 |
sub aptconfig |
|
245 |
{
|
|
246 |
# Build APT_CONFIG override
|
|
247 |
my ($dist) = @_; |
|
248 |
my $aptconf = "$datadir/$dist/etc/apt/apt.conf"; |
|
249 |
if (! -r $aptconf) { |
|
250 |
fatal("Unable to read $aptconf"); |
|
251 |
}
|
|
252 |
$ENV{'APT_CONFIG'} = $aptconf; |
|
253 |
}
|
|
254 |
||
255 |
###
|
|
256 |
||
257 |
sub aptcmd |
|
258 |
{
|
|
259 |
my ($cmd, $dist, @args) = @_; |
|
260 |
dist_check($dist); |
|
261 |
unshift(@args, aptopts($dist)); |
|
262 |
aptconfig($dist); |
|
263 |
exec($cmd, @args); |
|
264 |
}
|
|
265 |
||
266 |
sub bin2src |
|
267 |
{
|
|
268 |
my ($dist, $pkg) = @_; |
|
269 |
dist_check($dist); |
|
270 |
if (!defined($pkg)) { |
|
271 |
fatal("No package name provided. Exiting."); |
|
272 |
}
|
|
273 |
my @args = (aptopts($dist), 'show', $pkg); |
|
274 |
aptconfig($dist); |
|
275 |
my $src = $pkg; |
|
276 |
my $pid = open(CACHE, '-|', 'apt-cache', @args); |
|
277 |
if (!defined($pid)) { |
|
278 |
fatal("Couldn't run apt-cache: $!"); |
|
279 |
}
|
|
280 |
if ($pid) { |
|
281 |
while (<CACHE>) { |
|
282 |
if (m/^Source: (.*)/) { |
|
283 |
$src = $1; |
|
284 |
last; |
|
285 |
}
|
|
286 |
}
|
|
287 |
close CACHE || fatal("bad apt-cache $!: $?"); |
|
288 |
print "$src\n"; |
|
289 |
}
|
|
290 |
}
|
|
291 |
||
292 |
sub src2bin { |
|
293 |
my ($dist, $pkg) = @_; |
|
294 |
dist_check($dist); |
|
295 |
if (!defined($pkg)) { |
|
296 |
fatal("no package name provided. Exiting."); |
|
297 |
}
|
|
298 |
my @args = (aptopts($dist), 'showsrc', $pkg); |
|
299 |
my $pid = open(CACHE, '-|', 'apt-cache', @args); |
|
300 |
if (!defined($pid)) { |
|
301 |
fatal("Couldn't run apt-cache: $!"); |
|
302 |
}
|
|
303 |
if ($pid) { |
|
304 |
while (<CACHE>) { |
|
305 |
if (m/^Binary: (.*)/) { |
|
306 |
print join("\n", split(/, /, $1)) . "\n"; |
|
307 |
last; |
|
308 |
}
|
|
309 |
}
|
|
310 |
close CACHE || fatal("bad apt-cache $!: $?"); |
|
311 |
}
|
|
312 |
}
|
|
313 |
||
314 |
sub dist_create |
|
315 |
{
|
|
316 |
my ($dist, $method, $version, @sections) = @_; |
|
317 |
if (!defined($dist)) { |
|
318 |
fatal("you must provide a dist name."); |
|
319 |
}
|
|
320 |
my $dir = "$datadir/$dist"; |
|
321 |
if (-d $dir) { |
|
322 |
fatal("$dir already exists, exiting."); |
|
323 |
}
|
|
324 |
make_path($datadir); |
|
325 |
foreach my $d (('/etc/apt', '/etc/apt/apt.conf.d', '/etc/apt/preferences.d', |
|
326 |
'/etc/apt/trusted.gpg.d', '/var/lib/apt/lists/partial', |
|
327 |
'/var/cache/apt/archives/partial', '/var/lib/dpkg')) { |
|
328 |
make_path("$dir/$d"); |
|
329 |
}
|
|
330 |
||
331 |
# Create sources.list
|
|
332 |
open(FH, '>', "$dir/etc/apt/sources.list"); |
|
333 |
if ($version) { |
|
334 |
# Use provided method, version and sections
|
|
335 |
my $sections_str = join(' ', @sections); |
|
336 |
print FH <<EOF; |
|
337 |
deb $method $version $sections_str
|
|
338 |
deb-src $method $version $sections_str
|
|
339 |
EOF
|
|
340 |
}
|
|
341 |
else { |
|
342 |
if ($method) { |
|
343 |
warn "W: method provided without a section. Using default content for sources.list\n"; |
|
344 |
}
|
|
345 |
# Fill in sources.list with example contents
|
|
346 |
print FH <<EOF; |
|
347 |
#deb http://ftp.debian.org/debian/ unstable main contrib non-free
|
|
348 |
#deb-src http://ftp.debian.org/debian/ unstable main contrib non-free
|
|
349 |
||
350 |
#deb http://archive.ubuntu.com/ubuntu dapper main restricted
|
|
351 |
#deb http://archive.ubuntu.com/ubuntu dapper universe multiverse
|
|
352 |
#deb-src http://archive.ubuntu.com/ubuntu dapper main restricted
|
|
353 |
#deb-src http://archive.ubuntu.com/ubuntu dapper universe multiverse
|
|
354 |
EOF
|
|
355 |
}
|
|
356 |
close FH; |
|
357 |
# Create dpkg status
|
|
358 |
open(FH, '>', "$dir/var/lib/dpkg/status"); |
|
359 |
close FH; #empty file |
|
360 |
# Create apt.conf
|
|
361 |
$arch ||= `dpkg --print-architecture`; |
|
362 |
chomp $arch; |
|
363 |
open(FH, ">$dir/etc/apt/apt.conf"); |
|
364 |
print FH <<EOF; |
|
365 |
Apt {
|
|
366 |
Architecture "$arch";
|
|
367 |
};
|
|
368 |
||
369 |
Dir "$dir";
|
|
370 |
Dir::State::status "$dir/var/lib/dpkg/status";
|
|
371 |
EOF
|
|
372 |
close FH; |
|
373 |
foreach my $keyring (qw(debian-archive-keyring.gpg |
|
374 |
debian-archive-removed-keys.gpg
|
|
375 |
ubuntu-archive-keyring.gpg
|
|
376 |
ubuntu-archive-removed-keys.gpg)) { |
|
377 |
cp("/usr/share/keyrings/$keyring", "$dir/etc/apt/trusted.gpg.d/"); |
|
378 |
}
|
|
379 |
print "Now edit $dir/etc/apt/sources.list\n" unless $version; |
|
380 |
print "Run chdist apt-get $dist update\n"; |
|
381 |
print "And enjoy.\n"; |
|
382 |
}
|
|
383 |
||
384 |
||
385 |
||
386 |
sub get_distfiles { |
|
387 |
# Retrieve files to be read
|
|
388 |
# Takes a dist and a type
|
|
389 |
my ($dist, $type) = @_; |
|
390 |
||
391 |
my @files; |
|
392 |
||
393 |
foreach my $file ( glob($datadir . '/' . $dist . "/var/lib/apt/lists/*_$type") ) { |
|
394 |
if ( -f $file ) { |
|
395 |
push @files, $file; |
|
396 |
}
|
|
397 |
}
|
|
398 |
||
399 |
return \@files; |
|
400 |
}
|
|
401 |
||
402 |
||
403 |
sub dist_compare(\@$$) { |
|
404 |
# Takes a list of dists, a type of comparison and a do_compare flag
|
|
405 |
my ($dists, $do_compare, $type) = @_; |
|
406 |
type_check($type); |
|
407 |
||
408 |
# Get the list of dists from the referrence
|
|
409 |
my @dists = @$dists; |
|
410 |
map { dist_check($_) } @dists; |
|
411 |
||
412 |
# Get all packages
|
|
413 |
my %packages; |
|
414 |
||
415 |
foreach my $dist (@dists) { |
|
416 |
my $files = get_distfiles($dist,$type); |
|
417 |
my @files = @$files; |
|
418 |
foreach my $file ( @files ) { |
|
419 |
my $parsed_file = parseFile($file); |
|
420 |
foreach my $package ( keys(%{$parsed_file}) ) { |
|
421 |
if ( $packages{$dist}{$package} ) { |
|
422 |
warn "W: Package $package is already listed for $dist. Not overriding.\n"; |
|
423 |
} else { |
|
424 |
$packages{$dist}{$package} = $parsed_file->{$package}; |
|
425 |
}
|
|
426 |
}
|
|
427 |
}
|
|
428 |
}
|
|
429 |
||
430 |
# Get entire list of packages
|
|
431 |
my @all_packages = uniq sort ( map { keys(%{$packages{$_}}) } @dists ); |
|
432 |
||
433 |
foreach my $package (@all_packages) { |
|
434 |
my $line = "$package "; |
|
435 |
my $status = ""; |
|
436 |
my $details; |
|
437 |
||
438 |
foreach my $dist (@dists) { |
|
439 |
if ( $packages{$dist}{$package} ) { |
|
440 |
$line .= "$packages{$dist}{$package}{'Version'} "; |
|
441 |
} else { |
|
442 |
$line .= "UNAVAIL "; |
|
443 |
$status = "not_in_$dist"; |
|
444 |
}
|
|
445 |
}
|
|
446 |
||
447 |
my @versions = map { $packages{$_}{$package}{'Version'} } @dists; |
|
448 |
# Escaped versions
|
|
449 |
my @esc_vers = @versions; |
|
450 |
foreach my $vers (@esc_vers) { |
|
451 |
$vers =~ s|\+|\\\+|; |
|
452 |
}
|
|
453 |
||
454 |
# Do compare
|
|
455 |
if ($do_compare) { |
|
456 |
if (!@dists) { |
|
457 |
fatal('Can only compare versions if there are two distros.'); |
|
458 |
}
|
|
459 |
if (!$status) { |
|
460 |
my $cmp = version_compare($versions[0], $versions[1]); |
|
461 |
if (!$cmp) { |
|
462 |
$status = "same_version"; |
|
463 |
} elsif ($cmp < 0) { |
|
464 |
$status = "newer_in_$dists[1]"; |
|
465 |
if ( $versions[1] =~ m|^$esc_vers[0]| ) { |
|
466 |
$details = " local_changes_in_$dists[1]"; |
|
467 |
}
|
|
468 |
} else { |
|
469 |
$status = "newer_in_$dists[0]"; |
|
470 |
if ( $versions[0] =~ m|^$esc_vers[1]| ) { |
|
471 |
$details = " local_changes_in_$dists[0]"; |
|
472 |
}
|
|
473 |
}
|
|
474 |
}
|
|
475 |
$line .= " $status $details"; |
|
476 |
}
|
|
477 |
||
478 |
print "$line\n"; |
|
479 |
}
|
|
480 |
}
|
|
481 |
||
482 |
||
483 |
sub compare_src_bin { |
|
484 |
my ($dist, $do_compare) = @_; |
|
485 |
||
486 |
dist_check($dist); |
|
487 |
||
488 |
# Get all packages
|
|
489 |
my %packages; |
|
490 |
my @parse_types = ('Sources', 'Packages'); |
|
491 |
my @comp_types = ('Sources_Bin', 'Packages'); |
|
492 |
||
493 |
foreach my $type (@parse_types) { |
|
494 |
my $files = get_distfiles($dist, $type); |
|
495 |
my @files = @$files; |
|
496 |
foreach my $file ( @files ) { |
|
497 |
my $parsed_file = parseFile($file); |
|
498 |
foreach my $package ( keys(%{$parsed_file}) ) { |
|
499 |
if ( $packages{$dist}{$package} ) { |
|
500 |
warn "W: Package $package is already listed for $dist. Not overriding.\n"; |
|
501 |
} else { |
|
502 |
$packages{$type}{$package} = $parsed_file->{$package}; |
|
503 |
}
|
|
504 |
}
|
|
505 |
}
|
|
506 |
}
|
|
507 |
||
508 |
# Build 'Sources_Bin' hash
|
|
509 |
foreach my $package ( keys( %{$packages{Sources}} ) ) { |
|
510 |
my $package_h = \%{$packages{Sources}{$package}}; |
|
511 |
if ( $package_h->{'Binary'} ) { |
|
512 |
my @binaries = split(", ", $package_h->{'Binary'}); |
|
513 |
my $version = $package_h->{'Version'}; |
|
514 |
foreach my $binary (@binaries) { |
|
515 |
if (defined $packages{Sources_Bin}{$binary}) { |
|
516 |
my $alt_ver = $packages{Sources_Bin}{$binary}{Version}; |
|
517 |
# Skip this entry if it's an older version than we already
|
|
518 |
# have
|
|
519 |
if (version_compare($version, $alt_ver) < 0) { |
|
520 |
next; |
|
521 |
}
|
|
522 |
}
|
|
523 |
$packages{Sources_Bin}{$binary}{Version} = $version; |
|
524 |
}
|
|
525 |
} else { |
|
526 |
warn "Source $package has no binaries!\n"; |
|
527 |
}
|
|
528 |
}
|
|
529 |
||
530 |
# Get entire list of packages
|
|
531 |
my @all_packages = uniq sort ( map { keys(%{$packages{$_}}) } @comp_types ); |
|
532 |
||
533 |
foreach my $package (@all_packages) { |
|
534 |
my $line = "$package "; |
|
535 |
my $status = ""; |
|
536 |
my $details; |
|
537 |
||
538 |
foreach my $type (@comp_types) { |
|
539 |
if ( $packages{$type}{$package} ) { |
|
540 |
$line .= "$packages{$type}{$package}{'Version'} "; |
|
541 |
} else { |
|
542 |
$line .= "UNAVAIL "; |
|
543 |
$status = "not_in_$type"; |
|
544 |
}
|
|
545 |
}
|
|
546 |
||
547 |
my @versions = map { $packages{$_}{$package}{'Version'} } @comp_types; |
|
548 |
||
549 |
# Do compare
|
|
550 |
if ($do_compare) { |
|
551 |
if (!@comp_types) { |
|
552 |
fatal('Can only compare versions if there are two types.'); |
|
553 |
}
|
|
554 |
if (!$status) { |
|
555 |
my $cmp = version_compare($versions[0], $versions[1]); |
|
556 |
if (!$cmp) { |
|
557 |
$status = "same_version"; |
|
558 |
} elsif ($cmp < 0) { |
|
559 |
$status = "newer_in_$comp_types[1]"; |
|
560 |
if ( $versions[1] =~ m|^\Q$versions[0]\E| ) { |
|
561 |
$details = " local_changes_in_$comp_types[1]"; |
|
562 |
}
|
|
563 |
} else { |
|
564 |
$status = "newer_in_$comp_types[0]"; |
|
565 |
if ( $versions[0] =~ m|^\Q$versions[1]\E| ) { |
|
566 |
$details = " local_changes_in_$comp_types[0]"; |
|
567 |
}
|
|
568 |
}
|
|
569 |
}
|
|
570 |
$line .= " $status $details"; |
|
571 |
}
|
|
572 |
||
573 |
print "$line\n"; |
|
574 |
}
|
|
575 |
}
|
|
576 |
||
577 |
sub grep_file(\@$) |
|
578 |
{
|
|
579 |
my ($argv, $file) = @_; |
|
580 |
my $dist = shift @{$argv}; |
|
581 |
dist_check($dist); |
|
582 |
my @f = glob($datadir . '/' . $dist . "/var/lib/apt/lists/*_$file"); |
|
583 |
if (@f) { |
|
584 |
exec('grep-dctrl', @{$argv}, @f); |
|
585 |
}
|
|
586 |
else { |
|
587 |
fatal("Couldn't find a $file for $dist."); |
|
588 |
}
|
|
589 |
}
|
|
590 |
||
591 |
sub list { |
|
592 |
opendir(DIR, $datadir) or fatal("can't open dir $datadir: $!"); |
|
593 |
while (my $file = readdir(DIR)) { |
|
594 |
if ( (-d "$datadir/$file") && ($file =~ m|^\w+|) ) { |
|
595 |
print "$file\n"; |
|
596 |
}
|
|
597 |
}
|
|
598 |
closedir(DIR); |
|
599 |
}
|
|
600 |
||
601 |
||
602 |
||
603 |
sub parseFile { |
|
604 |
my ($file) = @_; |
|
605 |
||
606 |
# Parse a source file and returns results as a hash
|
|
607 |
||
608 |
open(FILE, '<', $file) || fatal("Could not open $file : $!"); |
|
609 |
||
610 |
# Use %tmp hash to store tmp data
|
|
611 |
my %tmp; |
|
612 |
my %result; |
|
613 |
||
614 |
while (my $line = <FILE>) { |
|
615 |
if ( $line =~ m|^$| ) { |
|
616 |
# Commit data if empty line
|
|
617 |
if ( $tmp{'Package'} ) { |
|
618 |
#print "Committing data for $tmp{'Package'}\n";
|
|
619 |
while ( my ($field, $data) = each(%tmp) ) { |
|
620 |
if ( $field ne "Package" ) { |
|
621 |
$result{$tmp{'Package'}}{$field} = $data; |
|
622 |
}
|
|
623 |
}
|
|
624 |
# Reset %tmp
|
|
625 |
%tmp = (); |
|
626 |
} else { |
|
627 |
warn "W: No Package field found. Not committing data.\n"; |
|
628 |
}
|
|
629 |
} elsif ( $line =~ m|^[a-zA-Z]| ) { |
|
630 |
# Gather data
|
|
631 |
my ($field, $data) = $line =~ m|([a-zA-z-]+): (.*)$|; |
|
632 |
if ($data) { |
|
633 |
$tmp{$field} = $data; |
|
634 |
}
|
|
635 |
}
|
|
636 |
}
|
|
637 |
close(FILE); |
|
638 |
||
639 |
return \%result; |
|
640 |
}
|
|
641 |
||
642 |
||
643 |
||
644 |
||
645 |
########################################################
|
|
646 |
### Command parsing
|
|
647 |
########################################################
|
|
648 |
||
649 |
my $command = shift @ARGV; |
|
650 |
given ($command) { |
|
651 |
when ('create') { |
|
652 |
dist_create(@ARGV); |
|
653 |
}
|
|
654 |
when ('apt-get') { |
|
655 |
aptcmd('apt-get', @ARGV); |
|
656 |
}
|
|
657 |
when ('apt-cache') { |
|
658 |
aptcmd('apt-cache', @ARGV); |
|
659 |
}
|
|
660 |
when ('apt-rdepends') { |
|
661 |
aptcmd('apt-rdepends', @ARGV); |
|
662 |
}
|
|
663 |
when ('bin2src') { |
|
664 |
bin2src(@ARGV); |
|
665 |
}
|
|
666 |
when ('src2bin') { |
|
667 |
src2bin(@ARGV); |
|
668 |
}
|
|
669 |
when ('compare-packages') { |
|
670 |
dist_compare(@ARGV, 0, 'Sources'); |
|
671 |
}
|
|
672 |
when ('compare-bin-packages') { |
|
673 |
dist_compare(@ARGV, 0, 'Packages'); |
|
674 |
}
|
|
675 |
when ('compare-versions') { |
|
676 |
dist_compare(@ARGV, 1, 'Sources'); |
|
677 |
}
|
|
678 |
when ('compare-bin-versions') { |
|
679 |
dist_compare(@ARGV, 1, 'Packages'); |
|
680 |
}
|
|
681 |
when ('grep-dctrl-packages') { |
|
682 |
grep_file(@ARGV, 'Packages'); |
|
683 |
}
|
|
684 |
when ('grep-dctrl-sources') { |
|
685 |
grep_file(@ARGV, 'Sources'); |
|
686 |
}
|
|
687 |
when ('compare-src-bin-packages') { |
|
688 |
compare_src_bin(@ARGV, 0); |
|
689 |
}
|
|
690 |
when ('compare-src-bin-versions') { |
|
691 |
compare_src_bin(@ARGV, 1); |
|
692 |
}
|
|
693 |
when ('list') { |
|
694 |
list; |
|
695 |
}
|
|
696 |
default { |
|
697 |
usage(1); |
|
698 |
}
|
|
699 |
}
|