1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
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__
|
