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/Pacman.pm | 126 ++++++++++++++++++++++++++++++
 1 file changed, 126 insertions(+)
 create mode 100644 lib/App/ArchLinux/PackagerTools/Pacman.pm

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

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