File:  [LON-CAPA] / loncom / build / system_dependencies / perltest.pl
Revision 1.12: download - view: text, annotated - select for diffs
Fri Aug 22 20:48:38 2003 UTC (20 years, 9 months ago) by albertel
Branches: MAIN
CVS tags: version_2_9_X, version_2_9_99_0, version_2_9_1, version_2_9_0, version_2_8_X, version_2_8_99_1, version_2_8_99_0, version_2_8_2, version_2_8_1, version_2_8_0, version_2_7_X, version_2_7_99_1, version_2_7_99_0, version_2_7_1, version_2_7_0, version_2_6_X, version_2_6_99_1, version_2_6_99_0, version_2_6_3, version_2_6_2, version_2_6_1, version_2_6_0, version_2_5_X, version_2_5_99_1, version_2_5_99_0, version_2_5_2, version_2_5_1, version_2_5_0, version_2_4_X, version_2_4_99_0, version_2_4_2, version_2_4_1, version_2_4_0, version_2_3_X, version_2_3_99_0, version_2_3_2, version_2_3_1, version_2_3_0, version_2_2_X, version_2_2_99_1, version_2_2_99_0, version_2_2_2, version_2_2_1, version_2_2_0, version_2_1_X, version_2_1_99_3, version_2_1_99_2, version_2_1_99_1, version_2_1_99_0, version_2_1_3, version_2_1_2, version_2_1_1, version_2_1_0, version_2_12_X, version_2_11_X, version_2_11_4_uiuc, version_2_11_4_msu, version_2_11_4, version_2_11_3_uiuc, version_2_11_3_msu, version_2_11_3, version_2_11_2_uiuc, version_2_11_2_msu, version_2_11_2_educog, version_2_11_2, version_2_11_1, version_2_11_0_RC3, version_2_11_0_RC2, version_2_11_0_RC1, version_2_11_0, version_2_10_X, version_2_10_1, version_2_10_0_RC2, version_2_10_0_RC1, version_2_10_0, version_2_0_X, version_2_0_99_1, version_2_0_2, version_2_0_1, version_2_0_0, version_1_99_3, version_1_99_2, version_1_99_1_tmcc, version_1_99_1, version_1_99_0_tmcc, version_1_99_0, version_1_3_X, version_1_3_3, version_1_3_2, version_1_3_1, version_1_3_0, version_1_2_X, version_1_2_99_1, version_1_2_99_0, version_1_2_1, version_1_2_0, version_1_1_X, version_1_1_99_5, version_1_1_99_4, version_1_1_99_3, version_1_1_99_2, version_1_1_99_1, version_1_1_99_0, version_1_1_3, version_1_1_2, version_1_1_1, version_1_1_0, version_1_0_99_3, version_1_0_99_2, version_1_0_99_1, version_1_0_99, loncapaMITrelate_1, language_hyphenation_merge, language_hyphenation, bz6209-base, bz6209, bz5969, bz5610, bz2851, PRINT_INCOMPLETE_base, PRINT_INCOMPLETE, HEAD, GCI_3, GCI_2, GCI_1, BZ5971-printing-apage, BZ5434-fox, BZ4492-merge, BZ4492-feature_horizontal_radioresponse, BZ4492-feature_Support_horizontal_radioresponse, BZ4492-Support_horizontal_radioresponse
- now you can send it the command 'updatedev' or 'updatestable' which will attempt to do CPAN updates on modules that are either outdated or missing, Which works alot of the time
- remove the _ref from some vars

    1: #!/usr/bin/perl
    2: 
    3: # perltest.pl - script to test the status of perl modules on a LON-CAPA system
    4: #
    5: # $Id: perltest.pl,v 1.12 2003/08/22 20:48:38 albertel Exp $
    6: #
    7: ###
    8: 
    9: =pod
   10: 
   11: =head1 NAME
   12: 
   13: B<perltest.pl> - Test status of perl modules installed on a LON-CAPA system.
   14: 
   15: =cut
   16: 
   17: # Written to help LON-CAPA (The LearningOnline Network with CAPA)
   18: #
   19: 
   20: =pod
   21: 
   22: =head1 SYNOPSIS
   23: 
   24: perl perltest.pl [MODE]
   25: 
   26: This script is located inside the LON-CAPA source code tree.
   27: This script is invoked by test-related targets inside
   28: F<loncapa/loncom/build/Makefile>.
   29: 
   30: This script is also used as a CGI script and is installed
   31: at the file location of F</home/httpd/cgi-bin/perltest.pl>.
   32: 
   33: MODE, when left blank, the output defaults to 'statusreport' mode.
   34: Except however, if $ENV{'QUERY_STRING'} exists, in which case
   35: 'html' mode is safely assumed.
   36: 
   37: Here is a complete list of MODEs.
   38: 
   39: =over 4
   40: 
   41: =item html
   42: 
   43: A web page detailing the status of CPAN distributions on a LON-CAPA server
   44: (as well as methods for resolution).
   45: 
   46: =item synopsis
   47: 
   48: Plain-text output which just summarizes the status of
   49: expected CPAN distributions on a system.  (This is what a
   50: user sees when running the ./TEST command.)
   51: 
   52: =item statusreport
   53: 
   54: Plain-text output which provides a detailed status report of
   55: CPAN distributions on a LON-CAPA server (as well as methods
   56: for resolution).
   57: 
   58: =back
   59: 
   60: =head1 DESCRIPTION
   61: 
   62: This program tests the status of perl modules installed on a LON-CAPA system.
   63: As with the other LON-CAPA test scripts, when reasonable, I try
   64: to avoid importing functionality from other LON-CAPA modules so as to
   65: avoid indirectly testing software dependencies.
   66: 
   67: =head2 ORGANIZATION OF THIS PERL SCRIPT
   68: 
   69: The script is organized into the following sections.
   70: 
   71: =over 4
   72: 
   73: =item 1.
   74: 
   75: Process version information of this file.
   76: 
   77: =item 2.
   78: 
   79: Determine output mode for the script.
   80: 
   81: =item 3.
   82: 
   83: Output header information.
   84: 
   85: =item 4.
   86: 
   87: Make sure the perl version is suitably high.
   88: 
   89: =item 5.
   90: 
   91: Make sure we have the find command.
   92: 
   93: =item 6.
   94: 
   95: Scan for all the perl modules present on the filesystem.
   96: 
   97: =item 7.
   98: 
   99: Read in cpan_distributions.txt.
  100: 
  101: =item 8.
  102: 
  103: Loop through all of the needed CPAN distributions and probe the system.
  104: 
  105: =item 9
  106: 
  107: Output a report (dependent on output mode).
  108: 
  109: =item 10
  110: 
  111: Subroutines.
  112: 
  113: B<vers_cmp> - compare two version numbers and see which is greater.
  114: 
  115: B<have_vers> - syntax check the version number and call B<vers_cmp>.
  116: 
  117: =back
  118: 
  119: =head1 STATUS
  120: 
  121: Ratings: 1=horrible 2=poor 3=fair 4=good 5=excellent
  122: 
  123: =over 4
  124: 
  125: =item Organization
  126: 
  127: 5
  128: 
  129: =item Functionality
  130: 
  131: 5
  132: 
  133: =item Has it been tested?
  134: 
  135: 4
  136: 
  137: =back
  138: 
  139: =head1 AUTHOR
  140: 
  141: This software is distributed under the General Public License,
  142: version 2, June 1991 (which is the same terms as LON-CAPA).
  143: 
  144: This is free software; you can redistribute it and/or modify
  145: it under the terms of the GNU General Public License as published by
  146: the Free Software Foundation; either version 2 of the License, or
  147: (at your option) any later version.
  148: 
  149: This software is distributed in the hope that it will be useful,
  150: but WITHOUT ANY WARRANTY; without even the implied warranty of
  151: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  152: GNU General Public License for more details.
  153: 
  154: You should have received a copy of the GNU General Public License
  155: along with this software; if not, write to the Free Software
  156: Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  157: 
  158: =cut
  159: 
  160: # =================================== Process version information of this file.
  161: my $VERSION = sprintf("%d.%02d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/);
  162: 
  163: # ========================== Determine the mode that this script should run in.
  164: my $mode;
  165: $mode=shift(@ARGV) if @ARGV;
  166: unless ( $mode )
  167:   {
  168:     $mode = 'statusreport';
  169:   }
  170: if ( defined($ENV{'QUERY_STRING'}) )
  171:   {
  172:     $mode = 'html';
  173:   }
  174: 
  175: # ================================================== Output header information.
  176: my $hostname = `hostname`; chomp($hostname);
  177: my $date = `date`; chomp($date);
  178: 
  179: # --- html mode blurb
  180: if ($mode eq "html") {
  181:     print(<<END);
  182: Content-type: text/html
  183: 
  184: <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
  185:  "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
  186: <html>
  187: <head>
  188: <meta http-equiv="Content-Type" content="text/html; charset=utf-8"></meta>
  189: <title>CPAN perl status report; $hostname; $date</title>
  190: </head>
  191: <body bgcolor="white">
  192: <h1>CPAN perl status report</h1>
  193: <pre>
  194: END
  195: }
  196: 
  197: print('Running perltest.pl, version '.$VERSION.'.'."\n");
  198: print('(Test status of perl modules installed on a LON-CAPA system).'."\n");
  199: 
  200: # This program is only a "modest" effort to LOOK and see whether
  201: # necessary perl system dependencies are present.  I do not yet
  202: # try to actually run tests against each needed perl module.
  203: # Eventually, all modules will be version-checked, and reasonable
  204: # testing implemented.
  205: 
  206: # ================================ Make sure the perl version is suitably high.
  207: print('Checking version of perl'."\n");
  208: print(`perl --version`);
  209: unless (eval("require 5.005"))
  210:   {
  211:     die('**** ERROR **** DEPENDENCY FAILURE: require perl version >= 5.005.'.
  212: 	"\n".'Do you even have perl installed on your system?'."\n");
  213:   }
  214: else
  215:   {
  216:     print('Perl >= 5.005...okay'."\n");
  217:   }
  218: 
  219: # ========================================= Make sure we have the find command.
  220: my $ret = system("find --version 1>/dev/null");
  221: if ($ret)
  222:   {
  223:     die('**** ERROR **** DEPENDENCY FAILURE: perltest.pl requires the GNU '.
  224: 	"'find'".' utility.'."\n");
  225:   }
  226: else
  227:   {
  228:     print('find command exists...okay'."\n");
  229:   }
  230: 
  231: # ==================== Scan for all the perl modules present on the filesystem.
  232: print('Scanning for perl modules...'."\n");
  233: my $big_module_string; # All the modules glued together in a string.
  234: my $number_of_modules = 0; # The total number of modules available in system.
  235: # --- Build a pattern matching string.
  236: foreach my $inc (@INC)
  237:   {
  238:     my @m = `find $inc -maxdepth 2000 -type f -name '*.pm'`;
  239:     foreach my $module (@m)
  240:       {
  241: 	$big_module_string .= $module;
  242: 	$number_of_modules++;
  243:       }
  244:   }
  245: # --- Notify user of the number of modules.
  246: print('There are '.$number_of_modules.
  247:       ' perl modules present on your filesystem.'."\n");
  248: 
  249: my %dist_module_hash; # Relate the distributions to their VersionFrom modules.
  250: my %module_name_on_filesystem; # Relate module name to filesystem syntax.
  251: my %dist_dev_version_hash; # Expected development version of CPAN distribution.
  252: my %dist_stable_version_hash; # Expected stable version of CPAN distribution.
  253: my %module_dev_version_hash; # development version of versionfrom_module.
  254: my %module_stable_version_hash; # stable version of versionfrom_module.
  255: 
  256: # ============================================= Read in cpan_distributions.txt.
  257: 
  258: # A brief description of CPAN (Comprehensive Perl Archive Network):
  259: # CPAN software is not released as separate perl modules.
  260: # CPAN software is released as "distributions" (also called "dists").
  261: # Each distribution consists of multiple perl modules.
  262: # For instance, the dist HTML-Tree (http://search.cpan.org/dist/HTML-Tree/)
  263: # consists of the modules HTML::AsSubs, HTML::Element, HTML::Element::traverse,
  264: # HTML::Parse, HTML::TreeBuilder, and HTML::Tree.
  265: # Most (but not all) distributions have versions which are defined
  266: # by one of their modules.  For the syntax of cpan_distributions.txt,
  267: # please read the comments inside cpan_distributions.txt.
  268: 
  269: # Open cpan_distributions.txt.
  270: open(IN,'<cpan_distributions.txt') or
  271:     die('**** ERROR **** Cannot find cpan_distributions.txt'."\n");
  272: 
  273: while(<IN>) # Loop through the lines.
  274:   {
  275:     next if /^\#/; # Ignore commented lines.
  276:     next unless /\S/; # Ignore blank lines.
  277: 
  278:     chomp; # Get rid of the newline at the end of the line.
  279: 
  280:     # Parse the line.
  281:     my ($dist_name,$dist_dev_version,$dist_stable_version,$versionfrom_info) =
  282: 	split(/\s+/); # Parse apart the line fields.
  283:     $versionfrom_info =~ /^(.*)\((.*)\)$/; # Parse apart the versionfrom info.
  284:     my ($version_module,$version_match) = ($1,$2); # Parse vals into variables.
  285: 
  286:     # Calculate DevVersion and StableVersion for the VersionFrom module.
  287:     my $module_dev_version;
  288:     my $module_stable_version;
  289:     if ($version_match eq "*") # There is a dist=module version relationship.
  290:       {
  291: 	$module_dev_version = $dist_dev_version; # module=dist.
  292: 	$module_stable_version = $dist_stable_version; # module=dist.
  293:       }
  294:     else # There is not a dist=module version relationship.
  295:       {
  296: 	($module_dev_version,$module_stable_version) = 
  297: 	    split(/\,/,$version_match); # module set to customized settings.
  298:       }
  299: 
  300:     $dist_module_hash{$dist_name} = $version_module; # The big dist index.
  301: 
  302:     # What the module "looks like" on the filesystem.
  303:     my $version_modulefs = $version_module;
  304:     $version_modulefs =~ s!::!/!g; $version_modulefs.='.pm';
  305:     $modulefs_hash{$version_module} = $version_modulefs;
  306: 
  307:     # Indexing the expected versions.
  308:     $module_dev_version_hash{$version_module} = $module_dev_version;
  309:     $module_stable_version_hash{$version_module} = $module_stable_version;
  310:     $dist_dev_version_hash{$dist_name} = $dist_dev_version;
  311:     $dist_stable_version_hash{$dist_name} = $dist_stable_version;
  312:   }
  313: close(IN);
  314: 
  315: # "MISSING"  means that no module is present inside the include path.
  316: # "OUTDATED" means that a module is present inside the include path but is
  317: #            an earlier version than expected.
  318: # "VERYOKAY" means that the module version is an exact match for the expected
  319: #            version.
  320: # "OKAY"     means that the module version is more recent than the expected
  321: #            version, so things are "probably" okay....  It is still possible
  322: #            that LON-CAPA is incompatible with the newer distribution version
  323: #            (corresponding to the module version).
  324: my @dev_missing;
  325: my @dev_outdated;
  326: my @dev_okay;
  327: my @dev_veryokay;
  328: my @dev_to_update;
  329: my @stable_missing;
  330: my @stable_outdated;
  331: my @stable_okay;
  332: my @stable_veryokay;
  333: my @stable_to_update;
  334: 
  335: # ===== Loop through all of the needed CPAN distributions and probe the system.
  336: foreach my $dist (keys %dist_module_hash) {
  337:     my $module = $dist_module_hash{$dist};
  338:     my $fs = $modulefs_hash{$module};
  339:     my $fsflag = 0;
  340:     if ($big_module_string =~ /$fs/) { $fsflag = 1; }
  341:     my ($vok,$vstr);
  342:     foreach my $type ('dev','stable') {
  343: 	my ($vers_mod,$vers_dist);
  344: 	my ($missing,$outdated,$veryokay,$okay,$to_update);
  345: 	if ($type eq 'dev') {
  346: 	    $vers_mod=$module_dev_version_hash{$module};
  347: 	    $vers_dist=$dist_dev_version_hash{$dist};
  348: 	    ($missing,$outdated,$veryokay,$okay,$to_update)=
  349: 		(\@dev_missing,\@dev_outdated,\@dev_veryokay,\@dev_okay,
  350: 		 \@dev_to_update);
  351: 	} elsif ($type eq 'stable') {
  352: 	    $vers_mod=$module_stable_version_hash{$module};
  353: 	    $vers_dist=$dist_stable_version_hash{$dist};
  354: 	    ($missing,$outdated,$veryokay,$okay,$to_update)=
  355: 		(\@stable_missing,\@stable_outdated,\@stable_veryokay,
  356: 		 \@stable_okay,\@stable_to_update);
  357: 	}
  358: 	($vok,$vstr) = have_vers($module,$vers_mod);
  359: 	# print "fsflag: $fsflag, vok: $vok, vstr: $vstr, fs: $fs\n";
  360: 	if ($fsflag and !$vok and $vstr=~/not found/) {
  361: 	    push(@$missing,'MISSING  '.$dist.' (want distribution '.
  362: 		 $module.' version '. $vers_dist.') ?'."\n");
  363: 	    push(@$to_update,$dist);
  364: 	    # The question mark indicates there was a pattern match in the
  365: 	    # big_module_string which would be unexpected.
  366: 	    # There is no usual reason to tell the normal LON-CAPA user about this
  367: 	    # question mark.  This is just source code magic.
  368: 	} elsif (!$fsflag and !$vok and $vstr=~/not found/) {
  369: 	    push(@$missing,'MISSING  '.$dist.' (want distribution '.
  370: 		 $module.' version '.$vers_dist.')'."\n");
  371: 	    push(@$to_update,$dist);
  372: 	} elsif ($fsflag and !$vok and $vstr!~/not found/) {
  373: 	    push(@$outdated,'OUTDATED '.$dist.' wanted module: v'.
  374: 		 $vers_mod.'; '.$vstr.' (VERSION_FROM is '.
  375: 		 $fs.') want dist '.$module.' version '.$vers_dist.'.'. "\n");
  376: 	    push(@$to_update,$dist);
  377: 	} elsif ($fsflag) {
  378: 	    $vstr=~/found v(.*)/;
  379: 	    my $vc=$1;
  380: 	    if ($vc eq $vers_mod) {
  381: 		push(@$veryokay,'VERYOKAY '.$dist.' wanted: v'.
  382: 		     $vers_mod.'; '.$vstr.' (VERSION_FROM is '.$fs.
  383: 		     ') want dist '.$module.' version '.$vers_dist."\n");
  384: 	    } else {
  385: 		push(@$okay,'OKAY     '.$dist.' wanted: v'.
  386: 		     $vers_mod.'; '.$vstr.' (VERSION_FROM is '.$fs.').'."\n");
  387: 	    }
  388: 	}
  389:     }
  390: }
  391: 
  392: print("\n".'SYNOPSIS'."\n");
  393: 
  394: # ========================================================== The stable report.
  395: print('**** STABLE REPORT (what a production server should worry about)'."\n");
  396: if (@stable_missing)
  397:   {
  398:     print('There are '.scalar(@stable_missing).' CPAN distributions missing '.
  399: 	  'from this LON-CAPA system.'."\n");
  400:   }
  401: else
  402:   {
  403:     print('All perl modules needed by LON-CAPA appear to be present.'."\n");
  404:   }
  405: if (@stable_outdated)
  406:   {
  407:     print(scalar(@stable_outdated).' CPAN distributions are out-dated '.
  408: 	  'on this LON-CAPA system.'."\n");
  409:   }
  410: if (@stable_veryokay)
  411:   {
  412:     print(scalar(@stable_veryokay).' CPAN distributions are an exact match '.
  413: 	  '(based on version number).'."\n");
  414: #    print @stable_veryokay;
  415:   }
  416: if (@stable_okay)
  417:   {
  418:     print(scalar(@stable_okay).' CPAN dists have a version number '.
  419: 	  'higher than expected'.
  420: 	  ' (probably okay).'. "\n");
  421:   }
  422: print("\n");
  423: 
  424: # ===================================================== The development report.
  425: print('**** DEVELOPMENT REPORT (do not worry about this unless you are a'.
  426:       ' coder)'."\n");
  427: if (@dev_missing)
  428:   {
  429:     print('There are '.scalar(@dev_missing).' CPAN distributions missing '.
  430: 	  'from this LON-CAPA system.'."\n");
  431:   }
  432: else
  433:   {
  434:     print('All perl modules needed by LON-CAPA appear to be present.'."\n");
  435:   }
  436: if (@dev_outdated)
  437:   {
  438:     print(scalar(@dev_outdated).' CPAN distributions are out-dated '.
  439: 	  'on this LON-CAPA system.'."\n");
  440:   }
  441: if (@dev_veryokay)
  442:   {
  443:     print(scalar(@dev_veryokay).' CPAN distributions are an exact match '.
  444: 	  '(based on version number).'."\n");
  445: #    print @dev_veryokay;
  446:   }
  447: if (@dev_okay)
  448:   {
  449:     print(scalar(@stable_okay).' CPAN dists have a version number '.
  450: 	  'higher than expected'.
  451: 	  ' (probably okay).'. "\n");
  452:   }
  453: 
  454: my $detailstream;
  455: if ($mode eq 'synopsis')
  456:   {
  457:     print("\n".'**** NOTE ****'."\n".
  458: 	  'After everything completes, please view the CPAN_STATUS_REPORT'.
  459: 	  ' file for more '."\n".'information on resolving your perl modules.'.
  460: 	  "\n");
  461: 
  462:     print('* HIT RETURN WHEN READY TO CONTINUE *'."\n");
  463:     my $returnkey=<>;
  464:     open(OUT,'>CPAN_STATUS_REPORT');
  465:     $detailstream=\*OUT;
  466:   }
  467: else
  468:   {
  469:     $detailstream=\*STDOUT;
  470:   }
  471: print($detailstream 
  472:       "\n".'DETAILED STATUS REPORT'."\n"); # Header of status report.
  473: 
  474: # Print advisory notices.
  475: print($detailstream
  476:       "\n".'(Consult loncapa/doc/otherfiles/perl_modules.txt for '.
  477:       'information on'."\n".
  478:       ' manual build instructions.)'."\n");
  479: print($detailstream
  480:       "\n".'(**** IMPORTANT NOTICE **** HTML-Parser needs to be patched '.
  481:       "\n".' as described in loncapa/doc/otherfiles/perl_modules.txt)'.
  482:       "\n");
  483: 
  484: print($detailstream
  485:       "\n".'For manual installation of CPAN distributions, visit'."\n".
  486:       'http://search.cpan.org/dist/DistName'."\n".
  487:       'where DistName is something like "HTML-Parser" or "libwww-perl".'.
  488:       "\n");
  489: 
  490: print($detailstream
  491:       "\n".'For automatic installation of CPAN distributions, visit'."\n".
  492:       'http://install.lon-capa.org/resources/cpanauto/DistName.bin'."\n".
  493:       'where DistName.bin is something like "HTML-Parser.bin" or '.
  494:       '"libwww-perl.bin".'."\n");
  495: 
  496: # Print detailed report of stable.
  497: print($detailstream
  498:       "\n".'STABLE (DETAILED REPORT)'."\n");
  499: print $detailstream @stable_missing;
  500: print $detailstream @stable_outdated;
  501: print $detailstream @stable_veryokay;
  502: print $detailstream @stable_okay;
  503: print($detailstream "\n".'DEVELOPMENT (DETAILED REPORT)'."\n");
  504: print $detailstream @dev_missing;
  505: print $detailstream @dev_outdated;
  506: print $detailstream @dev_veryokay;
  507: print $detailstream @dev_okay;
  508: 
  509: if ($mode eq "html")
  510:   {
  511:     print(<<END);
  512: </pre>
  513: </body>
  514: </html>
  515: END
  516:   }
  517: 
  518: if ($mode =~ /^update(dev|stable)$/) {
  519:     use CPAN;
  520:     my $type=$1;
  521:     print $detailstream 'Attempting to do a '.$type.' update'."\n";
  522:     my $to_update;
  523:     if ($type eq 'dev') {
  524: 	$to_update=\@dev_to_update;
  525:     } elsif ($type eq 'stable') {
  526: 	$to_update=\@stable_to_update;
  527:     }
  528:     foreach my $dist (@$to_update) {
  529: 	my $module=$dist_module_hash{$dist};
  530: 	my ($vers_mod,$vers_dist);
  531: 	if ($type eq 'dev') {
  532: 	    $vers_mod=$module_dev_version_hash{$module};
  533: 	    $vers_dist=$dist_dev_version_hash{$dist};
  534: 	} elsif ($type eq 'stable') {
  535: 	    $vers_mod=$module_stable_version_hash{$module};
  536: 	    $vers_dist=$dist_stable_version_hash{$dist};
  537: 	}
  538: 	install($module);
  539:     }
  540: }
  541: # ================================================================ Subroutines.
  542: # Note that "vers_cmp" and "have_vers" are adapted from a bugzilla version 2.16
  543: # "checksetup.pl" script.
  544: 
  545: # ------------ vers_cmp : compare two version numbers and see which is greater.
  546: # vers_cmp is adapted from Sort::Versions 1.3 1996/07/11 13:37:00 kjahds,
  547: # which is not included with Perl by default, hence the need to copy it here.
  548: # Seems silly to require it when this is the only place we need it...
  549: sub vers_cmp
  550:   {
  551:     if (@_ < 2) { die "not enough parameters for vers_cmp" }
  552:     if (@_ > 2) { die "too many parameters for vers_cmp" }
  553:     my ($a, $b) = @_;
  554:     my (@A) = ($a =~ /(\.|\d+|[^\.\d]+)/g);
  555:     my (@B) = ($b =~ /(\.|\d+|[^\.\d]+)/g);
  556:     my ($A,$B);
  557:     while (@A and @B)
  558:       {
  559:         $A = shift @A;
  560:         $B = shift @B;
  561:         if ($A eq "." and $B eq ".")
  562:           {
  563:             next;
  564:           }
  565:         elsif ( $A eq "." )
  566:           {
  567:             return -1;
  568:           }
  569:         elsif ( $B eq "." )
  570:           {
  571:             return 1;
  572:           }
  573:         elsif ($A =~ /^\d+$/ and $B =~ /^\d+$/)
  574:           {
  575:             return $A <=> $B if $A <=> $B;
  576:           }
  577:         else
  578:           {
  579:             $A = uc $A;
  580:             $B = uc $B;
  581:             return $A cmp $B if $A cmp $B;
  582:           }
  583:       }
  584:     @A <=> @B;
  585:   }
  586: 
  587: # --------------- have_vers: syntax check the version number and call vers_cmp.
  588: # This was originally clipped from the libnet Makefile.PL, adapted here to
  589: # use the above vers_cmp routine for accurate version checking.
  590: sub have_vers
  591:   {
  592:     my ($pkg, $wanted) = @_;
  593:     my ($msg, $vnum, $vstr);
  594:     no strict 'refs';
  595:     # printf("Checking for %15s %-9s ", $pkg, !$wanted?'(any)':"(v$wanted)");
  596: 
  597:     eval { my $p; ($p = $pkg . ".pm") =~ s!::!/!g; require $p; };
  598: 
  599:     $vnum = ${"${pkg}::VERSION"} || ${"${pkg}::Version"} || 0;
  600:     $vnum = -1 if $@;
  601: 
  602:     if ($vnum eq "-1") # string compare just in case it's non-numeric
  603:       {
  604:         $vstr = "not found";
  605:       }
  606:     elsif (vers_cmp($vnum,"0") > -1)
  607:       {
  608:         $vstr = "found v$vnum";
  609:       }
  610:     else
  611:       {
  612:         $vstr = "found unknown version";
  613:       }
  614: 
  615:     my $vok = (vers_cmp($vnum,$wanted) > -1);
  616:     # print ((($vok) ? "ok: " : " "), "$vstr\n");
  617:     return ($vok,$vstr);
  618:   }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>