diff options
Diffstat (limited to 'lib/App/ArchLinux/PackagerTools/CPAN.pm')
| -rw-r--r-- | lib/App/ArchLinux/PackagerTools/CPAN.pm | 154 |
1 files changed, 154 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__ |