Linux-Distribution-Packages-0.05/0000755000641000001440000000000010421515360017367 5ustar judithusers00000000000000Linux-Distribution-Packages-0.05/Changes0000644000641000001440000000060010421515360020656 0ustar judithusers00000000000000* 2006-20-01 Version 0.01. * 2006-02-02 Version 0.02 Add ability to write to file as option. Also can set format as an option. * 2006-07-02 Version 0.03 Add Slackware as a distribution. This was submitted by Alberto Re. * 2006-10-02 Version 0.04 Add Red Flag as a distribution. Alphabetize hash entries for easier find. * 2006-19-04 Version 0.05 Add Fedora as a distribution. Linux-Distribution-Packages-0.05/MANIFEST0000644000641000001440000000014710370457231020527 0ustar judithusers00000000000000Changes Makefile.PL MANIFEST README t/Linux-Distribution-Packages.t lib/Linux/Distribution/Packages.pm Linux-Distribution-Packages-0.05/Makefile.PL0000644000641000001440000000125210374176251021352 0ustar judithusers00000000000000use 5.006000; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'Linux::Distribution::Packages', VERSION_FROM => 'lib/Linux/Distribution/Packages.pm', # finds $VERSION PREREQ_PM => { 'Linux::Distribution' => '0.14', 'XML::Writer' => '0' }, # e.g., Module::Name => 1.1 PREREQ_FATAL => '1', ($] >= 5.005 ? ## I am not actually sure about this version (ABSTRACT_FROM => 'lib/Linux/Distribution/Packages.pm', # retrieve abstract from module AUTHOR => 'Judith Lebzelter ') : ()), ); Linux-Distribution-Packages-0.05/README0000644000641000001440000000142110370457231020252 0ustar judithusers00000000000000Linux-Distribution version 0.01 =============================== This is a simple module that uses Linux::Distribution to guess the linux distribution and then uses the correct commands to list all the packages on the system and then output them in one of three formats: native, csv, and xml. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module dependends on modules Linux::Distribution and XML::Writer. COPYRIGHT AND LICENCE Copyright (C) 2006 by Judith Lebzelter This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.5 or, at your option, any later version of Perl 5 you may have available. Linux-Distribution-Packages-0.05/lib/0000755000641000001440000000000010370457231020142 5ustar judithusers00000000000000Linux-Distribution-Packages-0.05/lib/Linux/0000755000641000001440000000000010370457231021241 5ustar judithusers00000000000000Linux-Distribution-Packages-0.05/lib/Linux/Distribution/0000755000641000001440000000000010421515401023707 5ustar judithusers00000000000000Linux-Distribution-Packages-0.05/lib/Linux/Distribution/Packages.pm0000644000641000001440000002014310421515401025763 0ustar judithusers00000000000000package Linux::Distribution::Packages; use 5.006000; use strict; use warnings; use base qw(Linux::Distribution); our $VERSION = '0.05'; my %commands = ( 'debian' => 'dpkg', 'gentoo' => 'equery', 'fedora' => 'rpm', 'redflag' => 'rpm', 'redhat' => 'rpm', 'slackware' => 'pkgtool', 'suse' => 'rpm', 'ubuntu' => 'dpkg', ); our @EXPORT_OK = qw(distribution_packages distribution_write format); sub new { my $package = shift; my $options = shift; my $self = { 'command' => '', 'format' => 'native', '_data' => '', 'output_file' => '' }; foreach my $option (keys %{$options}){ $self->{$option} = $options->{$option}; } bless $self, $package; $self->SUPER::new(); $self->distribution_name(); $self->distribution_packages(); return $self; } sub distribution_packages { my $self = shift || new(); if ($commands{$self->{'DISTRIB_ID'}}){ bless $self, 'Linux::Distribution::Packages::' . $commands{$self->{'DISTRIB_ID'}}; } else { print "Distribution [ $self->{'DISTRIB_ID'} ] not supported\n"; exit; } $self->_retrieve_all(); } sub distribution_write { my $self = shift; my $options = shift; foreach my $option (keys %{$options}){ $self->{$option} = $options->{$option}; } my $print_function = '_list_' . $self->{'format'}; if ( $self->{'format'} ne 'xml'){ $self->_open_output_fh(); } $self->$print_function(); if ( $self->{'format'} ne 'xml'){ $self->_close_output_fh(); } return 1; } sub format { my $self = shift; $self->{'format'} = shift || 'native'; } sub _retrieve_all { my $self = shift; $self->_command(); $self->{'_data'} = ` $self->{'command'} `; die "Error $? running \'$self->{'command'}\'\n" if $?; } sub _list_native { my $self = shift; my $output = $self->{'output_file_handle'}; print { $output || *STDOUT } $self->{_data}; } sub _list_xml { require XML::Writer; my $self = shift; my $writer; my $writer_options = {DATA_MODE => 1, DATA_INDENT => 2}; my $output; if (defined $self->{'output_file'}){ require IO::File; $output = new IO::File(">$self->{'output_file'}"); $writer_options->{'OUTPUT'} = $output; } if ($self->{'format'} =~ m/xml/i){ $writer = new XML::Writer(%{$writer_options}); $writer->startTag('distribution', "name" => $self->{'DISTRIB_ID'}, "release" => $self->distribution_version()); } my $hash = $self->_parse($writer); $writer->endTag('distribution'); } sub _list_csv { my $self = shift; $self->_parse(); } sub _row_csv { my $self = shift; my $output = $self->{'output_file_handle'}; print { $output || *STDOUT } "\'" . join("\',\'", @_) . "\'\n"; } sub _parse { my $self = shift; my $row_func='_row_' . $self->{'format'}; my @data = split '\n', $self->{'_data'}; foreach my $row (@data){ $self->$row_func($row); } } sub _open_output_fh { my $self = shift; if ($self->{'output_file'}){ open FH, ">>$self->{'output_file'}"; $self->{'output_file_handle'} = *FH; } else { delete $self->{'output_file_handle'}; delete $self->{'output_file'}; } } sub _close_output_fh { my $self = shift; if ($self->{'output_file'}){ close $self->{'output_file_handle'}; delete $self->{'output_file_handle'}; } } sub _command { my ( $self, $command ) = @_; # Add options not really yet implemented if ($self->{'options'}){ $command .= ' ' . $self->{'options'}; } $self->{'command'} = $command; } return 1; package Linux::Distribution::Packages::equery; use base qw(Linux::Distribution::Packages); sub _command { my $self = shift; $self->SUPER::_command('equery list'); } sub _parse { my $self = shift; my @data = split '\n', $self->{_data}; my $writer=shift; foreach my $row (@data){ my ($dir, $pkg, $ver); next if $row =~ m/.*installed packages.*/; if ($row =~ m/\-(r\d+)$/){ ($dir, $pkg, $ver) = $row =~ m/(.+)\/(.+)\-(.+(\-(r\d+)))$/; } else { ($dir, $pkg, $ver) = $row =~ m/(.+)\/(.+)\-(.+)/; } if ($self->{'format'} =~ m/xml/i){ $writer->emptyTag('package', 'name' => $pkg, 'version' => $ver , 'category' => $dir); next; } my $row_func='_row_' . $self->{'format'}; $self->$row_func($dir, $pkg, $ver, ''); } } return 1; package Linux::Distribution::Packages::dpkg; use base qw(Linux::Distribution::Packages); sub _command { my $self = shift; $self->SUPER::_command('dpkg --list'); } sub _parse { my $self = shift; my @data = split '\n', $self->{_data}; my $writer=shift; foreach my $row (@data){ my ($ii, $desc, $pkg, $ver); next if $row =~ m/^(Desired|\||\+).*/; ($ii, $pkg, $ver, $desc) = $row =~ m/^(.+?)\s+(.+?)\s+(.+?)\s+(.+)$/; if ($self->{'format'} =~ m/xml/i){ $writer->emptyTag('package', 'name' => $pkg, 'version' => $ver , 'description' => $desc); next; } my $row_func='_row_' . $self->{'format'}; $self->$row_func('', $pkg, $ver, $desc); } } return 1; package Linux::Distribution::Packages::rpm; use base qw(Linux::Distribution::Packages); sub _command { my $self = shift; $self->SUPER::_command('rpm -qa'); } sub _parse { my $self = shift; my @data = split '\n', $self->{_data}; my $writer=shift; foreach my $row (@data){ my ($pkg, $ver); next if $row =~ m/^(Desired|\||\+).*/; ($pkg, $ver) = $row =~ m/^(.+)\-+(.+\-.+)$/; if ($self->{'format'} =~ m/xml/i){ $writer->emptyTag('package', 'name' => $pkg, 'version' => $ver ); next; } my $row_func='_row_' . $self->{'format'}; $self->$row_func('', $pkg, $ver, ''); } } package Linux::Distribution::Packages::pkgtool; use base qw(Linux::Distribution::Packages); sub _command { my $self = shift; $self->SUPER::_command('ls /var/log/packages'); } sub _parse { my $self = shift; my @data = split '\n', $self->{_data}; my $writer=shift; foreach my $row (@data){ my ($pkg, $ver); ($pkg, $ver) = $row =~ m/^(.+)\-(.+)\-.+\-\d+$/; if ($self->{'format'} =~ m/xml/i){ $writer->emptyTag('package', 'name' => $pkg, 'version' => $ver ); next; } my $row_func='_row_' . $self->{'format'}; $self->$row_func('', $pkg, $ver, ''); } } return 1; __END__ =head1 NAME Linux::Distribution::Packages - list all packages on various Linux distributions =head1 SYNOPSIS use Linux::Distribution::Packages qw(distribution_packages distribution_write); $linux = new Linux::Distribution::Packages({'format' => 'csv', 'output_file' => 'packages.csv'}); $linux->distribution_write(); # Or you can (re)set the options when you write. $linux->distribution_write({'format' => 'xml', 'output_file' => 'packages.xml'}); # If you want to reload the package data $linux->distribution_packages(); =head1 DESCRIPTION This is a simple module that uses Linux::Distribution to guess the linux distribution and then uses the correct commands to list all the packages on the system and then output them in one of three formats: native, csv, and xml. Distributions currently working: debian, ubuntu, fedora, redhat, suse, gentoo, slackware, redflag. The module inherits from Linux::Distribution, so can also use its calls. =head2 EXPORT None by default. =head1 TODO * Add the capability to correctly get packages for all recognized distributions. * Seperate out parsing from writing. Parse data to hash and give access to hash. Then write the formatted data from the hash. =head1 AUTHORS Judith Lebzelter, Ejudith@osdl.orgE Alberto Re, Ealberto@accidia.netE =head1 COPYRIGHT AND LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.5 or, at your option, any later version of Perl 5 you may have available. =cut Linux-Distribution-Packages-0.05/t/0000755000641000001440000000000010421515424017633 5ustar judithusers00000000000000Linux-Distribution-Packages-0.05/t/Linux-Distribution-Packages.t0000644000641000001440000000104510421515424025310 0ustar judithusers00000000000000# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Linux-Distribution.t' ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More tests => 3; use Linux::Distribution::Packages; my $linux=new Linux::Distribution::Packages(); ok( defined($linux) , 'new() works 1' ); like( ref $linux, qr/^Linux::Distribution::Packages.*/, 'new() works 2' ); ok( $linux->distribution_write(), 'distribution_write() works' );