aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorAngelo Naselli <anaselli@linux.it>2015-07-03 23:55:54 +0200
committerAngelo Naselli <anaselli@linux.it>2015-07-03 23:55:54 +0200
commit8dc0a0866387fc197fd00579bff1367f21422d14 (patch)
treee9f1f7614bbf7b9944e50daacfe7938726d1771d
parent9ab21363fe366594d904f01b254f0228335ec9c7 (diff)
downloadmanatools-8dc0a0866387fc197fd00579bff1367f21422d14.tar
manatools-8dc0a0866387fc197fd00579bff1367f21422d14.tar.gz
manatools-8dc0a0866387fc197fd00579bff1367f21422d14.tar.bz2
manatools-8dc0a0866387fc197fd00579bff1367f21422d14.tar.xz
manatools-8dc0a0866387fc197fd00579bff1367f21422d14.zip
Added tools to urpmi backend
-rw-r--r--MANIFEST1
-rw-r--r--lib/ManaTools/Shared/urpmi_backend/tools.pm505
-rw-r--r--t/09-Shared-urpmi_backend.t40
3 files changed, 541 insertions, 5 deletions
diff --git a/MANIFEST b/MANIFEST
index 9fc82d56..508c2d4e 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -60,6 +60,7 @@ lib/ManaTools/Rpmdragora/rpmnew.pm
lib/ManaTools/SettingsReader.pm
lib/ManaTools/Shared.pm
lib/ManaTools/Shared/urpmi_backend/DB.pm
+lib/ManaTools/Shared/urpmi_backend/tools.pm
lib/ManaTools/Shared/Firewall.pm
lib/ManaTools/Shared/GUI.pm
lib/ManaTools/Shared/Hosts.pm
diff --git a/lib/ManaTools/Shared/urpmi_backend/tools.pm b/lib/ManaTools/Shared/urpmi_backend/tools.pm
new file mode 100644
index 00000000..8fb03bf3
--- /dev/null
+++ b/lib/ManaTools/Shared/urpmi_backend/tools.pm
@@ -0,0 +1,505 @@
+# vim: set et ts=4 sw=4:
+package ManaTools::Shared::urpmi_backend::tools;
+
+#============================================================= -*-perl-*-
+
+=head1 NAME
+
+ ManaTools::Shared::urpmi_backend::tools - urpmi backend tools object
+
+=head1 SYNOPSIS
+
+ use ManaTools::Shared::urpmi_backend::tools;
+
+ my $urpm_tools = ManaTools::Shared::urpmi_backend::tools->new();
+
+
+=head1 DESCRIPTION
+
+ This module is a backend to some urpmi funcitionalities
+
+=head1 SUPPORT
+
+ You can find documentation for this module with the perldoc command:
+
+ perldoc ManaTools::Shared::urpmi_backend::tools
+
+=head1 SEE also
+
+ ManaTools::Shared::urpmi_backend::DB
+
+=head1 AUTHOR
+
+ Angelo Naselli <anaselli@linux.it>
+
+=head1 COPYRIGHT and LICENSE
+
+Copyright (c) 2015 Angelo Naselli <anaselli@linux.it>
+ from Rpmdrake:
+ Copyright (c) 2002 Guillaume Cottenceau
+ Copyright (c) 2003-2005 MandrakeSoft SA
+ Copyright (c) 2005-2007 Mandriva SA
+ Copyright (c) 2008 Aurelien Lefebvre <alkh@mandriva.org>
+ Copyright (c) 2002-2014 Thierry Vignaud <thierry.vignaud@gmail.com>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License version 2, as
+published by the Free Software Foundation.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+=head1 METHODS
+
+=cut
+
+use Moose;
+
+use strict;
+use ManaTools::Shared::urpmi_backend::DB;
+
+use MDK::Common::File qw(cat_);
+use URPM;
+use urpm::msg;
+
+# use Exporter;
+# our @ISA = qw(Exporter);
+# our @EXPORT = qw(
+# get_update_medias
+# rpm_description
+# urpm_name
+# find_installed_fullname
+# is_mageia
+# is_package_installed
+# get_package_id
+# ensure_utf8
+# pkg2medium
+# fullname_to_package_id
+# get_package_by_package_id
+# get_package_upgrade
+# get_installed_fullname
+# get_installed_fullname_pkid
+# );
+
+#=============================================================
+
+=head2 object attribute
+
+=head3 urpmi_db_backend
+
+ a ManaTools::Shared::urpmi_backend::DB object
+
+=cut
+
+#=============================================================
+has 'urpmi_db_backend' => (
+ is => 'rw',
+ init_arg => undef,
+ lazy => 1,
+ builder => '_urpmi_db_backend_init',
+);
+
+sub _urpmi_db_backend_init {
+ my $self = shift;
+
+ return ManaTools::Shared::urpmi_backend::DB->new(),
+}
+
+
+has 'loc' => (
+ is => 'rw',
+ lazy => 1,
+ init_arg => undef,
+ builder => '_localeInitialize'
+);
+
+sub _localeInitialize {
+ my $self = shift;
+
+ my $cmdline = new yui::YCommandLine;
+ my $locale_dir = undef;
+ my $pos = $cmdline->find("--locales-dir");
+ if ($pos > 0)
+ {
+ $locale_dir = $cmdline->arg($pos+1);
+ }
+ $self->loc(
+ ManaTools::Shared::Locales->new(
+ domain_name => 'manatools',
+ dir_name => $locale_dir,
+ )
+ );
+}
+
+#=============================================================
+
+=head2 get_update_medias
+
+=head3 INPUT
+
+ $urpm: an urpm object
+
+=head3 DESCRIPTION
+
+ This method returns a list of update media
+ (here for convenience, implemented in
+ ManaTools::Shared::urpmi_backend::DB)
+
+=cut
+
+#=============================================================
+sub get_update_medias {
+ my ($self, $urpm) = @_;
+
+ $self->urpmi_db_backend()->get_update_medias($urpm);
+}
+
+#=============================================================
+
+=head2 ensure_utf8
+
+=head3 INPUT
+
+ text: a string that is converted or left to utf8
+
+=head3 DESCRIPTION
+
+ This method ensure the given string is utf8
+=cut
+
+#=============================================================
+sub ensure_utf8 {
+ my ($self, $text) = @_;
+ return '' if !$text;
+
+ if (utf8::is_utf8($text)) {
+ utf8::valid($text) and return;
+ utf8::encode($text); #- disable utf8 flag
+ utf8::upgrade($text);
+ } else {
+ utf8::decode($text); #- try to set utf8 flag
+ utf8::valid($text) and return;
+ warn "do not know what to with $text\n";
+ }
+}
+
+#=============================================================
+
+=head2 rpm_description
+
+=head3 INPUT
+
+# description: package description field
+
+=head3 DESCRIPTION
+
+ Retrieve the rpm desctiption
+
+=cut
+
+#=============================================================
+sub rpm_description {
+ my ($self, $description) = @_;
+ ensure_utf8($description);
+ my ($t, $tmp);
+ foreach (split "\n", $description) {
+ s/^\s*//;
+ if (/^$/ || /^\s*(-|\*|\+|o)\s/) {
+ $t || $tmp and $t .= "$tmp\n";
+ $tmp = $_;
+ } else {
+ $tmp = ($tmp ? "$tmp " : ($t && "\n") . $tmp) . $_;
+ }
+ }
+ "$t$tmp\n";
+}
+
+#=============================================================
+
+=head2 urpm_name
+
+=head3 INPUT
+
+ $pkg: package
+
+=head3 DESCRIPTION
+
+ This method returns the urpm format name e.g.
+ name-version-release.arch
+
+=cut
+
+#=============================================================
+sub urpm_name {
+ my ($self, $pkg) = @_;
+
+ return '?-?-?.?' unless ref($pkg) eq 'URPM::Package';
+# my ($name, $version, $release, $arch) = $pkg->fullname;
+# return "$name-$version-$release.$arch";
+
+ return scalar $pkg->fullname;
+}
+
+#=============================================================
+
+=head2 is_package_installed
+
+=head3 INPUT
+
+ $package: package to find (URPM::Package) or package name
+
+=head3 DESCRIPTION
+
+ This method returns if a package is installed
+
+=cut
+
+#=============================================================
+sub is_package_installed {
+ my ($self, $pkg) = @_;
+
+ my $installed = 0;
+ my $db = $self->urpmi_db_backend()->open_rpm_db();
+ if (ref($pkg) eq 'URPM::Package') {
+ $installed = URPM::is_package_installed(URPM::DB::open(), $pkg);
+ }
+ else {
+ my $version = 0;
+ $db->traverse_tag_find('name', $pkg, sub { $version = $_[0]->EVR; return ($version ? 1 : 0) });
+ $installed = $version ? 1 : 0;
+ }
+
+ return $installed;
+}
+
+#=============================================================
+
+=head2 find_installed_fullname
+
+=head3 INPUT
+
+ $package: package to find (URPM::Package) or package name
+
+=head3 DESCRIPTION
+
+ This method returns the full name of the package if installed
+
+=cut
+
+#=============================================================
+sub find_installed_fullname {
+ my ($self, $p) = @_;
+
+ # we can call it with the name or packge
+ my $name = ref($p) eq 'URPM::Package' ? $p->name : $p;
+
+ my @fullname;
+ my $db = $self->urpmi_db_backend()->open_rpm_db();
+ $db->traverse_tag('name', [ $name ], sub { push @fullname, scalar($_[0]->fullname) });
+
+ return @fullname ? join(',', sort @fullname) : "";
+}
+
+
+#=============================================================
+
+=head2 is_mageia
+
+=head3 DESCRIPTION
+
+ This method returns if the system is mageia linux
+
+=cut
+
+#=============================================================
+sub is_mageia {
+ my $self = shift;
+ cat_('/etc/release') =~ /Mageia/;
+}
+
+#=============================================================
+
+=head2 vendor
+
+=head3 DESCRIPTION
+
+ This method returns if the vendor is mageia or mandriva
+
+=cut
+
+#=============================================================
+sub vendor {
+ my $self = shift;
+
+ is_mageia() ? "mageia" : "mandriva";
+}
+
+#=============================================================
+
+=head2 get_package_id
+
+=head3 INPUT
+
+ $package: package (URPM::Package)
+
+=head3 DESCRIPTION
+
+ This method returns the package id meant as
+ (name;version-release;arch;vendor)
+
+=cut
+
+#=============================================================
+sub get_package_id {
+ my ($self, $pkg) = @_;
+
+ return '?;?-?;?;?' unless ref($pkg) eq 'URPM::Package';
+
+ return join(';', $pkg->name, $pkg->version . "-" . $pkg->release, $pkg->arch, $self->vendor());
+}
+
+
+#=============================================================
+
+=head2 get_package_id
+
+=head3 INPUT
+
+ $p: package (URPM::Package)
+ $urpm: urpm object
+
+=head3 DESCRIPTION
+
+ Returns the medium that contains the URPM::Package $pkg
+
+=cut
+
+#=============================================================
+sub pkg2medium {
+ my ($self, $p, $urpm) = @_;
+ return if ref($p) ne 'URPM::Package';
+
+ return { name => $self->loc()->N("None (installed)") } if !defined($p->id); # if installed
+
+ return URPM::pkg2media($urpm->{media}, $p) || { name => $self->loc()->N("Unknown"), fake => 1 };
+}
+
+#=============================================================
+
+=head2 fullname_to_package_id
+
+=head3 INPUT
+
+ $pkg_string: package fullname
+
+=head3 DESCRIPTION
+
+ Returns package id meant as "name;varsion-release;arch;vendor"
+
+=cut
+
+#=============================================================
+sub fullname_to_package_id {
+ # fullname, ie 'xeyes-1.0.1-5mdv2008.1.i586'
+ my ($self, $pkg_string) = @_;
+ chomp($pkg_string);
+ if ($pkg_string =~ /^(.*)-([^-]*)-([^-]*)\.([^\.]*)$/) {
+# TODO NOTE check package kit backend it seems the urpm package_id is "name;varsion-release;arch;vendor"
+ return join(';', $1, "$2-$3", $4, vendor());
+ }
+}
+
+#=============================================================
+
+=head2 get_package_by_package_id
+
+=head3 INPUT
+
+ $urpm: urpm object
+ $package_id: package id (see fullname_to_package_id)
+
+=head3 DESCRIPTION
+
+ Returns URPM::Package package
+
+=cut
+
+#=============================================================
+sub get_package_by_package_id {
+ my ($self, $urpm, $package_id) = @_;
+ my @depslist = @{$urpm->{depslist}};
+ foreach (@depslist) {
+ if ($self->get_package_id($_) eq $package_id) {
+ return $_;
+ }
+ }
+
+ return;
+}
+
+#=============================================================
+
+=head2 get_installed_fullname_pkid
+
+ $pkg: package (URPM::Package) or package name (string)
+
+
+=head3 DESCRIPTION
+
+ Returns package id of the given package
+
+=cut
+
+#=============================================================
+sub get_installed_fullname_pkid {
+ my ($self, $pkg) = @_;
+ my $pkgname = ref($pkg) eq 'URPM::Package' ? $pkg->name : $pkg;
+ my $db = $self->urpmi_db_backend()->open_rpm_db();
+ my $installed_pkid;
+ $db->traverse_tag_find('name', $pkgname, sub {
+ my ($p) = @_;
+ $installed_pkid = $self->get_package_id($p);
+ });
+ return $installed_pkid;
+}
+
+#=============================================================
+
+=head2 get_package_upgrade
+
+ $urpm: urpm object
+ $pkg: package (URPM::Package) or package name (string)
+
+
+=head3 DESCRIPTION
+
+ Returns package to upgrade
+
+=cut
+
+#=============================================================
+sub get_package_upgrade {
+ my ($self, $urpm, $pkg) = @_;
+
+ my $db = $self->urpmi_db_backend()->open_rpm_db();
+ $urpm->compute_installed_flags($db);
+ my @depslist = @{$urpm->{depslist}};
+ my $pkgname = ref($pkg) eq 'URPM::Package' ? $pkg->name : $pkg;
+
+ foreach (@depslist) {
+ if ($_->name =~ /^$pkgname$/ && $_->flag_upgrade) {
+ return $_;
+ }
+ }
+
+ return;
+}
+
+
+1; \ No newline at end of file
diff --git a/t/09-Shared-urpmi_backend.t b/t/09-Shared-urpmi_backend.t
index c5501b41..55317cf3 100644
--- a/t/09-Shared-urpmi_backend.t
+++ b/t/09-Shared-urpmi_backend.t
@@ -3,12 +3,16 @@ use strict;
use warnings FATAL => 'all';
use Test::More;
use Data::Dumper;
+use URPM;
BEGIN {
use_ok( 'ManaTools::Shared::urpmi_backend::DB' ) || print "ManaTools::Shared::urpmi_backend::DB failed!\n";
+ use_ok( 'ManaTools::Shared::urpmi_backend::tools' ) || print "ManaTools::Shared::urpmi_backend::tools failed!\n";
}
-ok ( my $obj = ManaTools::Shared::urpmi_backend::DB->new(), 'new');
+diag "******* ManaTools::Shared::urpmi_backend::DB *******";
+
+ok ( my $obj = ManaTools::Shared::urpmi_backend::DB->new(), 'new_DB');
is ( ref($obj->open_rpm_db()), 'URPM::DB', 'open_rpm_db');
my $urpm = $obj->open_urpmi_db();
is ( ref($urpm), 'urpm', 'open_urpmi_db');
@@ -19,14 +23,40 @@ is ( ref($urpm), 'urpm', 'fast_open_urpmi_db');
is ( $obj->lock($urpm), 1, 'lock(locked)');
is ( $obj->unlock($urpm), undef, 'unlock');
+diag "******* ManaTools::Shared::urpmi_backend::tools *******";
+
+ok ( my $tool = ManaTools::Shared::urpmi_backend::tools->new(), 'new_tools');
+is ( ref($tool->urpmi_db_backend()), 'ManaTools::Shared::urpmi_backend::DB', 'urpmi_db_backend');
+ok (my $resp = $tool->get_update_medias($urpm), 'get_update_medias from tools');
+diag "\tfound < " . $resp . " > backport media";
+ok ( $tool->is_package_installed('rpm'), 'is_package_installed(rpm)');
+ok ( my $fullname = $tool->find_installed_fullname('urpmi'), 'find_installed_fullname');
+diag "\turpmi installed package is < " . $fullname . " > ";
+ok ( $resp = ($tool->is_mageia() ? "yes" : "no"), 'is_mageia');
+diag "\tIs the system mageia? < " . $resp . " > ";
+ok ( $resp = $tool->vendor(), 'vendor' );
+diag "\tThe vendor is < " . $resp . " > ";
+
+$urpm = $obj->open_urpmi_db();
-ok ( my $resp = ($obj->is_it_a_devel_distro() ? 'yes' : 'no'), 'is_it_a_devel_distro');
+ok ( $resp = $tool->fullname_to_package_id($fullname), 'fullname_to_package_id' );
+ok ( my $pkg = $tool->get_package_by_package_id($urpm, $resp), 'get_package_by_package_id' );
+is ($fullname, $pkg->fullname, 'fullname eq pkg->fullname' );
+ok ( $resp = $tool->pkg2medium($pkg, $urpm), 'pkg2medium' );
+diag "\tThe medium is < " . $resp->{name} . " > ";
+ok ( $resp = $tool->get_installed_fullname_pkid($pkg), 'get_installed_fullname' );
+diag "\tThe package_id is < " . $resp . " > ";
+
+
+ok ( $resp = ($obj->is_it_a_devel_distro() ? 'yes' : 'no'), 'is_it_a_devel_distro');
diag "\tis_it_a_devel_distro? < " . $resp . " >";
-ok ( $resp = $obj->get_backport_media($urpm), 'get_backport_media');
+ok ( $resp = $obj->get_backport_media($urpm) || 'none', 'get_backport_media');
diag "\tfound < " . $resp . " > backport media";
-ok ( $resp = $obj->get_inactive_backport_media($urpm), 'get_inactive_backport_media');
+ok ( $resp = $obj->get_inactive_backport_media($urpm) || 'none', 'get_inactive_backport_media');
diag "\tfound < " . $resp . " > inactive backport media";
-ok ( $resp = $obj->get_update_medias($urpm), 'get_update_medias');
+ok ( $resp = $obj->get_update_medias($urpm) || 'none', 'get_update_medias');
diag "\tfound < " . $resp . " > update media";
+
+
done_testing;