[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