aboutsummaryrefslogtreecommitdiff
path: root/SBO-Lib/lib/SBO/Lib/Pkgs.pm
diff options
context:
space:
mode:
Diffstat (limited to 'SBO-Lib/lib/SBO/Lib/Pkgs.pm')
-rw-r--r--SBO-Lib/lib/SBO/Lib/Pkgs.pm198
1 files changed, 0 insertions, 198 deletions
diff --git a/SBO-Lib/lib/SBO/Lib/Pkgs.pm b/SBO-Lib/lib/SBO/Lib/Pkgs.pm
deleted file mode 100644
index 9e9e029..0000000
--- a/SBO-Lib/lib/SBO/Lib/Pkgs.pm
+++ /dev/null
@@ -1,198 +0,0 @@
-package SBO::Lib::Pkgs;
-
-use 5.016;
-use strict;
-use warnings;
-
-our $VERSION = '2.8.0';
-
-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;
-}
-
-1;