From e93e80dede905b653e35b8bb4e8f31f0c58719bd Mon Sep 17 00:00:00 2001 From: Florian Pritz Date: Sun, 18 Nov 2018 23:33:14 +0100 Subject: Implement basic check for upgradable packages Signed-off-by: Florian Pritz --- lib/App/ArchLinux/PackagerTools/CPAN.pm | 154 ++++++++++++++++++++++++++++++ lib/App/ArchLinux/PackagerTools/Pacman.pm | 126 ++++++++++++++++++++++++ 2 files changed, 280 insertions(+) create mode 100644 lib/App/ArchLinux/PackagerTools/CPAN.pm create mode 100644 lib/App/ArchLinux/PackagerTools/Pacman.pm (limited to 'lib/App/ArchLinux/PackagerTools') diff --git a/lib/App/ArchLinux/PackagerTools/CPAN.pm b/lib/App/ArchLinux/PackagerTools/CPAN.pm new file mode 100644 index 0000000..175e218 --- /dev/null +++ b/lib/App/ArchLinux/PackagerTools/CPAN.pm @@ -0,0 +1,154 @@ +package App::ArchLinux::PackagerTools::CPAN; +use strictures; + +use autodie; +use CPAN::DistnameInfo; +use CPANPLUS::Backend; +use Carp; +use Function::Parameters; +use IO::Zlib; +use Log::Any qw($log); +use Syntax::Keyword::Try; +use version; + +=head1 NAME + +App::ArchLinux::PackagerTools::CPAN - Methods to interact with CPAN + +=head1 SYNOPSIS + +use App::ArchLinux::PackagerTools::CPAN; + +# synopsis... + +=head1 DESCRIPTION + +# longer description... + +=head1 METHODS + +=head2 new + + App::ArchLinux::PackagerTools::CPAN->new(); + +Returns a new instance. + +=cut + +method new($class: $deps = {}) { + $deps->{cpanplus_backend} //= CPANPLUS::Backend->new(); + return $class->new_no_defaults($deps); +} + +method new_no_defaults($class: $deps = {}) { + my $self = {}; + bless $self, $class; + $self->{deps} = $deps; + $self->{dist_lc_map} = {}; + $self->{dists} = {}; + $self->_build_dist_index(); + return $self; +} + +=head2 Public Methods + +=head3 is_newer_version_available + +Return 1 if a newer version of the distribution is available, 0 otherwise. + +=cut + +method is_newer_version_available($dist_name, $version) { + my $dist = $self->get_dist($dist_name); + # TODO compare versions rather than not-equal check + my $dist_version = version->parse($dist->{version}); + if ($dist_version > version->parse($version)) { + return 1; + } else { + return 0; + } +} + +method _build_dist_index() { + $self->{deps}->{cpanplus_backend}->reload_indices(); + # TODO download pacakges list ourselves instead of using cpanplus for it? We may need cpanplus for other features later so keeping it is probably also fine. + + my $packages_file = "$ENV{HOME}/.cpanplus/02packages.details.txt.gz"; + my $fh = IO::Zlib->new($packages_file, 'r'); + my %seen; + my $line_number = 0; + while (<$fh>) { + # skip meta info (first 9 lines) + next if $line_number++ < 9; + + #$log->tracef("Parsing line: %s", $_); + my ($module_name, $module_version, $file) = split /\s+/; + + next if $seen{$file}++ > 0; + + my $dist = CPAN::DistnameInfo->new($file); + if (!defined $dist->{dist}) { + $log->debugf("Failed to parse file: %s", $file); + next; + } + + my $dist_name = $dist->{dist}; + my $dist_name_lc = lc($dist_name); + + my $dist_version; + try { + $dist_version = version->parse($dist->{version}); + } catch { + $log->debugf("Skipping dist with invalid version: %s", $@); + $log->debugf("Skipped dist is: %s", $dist); + next; + } + + my $index_dist; + my $index_version = version->parse($self->{dists}->{$dist_name}->{version}); + my $index_name = $self->{dist_lc_map}->{$dist_name_lc}; + $index_dist = $self->{dists}->{$index_name} if defined $index_name; + + if (!defined($index_dist) + || (defined($index_dist) && $index_name eq $dist_name && $dist_version > $index_version) + ) { + $self->{dist_lc_map}->{$dist_name_lc} = $dist_name; + $self->{dists}->{$dist_name} = { + dist_name => $dist_name, + version => $dist->{version}, + }; + } else { + if ($dist_name ne $index_name && $dist_version < $index_version) { + confess $log->errorf("Key '%s' already exists in lc_map. This requires a manual exception to map correctly.\nExisting: %s\nCurrent: %s", $dist_name_lc, $index_dist, {$dist->%{qw(dist version)}}); + } + } + } +} + +method search_dist($name) { + $name =~ s/::/-/g; + $log->tracef("Searching for CPAN distribution matching '%s'", $name); + + my $index_name = $self->{dist_lc_map}->{lc($name)}; + if (defined $index_name) { + return $self->{dists}->{$index_name}; + } + + return; +} + +method get_dist($dist_name) { + $dist_name =~ s/::/-/g; + $log->tracef("Getting CPAN data for distribution '%s'", $dist_name); + + my $index_name = $self->{dist_lc_map}->{lc($dist_name)}; + if (defined $index_name) { + return $self->{dists}->{$index_name}; + } + + croak $log->errorf("Failed to find distribution with name %s", $dist_name); +} + +1; + +__END__ diff --git a/lib/App/ArchLinux/PackagerTools/Pacman.pm b/lib/App/ArchLinux/PackagerTools/Pacman.pm new file mode 100644 index 0000000..765746e --- /dev/null +++ b/lib/App/ArchLinux/PackagerTools/Pacman.pm @@ -0,0 +1,126 @@ +package App::ArchLinux::PackagerTools::Pacman; +use strictures; + +use autodie; +use Function::Parameters; +use Log::Any qw($log); + +=head1 NAME + +App::ArchLinux::PackagerTools::Pacman - Methods to interact with pacman + +=head1 SYNOPSIS + + use App::ArchLinux::PackagerTools::Pacman; + + # synopsis... + +=head1 DESCRIPTION + +This module allows to query pacman for a list of packages in the repository and +extract a list of perl distributions that are part of the repository. + + +=head1 METHODS + +=head2 Constructors + +=head3 new + + App::ArchLinux::PackagerTools::Pacman->new(); + +Returns a new instance. + +=cut + + +method new($class: $deps = {}) { + $deps->{cpan} //= App::ArchLinux::PackagerTools::CPAN->new(); + $deps->{pkgname_cpan_name_map} //= { + # pkgname => cpan_name + 'perl-critic' => 'Perl::Critic', + 'perl-libintl-perl' => 'libintl-perl', + }; + return $class->new_no_defaults($deps); +} + +method new_no_defaults($class: $deps = {}) { + my $self = {}; + bless $self, $class; + $self->{deps} = $deps; + return $self; +} + +=head2 Public Methods + +=head3 get_packages + +Returns an arrayref of package hashes. Each package hash contains at least the +pkgname and pkgver keys. + +=cut + +method get_packages() { + my @packages; + open my $fh, '-|', 'expac -S \'%n %v\''; + my %seen; + while (<$fh>) { + if (m/^(?[^\s]+) (?.*)$/) { + push @packages, {%+}; + } + } + return \@packages; +} + +method get_perl_packages() { + my @packages = grep {$_->{pkgname} =~ /^perl-/} $self->get_packages->@*; + $log->debugf("Found %d perl packages", scalar(@packages)); + return \@packages; +} + +method get_perl_distributions() { + my @distributions; + + for my $package ($self->get_perl_packages()->@*) { + my $cleaned_name = $package->{pkgname} =~ s/^perl-//r; + my $dist; + if (defined $self->{deps}->{pkgname_cpan_name_map}->{$package->{pkgname}}) { + $dist = $self->{deps}->{cpan}->get_dist($self->{deps}->{pkgname_cpan_name_map}->{$package->{pkgname}}); + } else { + $dist = $self->{deps}->{cpan}->search_dist($cleaned_name); + } + push @distributions, $dist if defined $dist; + $log->warningf("Failed to find distribution for package '%s'", $package) if !defined $dist; + } + return \@distributions; +} + +method get_package_version($pkgname) { + # TODO do not fork expac for each package here! works for now, but it's sloooow + my $version = `expac -S -1 '%v' -- '$pkgname'`; + chomp $version; + return $version; +} + +method get_perl_pkgname($dist_name) { + my $pkgname = lc($dist_name); + $pkgname =~ s/::/-/g; + $pkgname = "perl-$pkgname"; + return $pkgname; +} + +method get_perl_distribution_version($dist_name) { + my $pkgname = $self->get_perl_pkgname($dist_name); + my $version = $self->get_package_version($pkgname); + # remove pkgrel + $version =~ s/-\d+(\.\d+)?$//; + # remove epoch + $version =~ s/^\d+://; + + $log->tracef("Found version '%s' for package '%s'", $version, $pkgname); + return $version; +} + +1; + +__END__ -- cgit v1.2.3-24-g4f1b