Changeset 5639 for branches/Release01x00/core/tools/extender.pl

Timestamp:

11/25/09 15:51:48 (2 years ago)

Author:

OlivierRaginel

Message:

Item8084: Add -c option to extender.pl to prevent CPAN.
Use Getopt::Std to parse arguments.
Allow directories in MANIFEST.
Cleanup session once it's been used.

File:

• branches/Release01x00/core/tools/extender.pl (modified) (10 diffs)

branches/Release01x00/core/tools/extender.pl

@@ -34 +34 @@
 use File::Copy;
 use File::Path;
+use Getopt::Std;
 
 no warnings 'redefine';
 
-my $noconfirm  = 0;
-my $downloadOK = 0;
-my $alreadyUnpacked = 0;
-my $reuseOK    = 0;
-my $inactive   = 0;
+my $noconfirm;
+my $downloadOK;
+my $alreadyUnpacked;
+my $reuseOK;
+my $inactive;
+my $noCPAN;
+my $action;
 my $session;
 my %available;
@@ -58 +61 @@
     $installationRoot = $1;
 
+    sub processParameters {
+        my %opts;
+        getopts('acdnru', \%opts);
+        $noconfirm = $opts{a};
+        $noCPAN = $opts{c};
+        $downloadOK = $opts{d};
+        $reuseOK = $opts{r};
+        $inactive = $opts{n};
+        $alreadyUnpacked = $opts{u};
+        if( @ARGV > 1 ) {
+            usage();
+            die 'Too many parameters: ' . join(" ", @ARGV);
+        }
+        $action = $ARGV[0];
+        $action ||= 'install';  # Default target is install
+    }
+
     # Check if we were invoked from configure
     # by looking at the call stack
@@ -67 +87 @@
             }
         }
-        return 0;
-    }
+        return;
+    }
+
     my $check_perl_module = sub {
         my $module = shift;
 
         if ( $module =~ /^CPAN/ ) {
-
-            # Check how we were invoked as CPAN shouldn't
-            # be loaded from the configure
-            if (running_from_configure) {
-                print "Running from configure, disabling $module\n";
+            if ($noCPAN) {
+                print "CPAN is disabled, disabling $module\n";
                 return $available{$module} = 0;
             }
@@ -100 +118 @@
     }
 
+    processParameters();
     # read setlib.cfg
     chdir('bin');
@@ -126 +145 @@
     }
     &$check_perl_module('CPAN');
-    
-    $session->finish();
-    undef $session;
 }
 
@@ -581 +597 @@
         $cmd .= ' -r' if $reuseOK;
         $cmd .= ' -n' if $inactive;
+        $cmd .= ' -c' if $noCPAN;
         $cmd .= ' install';
         local $| = 0;
@@ -794 +811 @@
         $err = $@;
     }
+    $session->finish();
+    undef $session;
     return ( !$err );
 }
@@ -852 +871 @@
         print "Install $target, permissions $MANIFEST->{$file}->{perms}\n";
         unless ($inactive) {
-            if ( -e $target ) {
+            if ( -e $target && ! -d _ ) {
                 # Save current permissions, remove write protect for Windows sake,  
                 # Back up the file and then restore the original permissions
@@ -864 +883 @@
                 }
             }
-            my @path = split( /[\/\\]+/, $target );
+            my @path = split( /[\/\\]+/, $target, -1 ); # -1 allows directories
             pop(@path);
             if ( scalar(@path) ) {
                 File::Path::mkpath( join( '/', @path ) );
             }
-            File::Copy::move( $source, $target )
-              || die "Failed to move $source to $target: $!\n";
+            unless( -d $source ) {
+                File::Copy::move( $source, $target )
+                    || print STDERR "Failed to move $source to $target: $!\n";
+            }
         }
         unless ($inactive) {
@@ -1132 +1153 @@
     unshift( @INC, 'lib' );
 
-    my $n      = 0;
-    my $action = 'install';
-    while ( $n < scalar(@ARGV) ) {
-        if ( $ARGV[$n] eq '-a' ) {
-            $noconfirm = 1;
-        }
-        elsif ( $ARGV[$n] eq '-d' ) {
-            $downloadOK = 1;
-        }
-        elsif ( $ARGV[$n] eq '-r' ) {
-            $reuseOK = 1;
-        }
-        elsif ( $ARGV[$n] eq '-n' ) {
-            $inactive = 1;
-        }
-        elsif ( $ARGV[$n] eq '-u' ) {
-            $alreadyUnpacked = 1;
-        }
-        elsif ( $ARGV[$n] =~ m/(install|uninstall|manifest|dependencies)/ ) {
-            $action = $1;
-        }
-
-# SMELL:   There really shouldn't be a null argument.  But installer breaks if it is there.
-        elsif ( $ARGV[$n] eq '' ) {
-            $n++;
-            next;
-        }
-        else {
-            usage();
-            die 'Bad parameter ' . $ARGV[$n];
-        }
-        $n++;
-    }
-
     if ( $action eq 'manifest' ) {
         foreach my $row ( split( /\r?\n/, $data{MANIFEST} ) ) {