summaryrefslogtreecommitdiffstats
path: root/lib/App/ArchLinux/PackagerTools
diff options
context:
space:
mode:
Diffstat (limited to 'lib/App/ArchLinux/PackagerTools')
-rw-r--r--lib/App/ArchLinux/PackagerTools/CPAN.pm154
-rw-r--r--lib/App/ArchLinux/PackagerTools/Pacman.pm126
2 files changed, 280 insertions, 0 deletions
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/^(?<pkgname>[^\s]+) (?<pkgver>.*)$/) {
+ 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__