--- loncom/build/system_dependencies/perltest.pl 2002/08/14 16:54:35 1.7 +++ loncom/build/system_dependencies/perltest.pl 2003/08/22 20:48:38 1.12 @@ -2,7 +2,7 @@ # perltest.pl - script to test the status of perl modules on a LON-CAPA system # -# $Id: perltest.pl,v 1.7 2002/08/14 16:54:35 harris41 Exp $ +# $Id: perltest.pl,v 1.12 2003/08/22 20:48:38 albertel Exp $ # ### @@ -16,10 +16,6 @@ B - Test status of perl mod # Written to help LON-CAPA (The LearningOnline Network with CAPA) # -# YEAR=2001 -# 9/30 Scott Harrison -# YEAR 2002 and onwards -# Scott Harrison, sharrison@users.sourceforge.net =pod @@ -142,8 +138,6 @@ Ratings: 1=horrible 2=poor 3=fair 4=good =head1 AUTHOR -Scott Harrison, sharrison@users.sourceforge.net, 2001, 2002 - This software is distributed under the General Public License, version 2, June 1991 (which is the same terms as LON-CAPA). @@ -164,7 +158,7 @@ Foundation, Inc., 59 Temple Place, Suite =cut # =================================== Process version information of this file. -my $VERSION = sprintf("%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/); +my $VERSION = sprintf("%d.%02d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/); # ========================== Determine the mode that this script should run in. my $mode; @@ -187,11 +181,14 @@ if ($mode eq "html") { print(< + CPAN perl status report; $hostname; $date - +

CPAN perl status report

 END
@@ -328,158 +325,135 @@ my @dev_missing;
 my @dev_outdated;
 my @dev_okay;
 my @dev_veryokay;
+my @dev_to_update;
 my @stable_missing;
 my @stable_outdated;
 my @stable_okay;
 my @stable_veryokay;
+my @stable_to_update;
 
 # ===== Loop through all of the needed CPAN distributions and probe the system.
-foreach my $dist (keys %dist_module_hash)
-  {
+foreach my $dist (keys %dist_module_hash) {
     my $module = $dist_module_hash{$dist};
     my $fs = $modulefs_hash{$module};
     my $fsflag = 0;
-    if ($big_module_string =~ /$fs/)
-      {
-        $fsflag = 1;
-      }
+    if ($big_module_string =~ /$fs/) { $fsflag = 1; }
     my ($vok,$vstr);
-    ($vok,$vstr) = have_vers($module,$module_dev_version_hash{$module});
-    # print "fsflag: $fsflag, vok: $vok, vstr: $vstr, fs: $fs\n";
-    if ($fsflag and !$vok and $vstr=~/not found/)
-      {
-	push(@dev_missing,'MISSING  '.$dist.' (want distribution version '.
-	     $dist_dev_version_hash{$dist}.') ?'."\n");
-	# The question mark indicates there was a pattern match in the
-	# big_module_string which would be unexpected.
-	# There is no usual reason to tell the normal LON-CAPA user about this
-	# question mark.  This is just source code magic.
-      }
-    elsif (!$fsflag and !$vok and $vstr=~/not found/)
-      {
-	push(@dev_missing,'MISSING  '.$dist.' (want distribution version '.
-	     $dist_dev_version_hash{$dist}.')'."\n");
-      }
-    elsif ($fsflag and !$vok and $vstr!~/not found/)
-      {
-	push(@dev_outdated,'OUTDATED '.$dist.' wanted module: v'.
-	     $module_dev_version_hash{$module}.'; '.$vstr.' (VERSION_FROM is '.
-	     $fs.') want dist version '.$dist_dev_version_hash{$dist}.'.'.
-	     "\n");
-      }
-    elsif ($fsflag)
-      {
-	$vstr=~/found v(.*)/;
-	my $vc=$1;
-	if ($vc eq $module_dev_version_hash{$module})
-          {
-	    push(@dev_veryokay,'VERYOKAY '.$dist.' wanted: v'.
-		 $module_dev_version_hash{$module}.'; '.$vstr.
-		 ' (VERSION_FROM is '.$fs.') want dist version '.
-		 $dist_dev_version_hash{$dist}."\n");
-	  }
-	else
-          {
-	    push(@dev_okay,'OKAY     '.$dist.' wanted: v'.
-		  $module_dev_version_hash{$module}.'; '.$vstr.
-		  ' (VERSION_FROM is '.$fs.').'."\n");
-	  }
-      }
-    ($vok,$vstr) = have_vers($module,$module_stable_version_hash{$module});
-    if ($fsflag and !$vok and $vstr=~/not found/)
-      {
-	push(@stable_missing,'MISSING  '.$dist.' (want distribution version '.
-	     $dist_stable_version_hash{$dist}.') ?'."\n");
-	# The question mark indicates there was a pattern match in the
-	# big_module_string which would be unexpected.
-	# There is no usual reason to tell the normal LON-CAPA user about this
-	# question mark.  This is just source code magic.
-      }
-    elsif (!$fsflag and !$vok and $vstr=~/not found/)
-      {
-	push(@stable_missing,'MISSING  '.$dist.' (want distribution version '.
-	     $dist_stable_version_hash{$dist}.')'."\n");
-      }
-    elsif ($fsflag and !$vok and $vstr!~/not found/)
-      {
-	push(@stable_outdated,'OUTDATED '.$dist.' wanted module: v'.
-	     $module_stable_version_hash{$module}.'; '.$vstr.
-	     ' (VERSION_FROM is '.$fs.') want dist version '.
-	     $dist_stable_version_hash{$dist}.'.'."\n");
-      }
-    elsif ($fsflag)
-      {
-	$vstr=~/found v(.*)/;
-	my $vc=$1;
-	if ($vc eq $module_stable_version_hash{$module})
-          {
-	    push(@stable_veryokay,'VERYOKAY '.$dist.' wanted: v'.
-		 $module_stable_version_hash{$module}.'; '.$vstr.
-		 ' (VERSION_FROM is '.$fs.') want dist version '.
-		 $dist_stable_version_hash{$dist}."\n");
-	  }
-	else
-          {
-	    push(@stable_okay,'OKAY     '.$dist.' wanted: v'.
-		  $module_stable_version_hash{$module}.'; '.$vstr.
-		  ' (VERSION_FROM is '.$fs.').'."\n");
-	  }
-      }
-  }
+    foreach my $type ('dev','stable') {
+	my ($vers_mod,$vers_dist);
+	my ($missing,$outdated,$veryokay,$okay,$to_update);
+	if ($type eq 'dev') {
+	    $vers_mod=$module_dev_version_hash{$module};
+	    $vers_dist=$dist_dev_version_hash{$dist};
+	    ($missing,$outdated,$veryokay,$okay,$to_update)=
+		(\@dev_missing,\@dev_outdated,\@dev_veryokay,\@dev_okay,
+		 \@dev_to_update);
+	} elsif ($type eq 'stable') {
+	    $vers_mod=$module_stable_version_hash{$module};
+	    $vers_dist=$dist_stable_version_hash{$dist};
+	    ($missing,$outdated,$veryokay,$okay,$to_update)=
+		(\@stable_missing,\@stable_outdated,\@stable_veryokay,
+		 \@stable_okay,\@stable_to_update);
+	}
+	($vok,$vstr) = have_vers($module,$vers_mod);
+	# print "fsflag: $fsflag, vok: $vok, vstr: $vstr, fs: $fs\n";
+	if ($fsflag and !$vok and $vstr=~/not found/) {
+	    push(@$missing,'MISSING  '.$dist.' (want distribution '.
+		 $module.' version '. $vers_dist.') ?'."\n");
+	    push(@$to_update,$dist);
+	    # The question mark indicates there was a pattern match in the
+	    # big_module_string which would be unexpected.
+	    # There is no usual reason to tell the normal LON-CAPA user about this
+	    # question mark.  This is just source code magic.
+	} elsif (!$fsflag and !$vok and $vstr=~/not found/) {
+	    push(@$missing,'MISSING  '.$dist.' (want distribution '.
+		 $module.' version '.$vers_dist.')'."\n");
+	    push(@$to_update,$dist);
+	} elsif ($fsflag and !$vok and $vstr!~/not found/) {
+	    push(@$outdated,'OUTDATED '.$dist.' wanted module: v'.
+		 $vers_mod.'; '.$vstr.' (VERSION_FROM is '.
+		 $fs.') want dist '.$module.' version '.$vers_dist.'.'. "\n");
+	    push(@$to_update,$dist);
+	} elsif ($fsflag) {
+	    $vstr=~/found v(.*)/;
+	    my $vc=$1;
+	    if ($vc eq $vers_mod) {
+		push(@$veryokay,'VERYOKAY '.$dist.' wanted: v'.
+		     $vers_mod.'; '.$vstr.' (VERSION_FROM is '.$fs.
+		     ') want dist '.$module.' version '.$vers_dist."\n");
+	    } else {
+		push(@$okay,'OKAY     '.$dist.' wanted: v'.
+		     $vers_mod.'; '.$vstr.' (VERSION_FROM is '.$fs.').'."\n");
+	    }
+	}
+    }
+}
 
 print("\n".'SYNOPSIS'."\n");
 
 # ========================================================== The stable report.
 print('**** STABLE REPORT (what a production server should worry about)'."\n");
-if (@stable_missing) {
+if (@stable_missing)
+  {
     print('There are '.scalar(@stable_missing).' CPAN distributions missing '.
 	  'from this LON-CAPA system.'."\n");
-}
-else {
+  }
+else
+  {
     print('All perl modules needed by LON-CAPA appear to be present.'."\n");
-}
-if (@stable_outdated) {
+  }
+if (@stable_outdated)
+  {
     print(scalar(@stable_outdated).' CPAN distributions are out-dated '.
 	  'on this LON-CAPA system.'."\n");
-}
-if (@stable_veryokay) {
+  }
+if (@stable_veryokay)
+  {
     print(scalar(@stable_veryokay).' CPAN distributions are an exact match '.
 	  '(based on version number).'."\n");
 #    print @stable_veryokay;
-}
-if (@stable_okay) {
+  }
+if (@stable_okay)
+  {
     print(scalar(@stable_okay).' CPAN dists have a version number '.
 	  'higher than expected'.
 	  ' (probably okay).'. "\n");
-}
+  }
 print("\n");
 
 # ===================================================== The development report.
 print('**** DEVELOPMENT REPORT (do not worry about this unless you are a'.
       ' coder)'."\n");
-if (@dev_missing) {
+if (@dev_missing)
+  {
     print('There are '.scalar(@dev_missing).' CPAN distributions missing '.
 	  'from this LON-CAPA system.'."\n");
-}
-else {
+  }
+else
+  {
     print('All perl modules needed by LON-CAPA appear to be present.'."\n");
-}
-if (@dev_outdated) {
+  }
+if (@dev_outdated)
+  {
     print(scalar(@dev_outdated).' CPAN distributions are out-dated '.
 	  'on this LON-CAPA system.'."\n");
-}
-if (@dev_veryokay) {
+  }
+if (@dev_veryokay)
+  {
     print(scalar(@dev_veryokay).' CPAN distributions are an exact match '.
 	  '(based on version number).'."\n");
 #    print @dev_veryokay;
-}
-if (@dev_okay) {
+  }
+if (@dev_okay)
+  {
     print(scalar(@stable_okay).' CPAN dists have a version number '.
 	  'higher than expected'.
 	  ' (probably okay).'. "\n");
-}
+  }
 
-if ($mode eq 'synopsis') {
+my $detailstream;
+if ($mode eq 'synopsis')
+  {
     print("\n".'**** NOTE ****'."\n".
 	  'After everything completes, please view the CPAN_STATUS_REPORT'.
 	  ' file for more '."\n".'information on resolving your perl modules.'.
@@ -487,49 +461,83 @@ if ($mode eq 'synopsis') {
 
     print('* HIT RETURN WHEN READY TO CONTINUE *'."\n");
     my $returnkey=<>;
-}
-else {
-    print("\n".'DETAILED STATUS REPORT'."\n"); # Header of status report.
-
-    # Print advisory notices.
-    print("\n".'(Consult loncapa/doc/otherfiles/perl_modules.txt for '.
-	  'information on'."\n".
-	  ' manual build instructions.)'."\n");
-    print("\n".'(**** IMPORTANT NOTICE **** HTML-Parser needs to be patched '.
-	  "\n".' as described in loncapa/doc/otherfiles/perl_modules.txt)'.
-	  "\n");
-
-    print("\n".'For manual installation of CPAN distributions, visit'."\n".
-	  'http://search.cpan.org/dist/DistName'."\n".
-	  'where DistName is something like "HTML-Parser" or "libwww-perl".'.
-	  "\n");
+    open(OUT,'>CPAN_STATUS_REPORT');
+    $detailstream=\*OUT;
+  }
+else
+  {
+    $detailstream=\*STDOUT;
+  }
+print($detailstream 
+      "\n".'DETAILED STATUS REPORT'."\n"); # Header of status report.
 
-    print("\n".'For automatic installation of CPAN distributions, visit'."\n".
-	  'http://install.lon-capa.org/resources/cpanauto/DistName.bin'."\n".
-	  'where DistName.bin is something like "HTML-Parser.bin" or '.
-	  '"libwww-perl.bin".'."\n");
-
-    # Print detailed report of stable.
-    print("\n".'STABLE (DETAILED REPORT)'."\n");
-    print @stable_missing;
-    print @stable_outdated;
-    print @stable_veryokay;
-    print @stable_okay;
-    print("\n".'DEVELOPMENT (DETAILED REPORT)'."\n");
-    print @dev_missing;
-    print @dev_outdated;
-    print @dev_veryokay;
-    print @dev_okay;
-}
+# Print advisory notices.
+print($detailstream
+      "\n".'(Consult loncapa/doc/otherfiles/perl_modules.txt for '.
+      'information on'."\n".
+      ' manual build instructions.)'."\n");
+print($detailstream
+      "\n".'(**** IMPORTANT NOTICE **** HTML-Parser needs to be patched '.
+      "\n".' as described in loncapa/doc/otherfiles/perl_modules.txt)'.
+      "\n");
+
+print($detailstream
+      "\n".'For manual installation of CPAN distributions, visit'."\n".
+      'http://search.cpan.org/dist/DistName'."\n".
+      'where DistName is something like "HTML-Parser" or "libwww-perl".'.
+      "\n");
+
+print($detailstream
+      "\n".'For automatic installation of CPAN distributions, visit'."\n".
+      'http://install.lon-capa.org/resources/cpanauto/DistName.bin'."\n".
+      'where DistName.bin is something like "HTML-Parser.bin" or '.
+      '"libwww-perl.bin".'."\n");
+
+# Print detailed report of stable.
+print($detailstream
+      "\n".'STABLE (DETAILED REPORT)'."\n");
+print $detailstream @stable_missing;
+print $detailstream @stable_outdated;
+print $detailstream @stable_veryokay;
+print $detailstream @stable_okay;
+print($detailstream "\n".'DEVELOPMENT (DETAILED REPORT)'."\n");
+print $detailstream @dev_missing;
+print $detailstream @dev_outdated;
+print $detailstream @dev_veryokay;
+print $detailstream @dev_okay;
 
-if ($mode eq "html") {
+if ($mode eq "html")
+  {
     print(<
 
 
 END
-}
+  }
 
+if ($mode =~ /^update(dev|stable)$/) {
+    use CPAN;
+    my $type=$1;
+    print $detailstream 'Attempting to do a '.$type.' update'."\n";
+    my $to_update;
+    if ($type eq 'dev') {
+	$to_update=\@dev_to_update;
+    } elsif ($type eq 'stable') {
+	$to_update=\@stable_to_update;
+    }
+    foreach my $dist (@$to_update) {
+	my $module=$dist_module_hash{$dist};
+	my ($vers_mod,$vers_dist);
+	if ($type eq 'dev') {
+	    $vers_mod=$module_dev_version_hash{$module};
+	    $vers_dist=$dist_dev_version_hash{$dist};
+	} elsif ($type eq 'stable') {
+	    $vers_mod=$module_stable_version_hash{$module};
+	    $vers_dist=$dist_stable_version_hash{$dist};
+	}
+	install($module);
+    }
+}
 # ================================================================ Subroutines.
 # Note that "vers_cmp" and "have_vers" are adapted from a bugzilla version 2.16
 # "checksetup.pl" script.