[gentoo-perl] r29 - in trunk: bin extra-docs

Author: cab
Date: 2005-05-15 18:44:07 +0200 (Sun, 15 May 2005)
New Revision: 29

Modified:
   trunk/bin/g-cpan.pl
   trunk/extra-docs/Changes
Log:
- Lots of colours everywhere !
- new subs for text formatting
- replaced all simple print() call by print_x() ones


Modified: trunk/bin/g-cpan.pl
===================================================================
--- trunk/bin/g-cpan.pl	2005-05-15 12:29:15 UTC (rev 28)
+++ trunk/bin/g-cpan.pl	2005-05-15 16:44:07 UTC (rev 29)
@@ -80,14 +80,14 @@
 
 # Output error if more than one switch is activated
 if ( $search + $list + $install + $upgrade > 1 ) {
-    print
-"You can't combine search, list, install or upgrade with each other. Pick up one !\n\n";
+    print_err(
+"You can't combine search, list, install or upgrade with each other. Pick up one !\n");
     exit_usage();
 }
 
 # Output error if no arguments
 if ( !( defined( $ARGV[0] ) ) and !( defined($upgrade) or defined($list) ) ) {
-    print "Not even one module name or expression given !\n\n";
+    print_err ("Not even one module name or expression given !\n");
     exit_usage();
 }
 
@@ -130,7 +130,7 @@
         if ( $expr !~ m|::| ) {
             $expr =~ s/-/::/g;
         }
-        print "Searching for $expr on CPAN\n\n";
+        print_ok ("Searching for $expr on CPAN");
         CPAN::Shell->m("/$expr/");
     }
 
@@ -172,13 +172,12 @@
 if ( $OVERLAYS[0] ) {
     $tmp_overlay_dir = $OVERLAYS[0];
     if ($verbose) {
-        print
-          "Setting $tmp_overlay_dir as the PORTDIR_OVERLAY for this session.\n";
+        print_info ("Setting $tmp_overlay_dir as the PORTDIR_OVERLAY for this session.");
     }
 }
 
 # Grab the whole available arches list, to include them later in ebuilds
-print "Grabbing arch list\n" if $verbose;
+print "Grabbing arch list" if $verbose;
 my $arches = do {
         open my $tmp, "<$PORTAGE_DIR/profiles/arch.list"
           or fatal(ERR_OPEN_READ, "$PORTAGE_DIR/profiles/arch.list", $!);
@@ -205,7 +204,7 @@
 
 # Take care of List requests. This should return all the ebuilds managed by g-cpan
 if ($list) {
-    printbig "Generating list of modules managed by g-cpan";
+    print_ok ("Generating list of modules managed by g-cpan");
     my @managed = get_gcpans();
 }
 
@@ -261,7 +260,7 @@
             if(lc $file eq lc $dir) {
 	    	my $cat = basename($sdir);
                 $found = "$cat/$file";
-                print "$prog: Looking for ebuilds in $sdir, found $found so far.\n" if $verbose;
+                print_info ("$prog: Looking for ebuilds in $sdir, found $found so far.") if $verbose;
                 close PDIR;
                 last SOURCE_FOLDER;
             }
@@ -288,14 +287,14 @@
 	# Yes - this is potentially a large list of dirs, and we only want the ones containing the tail perl-gcpan
 	# - mcummings
         if ( basename($sdir) eq "perl-gcpan" ) {
-    	    print "OVERLAY: $sdir\n" if $list;
+    	    print_info ("OVERLAY: $sdir") if $list;
             # FIXME Sniper
             # maybee replace fatal by "warn and next folder" ?
             opendir PDIR, $sdir or fatal(ERR_FOLDER_OPEN, $sdir, $!);
             while(my $file = readdir PDIR) {
                 next if $file eq '.'
                      or $file eq '..';
-		print "perl-gcpan/$file\n" if $list;
+		print_info ("perl-gcpan/$file") if $list;
                 push @g_list, $file;
             }
             closedir PDIR;
@@ -333,11 +332,11 @@
     my $fulldir  = File::Spec->catdir( $perldev_overlay, $dir );
     my $filesdir = File::Spec->catdir( $fulldir,         'files' );
     unless ( -d $fulldir ) {
-        print "Create folder '$fulldir'\n" if $verbose;
+        print_info ("Create folder '$fulldir'") if $verbose;
         mkdir($fulldir, 0755) or fatal(ERR_FOLDER_CREATE, $fulldir, $!);
     }
     unless ( -d $filesdir ) {
-        print "Create folder '$filesdir'\n" if $verbose;
+        print_info ("Create folder '$filesdir'") if $verbose;
         mkdir($filesdir, 0755) or fatal(ERR_FOLDER_CREATE, $filesdir, $!);
     }
 
@@ -346,7 +345,7 @@
     # CGI::Builder's '1.26+' version breaks portage
     #unless ( $file =~ m/(.*)\/(.*?)(-?)([0-9\.]+).*\.(?:tar|tgz|zip|bz2|gz)/ ) { MPC
     unless ( $file =~ m/.*\/.*?-?[0-9\.]+.*\.?:tar|tgz|zip|bz2|gz/ ) {
-        warn("Couldn't turn '$file' into an ebuild name\n");
+        warn("Couldn't turn '$file' into an ebuild name");
         return;
     }
 
@@ -372,7 +371,7 @@
 
     my $desc = $module->description || 'No description available.';
 
-    print "Writing to $ebuild\n" if ($verbose);
+    print_ok ("Writing to $ebuild") if ($verbose);
     open EBUILD, ">$ebuild" or fatal(ERR_OPEN_WRITE, $ebuild, $!);
     print EBUILD <<"HERE";
 
@@ -447,7 +446,7 @@
 
     my $file = $obj->cpan_file;
     my $dir  = portage_dir($obj);
-    print "$prog: portage_dir returned $dir\n" if ($verbose);
+    print_info ("$prog: portage_dir returned $dir") if ($verbose);
     unless ($dir) {
         warn("Couldn't turn '$file' into a directory name\n");
         return;
@@ -465,15 +464,15 @@
         return;
     }
     elsif ( !defined $recursive && module_check($module_name) ) {
-        printbig "Module already installed for '$module_name'\n";
+        print_warn ("Module already installed for '$module_name'");
         return;
     }
     elsif ( $dir eq 'perl' ) {
-        printbig "Module '$module_name' is part of the base perl install\n";
+        print_warn ("Module '$module_name' is part of the base perl install");
         return;
     }
 
-    printbig "Need to create ebuild for '$module_name': $dir\n";
+    print_ok ("Need to create ebuild for '$module_name': $dir");
 
     # check depends ... with CPAN have to make the module
     # before it can tell us what the depends are, this stinks
@@ -527,7 +526,7 @@
     if ( $module_name !~ m|::| ) {
         $module_name =~ s/-/::/g;
     }    # Assume they gave us module-name instead of module::name
-    print "Looking for $module_name...\n";
+    print_info ("Looking for $module_name...");
     my $obj = CPAN::Shell->expandany($module_name);
     unless ( ( ref $obj eq "CPAN::Module" ) || ( ref $obj eq "CPAN::Bundle" ) )
     {
@@ -537,72 +536,74 @@
 
     my $file = $obj->cpan_file;
     my $dir  = portage_dir($obj);
-    print "$prog: portage_dir returned $dir\n" if ($verbose);
+    print_info ("$prog: portage_dir returned $dir") if ($verbose);
     unless ($dir) {
         warn("Couldn't turn '$file' into a directory name\n");
         return;
     }
 
     unless ( ebuild_exists($dir) ) {
-        printbig "No ebuild available for '$module_name': "
-          . &ebuild_exists($dir) . "\n";
+        print_warn ("No ebuild available for '$module_name': " . &ebuild_exists($dir));
         return;
     }
     elsif ( defined $recursive && !module_check($module_name) ) {
-        printbig "No module installed for '$module_name'\n";
+        print_warn ("No module installed for '$module_name'");
         return;
     }
     elsif ( $dir eq 'perl' ) {
-        printbig
-"Module '$module_name' is part of the base perl install - we don't touch perl here\n";
+        print_err
+("Module '$module_name' is part of the base perl install - we don't touch perl here");
         return;
     }
 
-    printbig "Checking ebuild for '$module_name': $dir\n";
+    print_info ("Checking ebuild for '$module_name': $dir");
     my $fullname = ebuild_exists($dir);
 
     if (dirname($fullname) eq "perl-gcpan") {
-    # check depends ... with CPAN have to make the module
-    # before it can tell us what the depends are, this stinks
+		
+    	# check depends ... with CPAN have to make the module
+    	# before it can tell us what the depends are, this stinks
 
-    $CPAN::Config->{prerequisites_policy} = "";
-    $CPAN::Config->{inactivity_timeout}   = 30;
+	    $CPAN::Config->{prerequisites_policy} = "";
+   		$CPAN::Config->{inactivity_timeout}   = 30;
 
-    my $pack = $CPAN::META->instance( 'CPAN::Distribution', $file );
-    $pack->called_for( $obj->id );
-    $pack->make;
+	    my $pack = $CPAN::META->instance( 'CPAN::Distribution', $file );
+    	$pack->called_for( $obj->id );
+    	$pack->make;
 
-    # A cheap ploy, but this lets us add module-build as needed
-    # instead of forcing it on everyone
-    my $add_mb = 0;
-    if ( -f "Build.PL" ) { $add_mb = 1 }
-    $pack->unforce if $pack->can("unforce") && exists $obj->{'force_update'};
-    delete $obj->{'force_update'};
+    	# A cheap ploy, but this lets us add module-build as needed
+    	# instead of forcing it on everyone
+    	my $add_mb = 0;
+    	if ( -f "Build.PL" ) { $add_mb = 1 }
+    	$pack->unforce if $pack->can("unforce") && exists $obj->{'force_update'};
+    	delete $obj->{'force_update'};
 
-    # grab the MD5 checksum for the source file now
+    	# grab the MD5 checksum for the source file now
 
-    my $localfile = $pack->{localfile};
-    ( my $base = $file ) =~ s/.*\/(.*)/$1/;
+    	my $localfile = $pack->{localfile};
+    	( my $base = $file ) =~ s/.*\/(.*)/$1/;
 
+    	my $md5string = sprintf "MD5 %s %s %d", file_md5sum($localfile), $base, -s $localfile;
 
-    my $md5string = sprintf "MD5 %s %s %d", file_md5sum($localfile), $base, -s $localfile;
+    	# make ebuilds for all the prereqs
+    	my $prereq_pm = $pack->prereq_pm;
+    	if ($add_mb) { $prereq_pm->{'Module::Build'} = "0" }
+    	install_module( $_, 1 ) for ( keys %$prereq_pm );
 
-    # make ebuilds for all the prereqs
-    my $prereq_pm = $pack->prereq_pm;
-    if ($add_mb) { $prereq_pm->{'Module::Build'} = "0" }
-    install_module( $_, 1 ) for ( keys %$prereq_pm );
+    	# get the build dir from CPAN, this will tell us definitively
+    	# what we should set S to in the ebuild
+    	# strip off the path element
+    	( my $build_dir = $pack->{build_dir} ) =~ s|.*/||;
 
-    # get the build dir from CPAN, this will tell us definitively
-    # what we should set S to in the ebuild
-    # strip off the path element
-    ( my $build_dir = $pack->{build_dir} ) =~ s|.*/||;
-
-    create_ebuild( $obj, $dir, $file, $build_dir, $prereq_pm, $md5string );
-    unless ( -f "$PORTAGE_DISTDIR/$localfile" ) {
-        system( '/bin/mv', '-f', $localfile, $PORTAGE_DISTDIR );
+    	create_ebuild( $obj, $dir, $file, $build_dir, $prereq_pm, $md5string );
+    	unless ( -f "$PORTAGE_DISTDIR/$localfile" ) {
+        	system( '/bin/mv', '-f', $localfile, $PORTAGE_DISTDIR );
+    	}
+        push @ebuild_list, "perl-gcpan/$dir";
     }
-        push @ebuild_list, "perl-gcpan/$dir";
-    } else { push @ebuild_list, "$fullname" }
+	else { 
+		push @ebuild_list, "$fullname";
+	}
 
 }
 
@@ -611,10 +612,10 @@
 	push @flags, "-p" if $pretend > 0;
 	push @flags, "-u" if $upgrade > 0;
 	push @flags,  "--ask" if $ask > 0;
-	print "Calling: emerge --oneshot --digest @ebuild_list\n" if ($verbose);
-        # FIXME Sniper
-        # check return values
-        system( "emerge",@flags, "--oneshot", "--digest", @ebuild_list );
+	print_info ("Calling: emerge --oneshot --digest @ebuild_list") if ($verbose);
+    # FIXME Sniper
+    # check return values
+    system( "emerge", @flags, "--oneshot", "--digest", @ebuild_list );
 }
 
 sub get_globals {
@@ -688,7 +689,7 @@
     my $cpan_cfg_dir  = File::Spec->catfile($ENV{HOME},    CPAN_CFG_DIR);
     my $cpan_cfg_file = File::Spec->catfile($cpan_cfg_dir, CPAN_CFG_NAME);
 
-    printbig "No CPAN Config found, auto-generating a basic one in $cpan_cfg_dir\n";
+    print_warn ("No CPAN Config found, auto-generating a basic one in $cpan_cfg_dir");
     if(not -d $cpan_cfg_dir) {
         mkpath($cpan_cfg_dir, 1, 0755 ) or fatal(ERR_FOLDER_CREATE, $cpan_cfg_dir, $!);
     }
@@ -767,6 +768,8 @@
 sub printbig {
 # FIXME cab
 # Rewrite using colors !
+# FIXING - cab
+# This sub should'nt be used now.
 # FIXME Sniper
 # 72 hard coded is bad
     print '*' x 72, "\n";
@@ -778,6 +781,24 @@
     print '*' x 72, "\n";
 }
 
+
+# cab - four (very fast) subs to help formating text output. Guess they could be improved a lot
+# maybe i should add a FIXME - Sniper around here.. :)
+# anyway, they expect a string and add a colored star at the beginning and the CR/LF
+# at the end of the line. oh, shiny world ;)
+sub print_ok {
+	print color("bold green"), "* ", color("reset"), @_, "\n";
+}
+sub print_info {
+	print color("bold cyan"), "* ", color("reset"), @_, "\n";
+}
+sub print_warn {
+	print color("bold yellow"), "* ", color("reset"), @_, "\n";
+}
+sub print_err{
+	print color("bold red"), "* ", color("reset"), @_, "\n";
+}
+
 #################################################
 # NAME  : fatal
 # AUTHOR: David "Sniper" Rigaudiere
@@ -798,7 +819,7 @@
 # FIXME cab : add a test (if -f $file) ?
 sub file_md5sum {
     my ($file) = @_;;
-    print "Computing MD5 Sum of $file\n" if $verbose;
+    print_info ("Computing MD5 Sum of $file") if $verbose;
 
     open DIGIFILE, $file or fatal(ERR_OPEN_READ, $file, $!);
     my $md5digest = Digest::MD5->new->addfile(*DIGIFILE)->hexdigest;
@@ -835,7 +856,7 @@
 # should try to see if it can be merged with clean_up()
 sub clean_the_mess {
     if ($verbose) {
-        print "Now cleaning up the system of all the junk we put in !\n";
+        print_info ("Now cleaning up the system of all the junk we put in !");
     }
     if ($needs_cpan_stub) {
         unlink "$ENV{HOME}/.cpan/CPAN/MyConfig.pm";

Modified: trunk/extra-docs/Changes
===================================================================
--- trunk/extra-docs/Changes	2005-05-15 12:29:15 UTC (rev 28)
+++ trunk/extra-docs/Changes	2005-05-15 16:44:07 UTC (rev 29)
@@ -1,3 +1,9 @@
+15/05/2005 - cab in wonderland
+
+- Lots of colours everywhere !
+- new subs for text formatting
+- replaced all simple print() call by print_x() ones
+
 15/05/2005 - mcummings
 
 - Removed sub that was no longer being invoked (had cleaned up the code for this last week)


-- 
gentoo-perl@g.o mailing list