[gentoo-perl] r10 - code

Author: sniper
Date: 2005-05-11 05:54:31 +0200 (Wed, 11 May 2005)
New Revision: 10

Modified:
   code/g-cpan.pl
Log:
Code cleaning centralisation error messages (easy internationalisation by example)
- Add ERR_ constants, use with fatal()
- get rid of die() and use fatal()
- add sub fatal() :)

Add FIXME



Modified: code/g-cpan.pl
===================================================================
--- code/g-cpan.pl	2005-05-11 02:53:30 UTC (rev 9)
+++ code/g-cpan.pl	2005-05-11 03:54:31 UTC (rev 10)
@@ -30,6 +30,15 @@
 use constant DEF_WGET_PROG     => '/usr/bin/wget';
 use constant DEF_BASH_PROG     => '/bin/bash';
 
+##### ERRORS constants (easy internationalisation ;-) #####
+use constant ERR_FILE_NOTFOUND   => "Couldn't find file '%s'";              # filename
+use constant ERR_FOLDER_NOTFOUND => "Couldn't find folder '%s'";            # foldername
+use constant ERR_OPEN_READ       => "Couldn't open (read) file'%s' : %s";   # filename, $!
+use constant ERR_OPEN_WRITE      => "Couldn't open (write) file'%s' : %s";  # filename, $!
+use constant ERR_OPEN_FOLDER     => "Couldn't open folder '%s', %s";        # foldername, $!
+use constant ERR_FOLDER_CREATE   => "Couldn't create folder '%s' : %s";     # foldername, $!
+
+
 # predeclared subs
 sub printbig;
 
@@ -166,19 +175,16 @@
 }
 
 # Grab the whole available arches list, to include them later in ebuilds
+print "Grabbing arch list\n" if $verbose;
 my $arches = do {
-    if ($verbose) {
-        print "Grabbing arch list\n";
-    }
-    open my $tmp, "$PORTAGE_DIR/profiles/arch.list"
-      or die "Unable to open '$PORTAGE_DIR/profiles/arch.list' : $!";
-    join " ", map { chomp; $_ } <$tmp>;
-  };
+        open my $tmp, "<$PORTAGE_DIR/profiles/arch.list"
+          or fatal(ERR_OPEN_READ, "$PORTAGE_DIR/profiles/arch.list", $!);
+        join " ", map { chomp; $_ } <$tmp>;
+};
 
-  #this should never find the dir, but just to be safe
-  unless ( -d $tmp_overlay_dir ) {
-    mkpath( [$tmp_overlay_dir], 1, 0755 )
-      or die "Couldn't create '$tmp_overlay_dir': $|";
+#this should never find the dir, but just to be safe
+if(not -d $tmp_overlay_dir) {
+    mkpath($tmp_overlay_dir, 1, 0755) or fatal(ERR_FOLDER_CREATE, $tmp_overlay_dir, $!);
 }
 
 # Now we cat our dev-perl directory onto our overlay directory.
@@ -186,15 +192,13 @@
 #i.e. dev-perl/package
 my $perldev_overlay = File::Spec->catfile( $tmp_overlay_dir, 'perl-gcpan' );
 
-unless ( -d $perldev_overlay ) {
-
+if(not -d $perldev_overlay) {
     # create perldev overlay dir if not present
-    mkpath( [$perldev_overlay], 1, 0755 )
-      or die "Couldn't create '$perldev_overlay': $|";
+    mkpath($perldev_overlay, 1, 0755) or fatal(ERR_FOLDER_CREATE, $perldev_overlay, $!);
 }
 
 # Now we export our overlay directory into the session's env vars
-$ENV{'PORTDIR_OVERLAY'} = $tmp_overlay_dir;
+$ENV{PORTDIR_OVERLAY} = $tmp_overlay_dir;
 
 # sub main.. well, sort of ;p
 if ($install) {
@@ -212,11 +216,12 @@
         upgrade_module($_) for (@GLIST);
         emerge_up_module(@GLIST);
     }
+}
 
+if($install or $upgrade) {
+    clean_up();
 }
 
-if ( $install or $upgrade ) { clean_up() }
-
 exit;
 
 ##########
@@ -225,6 +230,8 @@
 
 # jrray printing functions
 sub printbig {
+# FIXME Sniper
+# 72 hard coded is bad
     print '*' x 72, "\n";
     print '*',   "\n";
     print '*',   "\n";
@@ -243,14 +250,13 @@
     # see if an ebuild for $dir exists already. If so, return its name.
     my $found = '';
 
-    foreach my $sdir (
-        grep { -d $_ } (
-            @PORTAGE_DEV_PERL, @OVERLAY_PERLS,
-            $perldev_overlay,  @TMP_DEV_PERL_DIRS
-        )
-      )
-    {
-        opendir PDIR, $sdir;
+    foreach my $sdir (@PORTAGE_DEV_PERL, @OVERLAY_PERLS, $perldev_overlay, @TMP_DEV_PERL_DIRS) {
+        next if not -d $sdir;
+
+        opendir PDIR, $sdir or fatal(ERR_OPEN_FOLDER, $sdir, $!);
+        # FIXME Sniper
+        # we have to use while() construction otherwise we full memory and we read ALL THE folder
+        # even if we found the ebiuld on the 'first place', btw we can get rid of List::Util
         my @dirs = readdir(PDIR);
         closedir PDIR;
         $found ||= first { lc($_) eq lc($dir) }(@dirs);
@@ -270,8 +276,12 @@
 sub get_gcpans {
     my @g_list;
     foreach my $sdir ( grep { -d $_ } ( @PORTAGE_DEV_PERL, @OVERLAY_PERLS ) ) {
+        # FIXME Sniper
+        # Do we really need regexp here ?
         if ( $sdir =~ m/perl-gcpan/ ) {
             opendir PDIR, $sdir;
+            # FIXME Sniper
+            # use while() here
             my @dirs = readdir(PDIR);
             closedir PDIR;
             foreach my $dir (@dirs) {
@@ -292,6 +302,8 @@
 
     my $found = '';
 
+    # FIXME Sniper
+    # not nice construct, put grep inside
     foreach my $sdir (
         grep { -d $_ } (
             @PORTAGE_DEV_PERL, @OVERLAY_PERLS,
@@ -300,6 +312,8 @@
       )
     {
         opendir PDIR, $sdir;
+        # FIXME Sniper
+        # use while() here
         my @dirs = readdir(PDIR);
         closedir PDIR;
         $found ||= first { lc($_) eq lc($dir) }(@dirs);
@@ -350,12 +364,14 @@
     my $fulldir  = File::Spec->catdir( $perldev_overlay, $dir );
     my $filesdir = File::Spec->catdir( $fulldir,         'files' );
     unless ( -d $fulldir ) {
-        mkdir $fulldir, 0755 or die "Couldn't create '$fulldir': $!";
+        mkdir($fulldir, 0755) or fatal(ERR_FOLDER_CREATE, $fulldir, $!);
     }
     unless ( -d $filesdir ) {
-        mkdir $filesdir, 0755 or die "Couldn't create '$filesdir': $!";
+        mkdir($filesdir, 0755) or fatal(ERR_FOLDER_CREATE, $filesdir, $!);
     }
 
+    # FIXME Sniper
+    # these tests are useles since done during mkdir()
     unless ( -d $fulldir )  { die "$fulldir not created!!\n" }
     unless ( -d $filesdir ) { die "$fulldir not created!!\n" }
 
@@ -383,7 +399,7 @@
     my $desc = $module->description || 'No description available.';
 
     print "Writing to $ebuild\n" if ($verbose);
-    open EBUILD, ">$ebuild" or die "Could not write to '$ebuild': $!";
+    open EBUILD, ">$ebuild" or fatal(ERR_OPEN_WRITE, $ebuild, $!);
     print EBUILD <<"HERE";
 
 # Copyright 1999-2004 Gentoo Foundation
@@ -437,7 +453,7 @@
     close EBUILD;
 
     # write the digest too
-    open DIGEST, ">$digest" or die "Could not write to '$digest': $!";
+    open DIGEST, ">$digest" or fatal(ERR_OPEN_WRITE, $digest, $!);
     print DIGEST $md5, "\n";
     close DIGEST;
 }
@@ -515,6 +531,8 @@
 
     create_ebuild( $obj, $dir, $file, $build_dir, $prereq_pm, $md5string );
 
+    # FIXME Sniper
+    # OH MY GOD !
     system( '/bin/mv', '-f', $localfile, $PORTAGE_DISTDIR );
 
     push @ebuild_list, "perl-gcpan/$dir";
@@ -602,6 +620,8 @@
     }
 }
 
+# TODO Sniper
+# maybee put this in END {} block
 sub clean_up {
 
     #Probably don't need to do this, but for sanity's sake, we reset this var
@@ -617,6 +637,8 @@
     foreach my $ebuild_name (@ebuild_list) {
         $ebuild_name =~ m/.*\/(.*)-[^-]+\./;
         print "$0: emerging $ebuild_name\n";
+        # FIXME Sniper
+        # check return values
         system( "emerge", "--oneshot", "--digest", $ebuild_name );
     }
 }
@@ -634,6 +656,8 @@
     chomp($answer);
     if ( $answer =~ m|y|i ) {
         foreach my $ebuild_name (@ebuild_list) {
+            # FIXME Sniper
+            # check return values
             system( "emerge", "--oneshot", "--digest", $ebuild_name );
         }
     }
@@ -645,12 +669,14 @@
 
     # Setting default configs
     my %conf;
+    # FIXME Sniper
+    # use constants
     $conf{PORTDIR} = "/usr/portage";
     $conf{DISTDIR} = "/usr/portage/distfiles";
     my @OVERLAYS = ();
 
     # Opening make.conf to find real user settings
-    open CONF, "<$MAKECONF" or die "Open $MAKECONF failed : $!";
+    open CONF, "<$MAKECONF" or fatal(ERR_OPEN_READ, $MAKECONF, $!);
 
     # And parsing it :)
     while ( defined( my $line = <CONF> ) ) {
@@ -723,7 +749,7 @@
 
     printbig "No CPAN Config found, auto-generating a basic one in $cpan_cfg_dir\n";
     if(not -d $cpan_cfg_dir) {
-        mkpath($cpan_cfg_dir, 1, 0755 ) or die "Couldn't create folder '$cpan_cfg_dir' : $!";
+        mkpath($cpan_cfg_dir, 1, 0755 ) or fatal(ERR_FOLDER_CREATE, $cpan_cfg_dir, $!);
     }
 
     my $tmp_dir       = -d $ENV{TMPDIR}      ? $ENV{TMPDIR}      : $ENV{HOME};
@@ -741,7 +767,7 @@
     my $unzip_prog    = -x DEF_UNZIP_PROG    ? DEF_UNZIP_PROG    : '';
     my $wget_prog     = -x DEF_WGET_PROG     ? DEF_WGET_PROG     : '';
 
-    open CPANCONF, ">$cpan_cfg_file" or die "Couldn't create file '$cpan_cfg_file' : $!";
+    open CPANCONF, ">$cpan_cfg_file" or fatal(ERR_FOLDER_CREATE, $cpan_cfg_file, $!);
     print CPANCONF <<"SHERE";
 
 # This is CPAN.pm's systemwide configuration file. This file provides
@@ -795,16 +821,14 @@
 # Simple useful sub. returns md5 hexdigest of the given argument
 # awaits a file name.
 sub file_md5sum {
+    my ($file) = @_;;
+    print "Computing MD5 Sum of $file\n" if $verbose;
 
-    my $file = $_[0];
-
-    if ($verbose) {
-        print "Computing MD5 Sum of $file\n";
-    }
-
-    open(DIGIFILE, $file ) or die "Can't open '$file': $!";
+    open DIGIFILE, $file or fatal(ERR_OPEN_READ, $file, $!);
     my $md5digest = Digest::MD5->new->addfile(*DIGIFILE)->hexdigest;
-    close(DIGIFILE);
+    # FIXME Sniper
+    # here, check the md5sum
+    close DIGIFILE;
 
     return $md5digest;
 }
@@ -822,6 +846,17 @@
     }
 }
 
+#################################################
+# NAME  : fatal
+# AUTHOR: David "Sniper" Rigaudiere
+# OBJECT: die like with pattern format
+#
+# IN: 0 scalar pattern sprintf format
+#     x LIST   variables filling blank in pattern
+#################################################
+sub fatal { die sprintf(shift, @_) }
+
+
 sub exit_usage {
     print <<"USAGE";
 Usage : $0 <Switch(es)> Module Name(s)


-- 
gentoo-perl@g.o mailing list