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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
|
package SBO::Lib::Pkgs;
use 5.016;
use strict;
use warnings;
our $VERSION = '2.5';
use SBO::Lib::Util qw/ %config script_error open_read version_cmp /;
use SBO::Lib::Tree qw/ get_sbo_location get_sbo_locations is_local /;
use SBO::Lib::Info qw/ get_orig_version get_sbo_version /;
use Exporter 'import';
our @EXPORT_OK = qw{
get_available_updates
get_inst_names
get_installed_cpans
get_installed_packages
get_local_outdated_versions
};
our %EXPORT_TAGS = (
all => \@EXPORT_OK,
);
=pod
=encoding UTF-8
=head1 NAME
SBO::Lib::Pkgs - Routines for interacting with the Slackware package database.
=head1 SYNOPSIS
use SBO::Lib::Pkgs qw/ get_installed_packages /;
my @installed_sbos = get_installed_packages('SBO');
=head1 SUBROUTINES
=cut
my $pkg_db = '/var/log/packages';
=head2 get_available_updates
my @updates = @{ get_available_updates() };
C<get_available_updates()> compares the installed versions in
C</var/log/packages> that are tagged as SBo with the version available from
the SlackBuilds.org or C<LOCAL_OVERRIDES> repository, and returns an array
reference to an array of hash references which specify package names, and
installed and available versions.
=cut
# for each installed sbo, find out whether or not the version in the tree is
# newer, and compile an array of hashes containing those which are
sub get_available_updates {
my @updates;
my $pkg_list = get_installed_packages('SBO');
for my $pkg (@$pkg_list) {
my $location = get_sbo_location($pkg->{name});
next unless $location;
my $version = get_sbo_version($location);
if (version_cmp($version, $pkg->{version}) != 0) {
push @updates, { name => $pkg->{name}, installed => $pkg->{version}, update => $version };
}
}
return \@updates;
}
=head2 get_inst_names
my @names = get_inst_names(get_available_updates());
C<get_inst_names()> returns a list of package names from an array reference
such as the one returned by C<get_available_updates()>.
=cut
# for a ref to an array of hashes of installed packages, return an array ref
# consisting of just their names
sub get_inst_names {
script_error('get_inst_names requires an argument.') unless @_ == 1;
my $inst = shift;
my @installed;
push @installed, $$_{name} for @$inst;
return \@installed;
}
=head2 get_installed_cpans
my @cpans = @{ get_installed_cpans() };
C<get_installed_cpans()> returns an array reference to a list of the perl
modules installed from the CPAN rather than from packages on SlackBuilds.org.
=cut
# return a list of perl modules installed via the CPAN
sub get_installed_cpans {
my @contents;
for my $file (grep { -f $_ } map { "$_/perllocal.pod" } @INC) {
my ($fh, $exit) = open_read($file);
next if $exit;
push @contents, grep {/Module/} <$fh>;
close $fh;
}
my $mod_regex = qr/C<Module>\s+L<([^\|]+)/;
my (@mods, @vers);
for my $line (@contents) {
push @mods, ($line =~ $mod_regex)[0];
}
return \@mods;
}
=head2 get_installed_packages
my @packages = @{ get_installed_packages($type) };
C<get_installed_packages()> returns an array reference to a list of packages in
C</var/log/packages> that match the specified C<$type>. The available types are
C<STD> for non-SBo packages, C<SBO> for SBo packages, and C<ALL> for both.
The returned array reference will hold a list of hash references representing
both names, versions, and full installed package name of the returned packages.
=cut
# pull an array of hashes, each hash containing the name and version of a
# package currently installed. Gets filtered using STD, SBO or ALL.
sub get_installed_packages {
script_error('get_installed_packages requires an argument.') unless @_ == 1;
my $filter = shift;
# Valid types: STD, SBO
my (@pkgs, %types);
foreach my $pkg (glob("$pkg_db/*")) {
$pkg =~ s!^\Q$pkg_db/\E!!;
my ($name, $version, $build) = $pkg =~ m#^([^/]+)-([^-]+)-[^-]+-([^-]+)$#
or next;
push @pkgs, { name => $name, version => $version, build => $build, pkg => $pkg };
$types{$name} = 'STD';
}
# If we want all packages, let's just return them all
return [ map { +{ name => $_->{name}, version => $_->{version}, pkg => $_->{pkg} } } @pkgs ]
if $filter eq 'ALL';
# Otherwise, mark the SBO ones and filter
my @sbos = map { $_->{name} } grep { $_->{build} =~ m/_SBo(|compat32)$/ }
@pkgs;
if (@sbos) {
my %locations = get_sbo_locations(map { s/-compat32//gr } @sbos);
foreach my $sbo (@sbos) { $types{$sbo} = 'SBO'
if $locations{ $sbo =~ s/-compat32//gr }; }
}
return [ map { +{ name => $_->{name}, version => $_->{version}, pkg => $_->{pkg} } }
grep { $types{$_->{name}} eq $filter } @pkgs ];
}
=head2 get_local_outdated_versions
my @outdated = get_local_outdated_versions();
C<get_local_outdated_versions()> checks the installed SBo packages and returns
a list of the ones for which the C<LOCAL_OVERRIDES> version is different to the
the version on SlackBuilds.org.
=cut
sub get_local_outdated_versions {
my @outdated;
my $local = $config{LOCAL_OVERRIDES};
unless ( $local eq 'FALSE' ) {
my $pkglist = get_installed_packages('SBO');
my @local = grep { is_local($_->{name}) } @$pkglist;
foreach my $sbo (@local) {
my $orig = get_orig_version($sbo->{name});
next if not defined $orig;
next if not version_cmp($orig, $sbo->{version});
push @outdated, { %$sbo, orig => $orig };
}
}
return @outdated;
}
=head1 AUTHORS
SBO::Lib was originally written by Jacob Pipkin <j@dawnrazor.net> with
contributions from Luke Williams <xocel@iquidus.org> and Andreas
Guldstrand <andreas.guldstrand@gmail.com>.
=head1 LICENSE
The sbotools are licensed under the WTFPL <http://sam.zoy.org/wtfpl/COPYING>.
Copyright (C) 2012-2017, Jacob Pipkin, Luke Williams, Andreas Guldstrand.
=cut
1;
|
