diff options
| -rw-r--r-- | META.json | 15 | ||||
| -rw-r--r-- | README.md | 10 | ||||
| -rw-r--r-- | cpanfile | 19 | ||||
| -rw-r--r-- | lib/App/ArchLinux/PackagerTools.pm | 65 | ||||
| -rw-r--r-- | lib/App/ArchLinux/PackagerTools/CPAN.pm | 154 | ||||
| -rw-r--r-- | lib/App/ArchLinux/PackagerTools/Pacman.pm | 126 | ||||
| -rwxr-xr-x | script/perlpkg.pl | 65 | ||||
| -rw-r--r-- | t/compile.t | 2 |
8 files changed, 448 insertions, 8 deletions
@@ -42,7 +42,20 @@ }, "runtime" : { "requires" : { - "perl" : "5.008001" + "CPAN::DistnameInfo" : "0", + "CPANPLUS::Backend" : "0", + "Function::Parameters" : "0", + "IO::Zlib" : "0", + "Log::Any" : "0", + "Log::Any::Adapter" : "0", + "Log::Log4perl" : "0", + "Path::Tiny" : "0", + "Syntax::Keyword::Try" : "0", + "TOML" : "0", + "autodie" : "0", + "perl" : "v5.24.0", + "strictures" : "0", + "version" : "0" } }, "test" : { @@ -10,6 +10,16 @@ App::ArchLinux::PackagerTools - It's new $module App::ArchLinux::PackagerTools is ... +# METHODS + +## Constructors + +### new + + App::ArchLinux::PackagerTools->new(); + +Returns a new instance. + # LICENSE Copyright (C) 2018 Florian Pritz <bluewind@xinu.at> @@ -1,4 +1,21 @@ -requires 'perl', '5.008001'; +requires 'CPAN::DistnameInfo'; +requires 'CPANPLUS::Backend'; +requires 'Function::Parameters'; +requires 'IO::Zlib'; +requires 'Log::Any'; +requires 'Log::Any::Adapter'; +requires 'Log::Log4perl'; +requires 'Path::Tiny'; +requires 'Syntax::Keyword::Try'; +requires 'TOML'; +requires 'autodie'; +requires 'perl', 'v5.24.0'; +requires 'strictures'; +requires 'version'; + +on configure => sub { + requires 'Module::Build::Tiny', '0.035'; +}; on 'test' => sub { requires 'Test::More', '0.98'; diff --git a/lib/App/ArchLinux/PackagerTools.pm b/lib/App/ArchLinux/PackagerTools.pm index 0e83434..d8cb89d 100644 --- a/lib/App/ArchLinux/PackagerTools.pm +++ b/lib/App/ArchLinux/PackagerTools.pm @@ -1,14 +1,15 @@ package App::ArchLinux::PackagerTools; -use 5.008001; -use strict; -use warnings; +use v5.24; +use strictures; our $VERSION = "0.01"; +use autodie; +use Function::Parameters; +use Log::Any qw($log); - -1; -__END__ +use App::ArchLinux::PackagerTools::Pacman; +use App::ArchLinux::PackagerTools::CPAN; =encoding utf-8 @@ -24,6 +25,55 @@ App::ArchLinux::PackagerTools - It's new $module App::ArchLinux::PackagerTools is ... +=head1 METHODS + +=head2 Constructors + +=head3 new + + App::ArchLinux::PackagerTools->new(); + +Returns a new instance. + +=cut +method new($class: $deps = {}) { + $deps->{cpan} //= App::ArchLinux::PackagerTools::CPAN->new(); + $deps->{pacman} //= App::ArchLinux::PackagerTools::Pacman->new({$deps->%{cpan}}); + return $class->new_no_defaults($deps); +} + +method new_no_defaults($class: $deps = {}) { + my $self = {}; + bless $self, $class; + $self->{deps} = $deps; + return $self; +} + +method get_distributions_in_repo() { + return $self->{deps}->{pacman}->get_perl_distributions(); +} + +method get_updateable_packages($distribution_names) { + my @packages; + for my $dist_name ($distribution_names->@*) { + my $repo_version = $self->{deps}->{pacman}->get_perl_distribution_version($dist_name); + my $dist = $self->{deps}->{cpan}->get_dist($dist_name); + if ($self->{deps}->{cpan}->is_newer_version_available($dist_name, $repo_version)) { + $log->infof('New version available for dist \'%s\': %s', $dist_name, $dist->{version}); + push @packages, { + dist_name => $dist_name, + repo_version => $repo_version, + cpan_version => $dist->{version}, + pkgname => $self->{deps}->{pacman}->get_perl_pkgname($dist_name), + }; + } else { + $log->debugf('Dist \'%s\' is already up to date with version %s', $dist_name, $dist->{version}); + } + + } + return \@packages; +} + =head1 LICENSE Copyright (C) 2018 Florian Pritz E<lt>bluewind@xinu.atE<gt> @@ -48,3 +98,6 @@ Florian Pritz E<lt>bluewind@xinu.atE<gt> =cut +1; + +__END__ 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__ diff --git a/script/perlpkg.pl b/script/perlpkg.pl new file mode 100755 index 0000000..7bfff3a --- /dev/null +++ b/script/perlpkg.pl @@ -0,0 +1,65 @@ +#!/usr/bin/env perl + +use v5.24; + +use warnings; +use strict; + +use Function::Parameters; +use Log::Any::Adapter; +use Log::Log4perl qw(:easy); +use Path::Tiny; +use TOML qw(from_toml); + +use App::ArchLinux::PackagerTools; + +=head1 NAME + +perlpkg.pl - Script to support perl packaging on Arch Linux + +=head1 SYNOPSIS + + perlpkg.pl [options] + + Options: + --debug + +=head1 DESCRIPTION + +TODO + +=head1 CONFIGURATION + +To configure the script create a file called $XDG_CONFIG_HOME/perlpkg/config.toml. + +The configuration file is not yet used/read. + +TODO + +=head1 SEE ALSO + +L<App::ArchLinux::PackagerTools> + +=cut + +#my $config = from_toml(path(($ENV{XDG_CONFIG_HOME} // $ENV{HOME}."/.config")."/perlpkg/config.toml")->slurp); + +Log::Log4perl->easy_init($ERROR); +if ($ARGV[0] // "" eq "--debug") { + Log::Log4perl->easy_init($TRACE); +} else { + Log::Log4perl->easy_init($INFO); +} +Log::Any::Adapter->set('Log4perl'); + +my $app = App::ArchLinux::PackagerTools->new(); + +use Data::Dumper; +my $dists = $app->get_distributions_in_repo(); +my $dist_names = [map {$_->{dist_name}} $dists->@*]; +print Dumper($app->get_updateable_packages($dist_names)); + +# TODO fetch maintainer from archweb +# TODO generate new pacakge pkgbuild +# TODO build +# TODO release diff --git a/t/compile.t b/t/compile.t index e8e5f22..b0bdaa5 100644 --- a/t/compile.t +++ b/t/compile.t @@ -3,6 +3,8 @@ use Test::More 0.98; use_ok $_ for qw( App::ArchLinux::PackagerTools + App::ArchLinux::PackagerTools::CPAN + App::ArchLinux::PackagerTools::Pacman ); done_testing; |