From e93e80dede905b653e35b8bb4e8f31f0c58719bd Mon Sep 17 00:00:00 2001
From: Florian Pritz <bluewind@xinu.at>
Date: Sun, 18 Nov 2018 23:33:14 +0100
Subject: Implement basic check for upgradable packages

Signed-off-by: Florian Pritz <bluewind@xinu.at>
---
 lib/App/ArchLinux/PackagerTools/CPAN.pm | 154 ++++++++++++++++++++++++++++++++
 1 file changed, 154 insertions(+)
 create mode 100644 lib/App/ArchLinux/PackagerTools/CPAN.pm

(limited to 'lib/App/ArchLinux/PackagerTools/CPAN.pm')

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__
-- 
cgit v1.2.3-24-g4f1b