[caracas-pm] [LARGO] Re: [l-linux] Listar paquetes Debian filtrado por repositorio
Ernesto Hernandez-Novich
emhnemhn at gmail.com
Thu Aug 23 18:16:10 PDT 2007
On Sun, 2007-08-19 at 15:47 -0400, Alfredo Rico wrote:
> Tengo instalado Etch en mi laptop y mi source.list contiene estos repositorios:
[...]
>
> Como podría listar todos los paquetes que pertenezcan exclusivamente a
> esta fuente:
> deb http://www.vobcopy.org/mirror/elive/ elive main efl elive
>
El código siguiente puede (o no) ayudarte con tu problema. El código
tiene al menos dos bugs (intencionales) para que los Perl Mongers puedan
practicar con su debugger, y es candidato para una obvia adaptación con
Getopt::Long (y alguna refactorización). Probablemente podamos hacerlo
en la reunión de septiembre, o en la lista de correso de los Perl
Mongers.
Perl tiene varios módulos disponibles para operar sobre el sistema de
paquetes Debian.
Hacen falta los paquetes liburi-perl y libparse-debian-packages-perl
para correr (además de haber hecho aptitude update :-).
#!/usr/bin/perl
use strict;
use warnings;
use IO::File;
use URI;
use File::Spec;
use Parse::Debian::Packages;
sub s2i {
my $source_line = shift;
my @items;
my $arch;
my $file_end;
if ($source_line =~ m/^deb /) {
$arch = 'binary-' . `dpkg --print-architecture`;
chomp $arch;
$file_end = 'Packages';
} elsif ($source_line =~ m/^deb-src /) {
$arch = 'source';
$file_end = 'Sources';
} else {
die "Invalid source line!";
}
$source_line =~ s/^deb(-src)? *//;
my ($uri,$dist, at parts) = split / +/,$source_line;
my $s = URI->new($uri);
my $host = $s->host();
my $path = $s->path() || '';
for ($path) {
s{^/|/$}{}g;
s{/}{_}g;
}
for my $part (@parts) {
push @items,
{
host => $host,
dist => $dist,
part => $part,
arch => $arch,
filename => File::Spec->catfile(
'/', 'var', 'lib', 'apt', 'lists',
join( '_',
$host,
$path,
'dists',
$dist =~ s{/}{_}g,
$part,
$arch,
$file_end
)
)
};
}
return @items;
}
open my $sl,"<","/etc/apt/sources.list" or die "Oops! $!";
while (my $line = <$sl>) {
chomp $line;
for my $item ( s2i( $line ) ) {
print "Servidor: ", $item->{host},"\n";
print "Dist: ", $item->{dist},"\n";
print "Sección: ", $item->{part},"\n";
print "Arquitectura: ", $item->{arch},"\n";
my $fh = IO::File->new( $item->{filename} );
my $parser = Parse::Debian::Packages->new($fh);
while ( my %package = $parser->next() ) {
print $package{Package},"\n";
}
print "\n--\n";
}
}
--
Ernesto Hernández-Novich - Linux 2.6.18 i686 - Unix: Live free or die!
Geek by nature, Linux by choice, Debian of course.
If you can't aptitude it, it isn't useful or doesn't exist.
GPG Key Fingerprint = 438C 49A2 A8C7 E7D7 1500 C507 96D6 A3D6 2F4C 85E3
More information about the caracas-pm
mailing list