pf-tools/pf-tools: using Module::Runtime in Packages.pm and crea...

parmelan-guest at users.alioth.debian.org parmelan-guest at users.alioth.debian.org
Fri Sep 10 21:50:45 UTC 2010


changeset dc0dd324c5d9 in /srv/hg.debian.org/hg/pf-tools/pf-tools
details: http://hg.debian.org/hg/pf-tools/pf-tools?cmd=changeset;node=dc0dd324c5d9
summary: using Module::Runtime in Packages.pm and creating Packages::DEB

diffstat:

4 files changed, 118 insertions(+), 4 deletions(-)
debian/changelog            |    1 
lib/PFTools/Conf.pm         |    2 
lib/PFTools/Packages.pm     |    2 
lib/PFTools/Packages/DEB.pm |  117 +++++++++++++++++++++++++++++++++++++++++++

diffs (truncated from 685 to 300 lines):

diff -r 38223b4691e9 -r dc0dd324c5d9 debian/changelog
--- a/debian/changelog	Fri Sep 10 13:41:35 2010 +0200
+++ b/debian/changelog	Fri Sep 10 23:50:11 2010 +0200
@@ -21,8 +21,9 @@
   * adding PFTools::VCS::CVS and PFTools::VCS::SVN
   * fix depends on debian/control with libmodule-runtime-perl
   * IO::File on Addmount (see README.coding.style) 
+  * using Module::Runtime in Packages.pm and creating Packages::DEB
 
- -- Thomas Parmelan <tom at sitadelle.com>  Fri, 10 Sep 2010 09:16:02 +0200
+ -- Christophe Caillet <quadchris at free.fr>  Fri, 10 Sep 2010 23:48:28 +0200
 
 pf-tools (1.0-1) unstable; urgency=low
 
diff -r 38223b4691e9 -r dc0dd324c5d9 lib/PFTools/Conf.pm
--- a/lib/PFTools/Conf.pm	Fri Sep 10 13:41:35 2010 +0200
+++ b/lib/PFTools/Conf.pm	Fri Sep 10 23:50:11 2010 +0200
@@ -1,6 +1,4 @@
 package PFTools::Conf;
-##
-##  $Id$
 ##
 ##  Copyright (C) 2007-2010 Christophe Caillet <quadchris at free.fr>
 ##  Copyright (C) 2005-2007 Thomas Parmelan <tom+pf-tools at ankh.fr.EU.org>
@@ -178,7 +176,11 @@
 
     unless ($host) {
         Abort( $CODE->{'UNDEF_KEY'},
-            "Unable to init substitution hash (undefined hostname).\n" );
+            "Unable to init substitution hash (undefined hostname)." );
+    }
+    unless (ref $hosttype ne 'SCALAR') {
+        Abort ( $CODE->{'INVALID_VALUE'},
+            "Hosttype parameter must be a string" );
     }
     unless ($pf_config) {
         $pf_config = Init_PF_CONFIG();
diff -r 38223b4691e9 -r dc0dd324c5d9 lib/PFTools/Packages.pm
--- a/lib/PFTools/Packages.pm	Fri Sep 10 13:41:35 2010 +0200
+++ b/lib/PFTools/Packages.pm	Fri Sep 10 23:50:11 2010 +0200
@@ -1,8 +1,6 @@
 package PFTools::Packages;
 ##
-##  $Id$
-##
-##  Copyright (C) 2009 Christophe Caillet <quadchris at free.fr>
+##  Copyright (C) 2009-2010 Christophe Caillet <quadchris at free.fr>
 ##
 ##  This program is free software; you can redistribute it and/or
 ##  modify it under the terms of the GNU General Public License
@@ -24,8 +22,10 @@
 
 use English qw( -no_match_vars );    # Avoids regex performance penalty
 use Exporter;
+use Module::Runtime qw( use_module );
 
 use PFTools::Logger;
+use PFTools::Packages::DEB;
 
 our @ISA = ('Exporter');
 
@@ -41,301 +41,111 @@
 
 our @EXPORT_OK = qw();
 
-my $PKG_CMD = {};
-$PKG_CMD->{'deb'}->{'status'} = 'LANG=C LC_ALL=C /usr/bin/dpkg -s';
-$PKG_CMD->{'deb'}->{'update'}
-    = 'LANG=C LC_ALL=C /usr/bin/apt-get -y --force-yes update';
-$PKG_CMD->{'deb'}->{'depends'} = 'LANG=C LC_ALL=C /usr/bin/apt-cache show';
-$PKG_CMD->{'deb'}->{'install'}
-    = 'LANG=C LC_ALL=C /usr/bin/apt-get -y --force-yes install';
-$PKG_CMD->{'deb'}->{'purge'}  = 'LANG=C LC_ALL=C /usr/bin/dpkg --purge';
-$PKG_CMD->{'deb'}->{'policy'} = 'LANG=C LC_ALL=C /usr/bin/apt-cache policy';
-$PKG_CMD->{'deb'}->{'compare'}
-    = 'LANG=C LC_ALL=C /usr/bin/dpkg --compare-versions';
-$PKG_CMD->{'rpm'} = 'TODO';
-
 my $VERBOSE = 0;
 
-sub Get_pkg_status ($$) {
+sub Init_pkgtype_module {
+    my ( $pkg_type, $pf_config ) = @_;
+
+    return unless $pkg_type;
+
+    my $module_name = "PFTools::Packages::".uc( $pkg_type );
+    my $module;
+    eval { $module = use_module($module_name); };
+    $module->import();
+    return 1;
+}
+
+sub Get_pkg_status {
     my ( $pkg_type, $pkg_name ) = @_;
 
+    return unless $pkg_type or $pkg_name;
     my $result = {};
-    if ( !defined $PKG_CMD->{$pkg_type} ) {
-        Warn( $CODE->{'OPEN'}, "Unknown package type " . $pkg_type )
-            if ($VERBOSE);
-        return undef;
+
+    if( ! Init_pkgtype_module ( $pkg_type ) ) {
+        Warn ($CODE->{'OPEN'},
+            "Unable to init package engine" );
+        return;
     }
-    elsif ( $pkg_type eq 'rpm' ) {
-
-        #TODO
-        Warn( $CODE->{'OPEN'}, "Need to implement the RPM handler" )
-            if ($VERBOSE);
-        return undef;
-    }
-    elsif ( $pkg_type eq 'deb' ) {
-        unless (
-            open( PKG,
-                      $PKG_CMD->{$pkg_type}->{'status'} . ' '
-                    . $pkg_name
-                    . ' 2>/dev/null |'
-            )
-            )
-        {
-            Warn( $CODE->{'OPEN'},
-                "Unable to retrieve status for package " . $pkg_name )
-                if ($VERBOSE);
-            return undef;
-        }
-        while (<PKG>) {
-            if (/^Status:\s+/) {
-                if ( !/^Status:\s+install\s+ok\s+installed\s*$/ ) {
-                    $result->{'installed'} = 0;
-                }
-                else {
-                    $result->{'installed'} = 1;
-                }
-            }
-            if (/^Version:\s+(.+)\s*$/) {
-                $result->{'version'} = $1;
-                last;
-            }
-        }
-        close(PKG);
-    }
-    return $result;
+    return Pkg_status ( $pkg_name );
 }
 
 sub Update_pkg_repository ($) {
     my ($pkg_type) = @_;
 
-    if ( !defined $PKG_CMD->{$pkg_type} ) {
-        Warn( $CODE->{'OPEN'}, "Unknown package type " . $pkg_type )
-            if ($VERBOSE);
-        return 0;
+    return unless $pkg_type;
+
+    if( ! Init_pkgtype_module ( $pkg_type ) ) {
+        Warn ($CODE->{'OPEN'},
+            "Unable to init package engine" );
+        return;
     }
-    elsif ( $pkg_type eq 'rpm' ) {
-
-        #TODO
-        Warn( $CODE->{'OPEN'}, "Need to implement the RPM handler" )
-            if ($VERBOSE);
-        return 0;
-    }
-    elsif ( $pkg_type eq 'deb' ) {
-        if ( deferredlogsystem( $PKG_CMD->{$pkg_type}->{'update'} ) ) {
-            Warn( $CODE->{'OPEN'}, "Updating repository failed !" )
-                if ($VERBOSE);
-            return 0;
-        }
-    }
-    return 1;
+    return Pkg_update_repository ();
 }
 
 sub Purge_pkg ($$) {
     my ( $pkg_type, $pkg_name ) = @_;
 
-    if ( !defined $PKG_CMD->{$pkg_type} ) {
-        Warn( $CODE->{'OPEN'}, "Unknown package type " . $pkg_type )
-            if ($VERBOSE);
-        return 0;
+    return unless $pkg_type or $pkg_name;
+
+    if( ! Init_pkgtype_module ( $pkg_type ) ) {
+        Warn ($CODE->{'OPEN'},
+            "Unable to init package engine" );
+        return;
     }
-    elsif ( $pkg_type eq 'rpm' ) {
-
-        #TODO
-        Warn( $CODE->{'OPEN'}, "Need to implement the RPM handler" )
-            if ($VERBOSE);
-        return 0;
-    }
-    elsif ( $pkg_type eq 'deb' ) {
-        if (deferredlogsystem(
-                $PKG_CMD->{$pkg_type}->{'purge'} . " '" . $pkg_name . "'"
-            )
-            )
-        {
-            Warn( $CODE->{'OPEN'}, "Unable to purge " . $pkg_name )
-                if ($VERBOSE);
-            return 0;
-        }
-    }
-    return 1;
+    return Pkg_purge ( $pkg_name );
 }
 
 sub Get_pkg_depends ($$) {
     my ( $pkg_type, $pkg_name ) = @_;
-    my $dep_list;
 
-    if ( !defined $PKG_CMD->{$pkg_type} ) {
-        Warn( $CODE->{'OPEN'}, "Unknown package type " . $pkg_type )
-            if ($VERBOSE);
-        return undef;
+    return unless $pkg_type or $pkg_name;
+
+    if( ! Init_pkgtype_module ( $pkg_type ) ) {
+        Warn ($CODE->{'OPEN'},
+            "Unable to init package engine" );
+        return;
     }
-    elsif ( $pkg_type eq 'rpm' ) {
-
-        #TODO
-        Warn( $CODE->{'OPEN'}, "Need to implement the RPM handler" )
-            if ($VERBOSE);
-        return undef;
-    }
-    elsif ( $pkg_type eq 'deb' ) {
-        unless (
-            open( APTDEP,
-                      $PKG_CMD->{$pkg_type}->{'depends'} . ' '
-                    . $pkg_name
-                    . ' 2>/dev/null |'
-            )
-            )
-        {
-            Warn( $CODE->{'OPEN'},
-                "Unable to get depends for package " . $pkg_name )
-                if ($VERBOSE);
-            return undef;
-        }
-        while (<APTDEP>) {
-            if (m/^Depends: (.*)$/) {
-                foreach my $pkg ( split( /,/, $1 ) ) {
-                    if ( $pkg =~ /|/ ) {
-                        $pkg =~ s/\([^\)]+\)//g;
-                        $pkg =~ s/\s+//g;
-                        foreach my $possible_pkg ( split( /\|/, $pkg ) ) {
-                            if ( $possible_pkg ne $pkg_name ) {
-                                $dep_list .= " " . $possible_pkg;
-                            }
-                        }
-                    }
-                    elsif ( $pkg ne $pkg_name ) {
-                        $dep_list .= " " . $pkg;
-                    }
-                }
-            }
-        }
-        close(APTDEP);
-    }
-    $dep_list =~ s/^\s*//;
-    return $dep_list;
+    return Pkg_depends ( $pkg_name );
 }
 
 sub Get_pkg_policy ($$$) {
     my ( $pkg_type, $pkg_name, $version ) = @_;
-    my ( $installed, $available, $specified_version );
 
-    $specified_version = 0;
-    if ( !defined $PKG_CMD->{$pkg_type} ) {
-        Warn( $CODE->{'OPEN'}, "Unknown package type " . $pkg_type )
-            if ($VERBOSE);
-        return undef;
+    return unless $pkg_type or $pkg_name;
+
+    if( ! Init_pkgtype_module ( $pkg_type ) ) {
+        Warn ($CODE->{'OPEN'},
+            "Unable to init package engine" );
+        return;
     }
-    elsif ( $pkg_type eq 'rpm' ) {
-
-        #TODO
-        Warn( $CODE->{'OPEN'}, "Need to implement the RPM handler" )
-            if ($VERBOSE);
-        return undef;



More information about the pf-tools-commits mailing list