Annotation of loncom/build/system_dependencies/perltest.pl, revision 1.10

1.1       harris41    1: #!/usr/bin/perl
                      2: 
1.6       harris41    3: # perltest.pl - script to test the status of perl modules on a LON-CAPA system
1.1       harris41    4: #
1.10    ! harris41    5: # $Id: perltest.pl,v 1.9 2002/11/04 01:57:53 harris41 Exp $
1.6       harris41    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)
1.1       harris41   18: #
1.6       harris41   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
1.7       harris41   31: at the file location of F</home/httpd/cgi-bin/perltest.pl>.
1.6       harris41   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.
1.10    ! harris41  161: my $VERSION = sprintf("%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/);
1.6       harris41  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: 
1.8       harris41  184: <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
                    185:  "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1.6       harris41  186: <html>
                    187: <head>
1.8       harris41  188: <meta http-equiv="Content-Type" content="text/html; charset=utf-8"></meta>
1.6       harris41  189: <title>CPAN perl status report; $hostname; $date</title>
                    190: </head>
1.8       harris41  191: <body bgcolor="white">
1.6       harris41  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
1.1       harris41  201: # necessary perl system dependencies are present.  I do not yet
                    202: # try to actually run tests against each needed perl module.
1.6       harris41  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 @stable_missing;
                    329: my @stable_outdated;
                    330: my @stable_okay;
                    331: my @stable_veryokay;
                    332: 
                    333: # ===== Loop through all of the needed CPAN distributions and probe the system.
                    334: foreach my $dist (keys %dist_module_hash)
                    335:   {
                    336:     my $module = $dist_module_hash{$dist};
                    337:     my $fs = $modulefs_hash{$module};
                    338:     my $fsflag = 0;
                    339:     if ($big_module_string =~ /$fs/)
                    340:       {
                    341:         $fsflag = 1;
                    342:       }
                    343:     my ($vok,$vstr);
                    344:     ($vok,$vstr) = have_vers($module,$module_dev_version_hash{$module});
                    345:     # print "fsflag: $fsflag, vok: $vok, vstr: $vstr, fs: $fs\n";
                    346:     if ($fsflag and !$vok and $vstr=~/not found/)
                    347:       {
                    348: 	push(@dev_missing,'MISSING  '.$dist.' (want distribution version '.
                    349: 	     $dist_dev_version_hash{$dist}.') ?'."\n");
                    350: 	# The question mark indicates there was a pattern match in the
                    351: 	# big_module_string which would be unexpected.
                    352: 	# There is no usual reason to tell the normal LON-CAPA user about this
                    353: 	# question mark.  This is just source code magic.
                    354:       }
                    355:     elsif (!$fsflag and !$vok and $vstr=~/not found/)
                    356:       {
                    357: 	push(@dev_missing,'MISSING  '.$dist.' (want distribution version '.
                    358: 	     $dist_dev_version_hash{$dist}.')'."\n");
                    359:       }
                    360:     elsif ($fsflag and !$vok and $vstr!~/not found/)
                    361:       {
                    362: 	push(@dev_outdated,'OUTDATED '.$dist.' wanted module: v'.
                    363: 	     $module_dev_version_hash{$module}.'; '.$vstr.' (VERSION_FROM is '.
                    364: 	     $fs.') want dist version '.$dist_dev_version_hash{$dist}.'.'.
                    365: 	     "\n");
                    366:       }
                    367:     elsif ($fsflag)
                    368:       {
                    369: 	$vstr=~/found v(.*)/;
                    370: 	my $vc=$1;
                    371: 	if ($vc eq $module_dev_version_hash{$module})
                    372:           {
                    373: 	    push(@dev_veryokay,'VERYOKAY '.$dist.' wanted: v'.
                    374: 		 $module_dev_version_hash{$module}.'; '.$vstr.
                    375: 		 ' (VERSION_FROM is '.$fs.') want dist version '.
                    376: 		 $dist_dev_version_hash{$dist}."\n");
                    377: 	  }
                    378: 	else
                    379:           {
                    380: 	    push(@dev_okay,'OKAY     '.$dist.' wanted: v'.
                    381: 		  $module_dev_version_hash{$module}.'; '.$vstr.
                    382: 		  ' (VERSION_FROM is '.$fs.').'."\n");
                    383: 	  }
                    384:       }
                    385:     ($vok,$vstr) = have_vers($module,$module_stable_version_hash{$module});
                    386:     if ($fsflag and !$vok and $vstr=~/not found/)
                    387:       {
                    388: 	push(@stable_missing,'MISSING  '.$dist.' (want distribution version '.
                    389: 	     $dist_stable_version_hash{$dist}.') ?'."\n");
                    390: 	# The question mark indicates there was a pattern match in the
                    391: 	# big_module_string which would be unexpected.
                    392: 	# There is no usual reason to tell the normal LON-CAPA user about this
                    393: 	# question mark.  This is just source code magic.
                    394:       }
                    395:     elsif (!$fsflag and !$vok and $vstr=~/not found/)
                    396:       {
                    397: 	push(@stable_missing,'MISSING  '.$dist.' (want distribution version '.
                    398: 	     $dist_stable_version_hash{$dist}.')'."\n");
                    399:       }
                    400:     elsif ($fsflag and !$vok and $vstr!~/not found/)
                    401:       {
                    402: 	push(@stable_outdated,'OUTDATED '.$dist.' wanted module: v'.
                    403: 	     $module_stable_version_hash{$module}.'; '.$vstr.
                    404: 	     ' (VERSION_FROM is '.$fs.') want dist version '.
                    405: 	     $dist_stable_version_hash{$dist}.'.'."\n");
                    406:       }
                    407:     elsif ($fsflag)
                    408:       {
                    409: 	$vstr=~/found v(.*)/;
                    410: 	my $vc=$1;
                    411: 	if ($vc eq $module_stable_version_hash{$module})
                    412:           {
                    413: 	    push(@stable_veryokay,'VERYOKAY '.$dist.' wanted: v'.
                    414: 		 $module_stable_version_hash{$module}.'; '.$vstr.
                    415: 		 ' (VERSION_FROM is '.$fs.') want dist version '.
                    416: 		 $dist_stable_version_hash{$dist}."\n");
                    417: 	  }
                    418: 	else
                    419:           {
                    420: 	    push(@stable_okay,'OKAY     '.$dist.' wanted: v'.
                    421: 		  $module_stable_version_hash{$module}.'; '.$vstr.
                    422: 		  ' (VERSION_FROM is '.$fs.').'."\n");
                    423: 	  }
                    424:       }
                    425:   }
1.1       harris41  426: 
1.6       harris41  427: print("\n".'SYNOPSIS'."\n");
                    428: 
                    429: # ========================================================== The stable report.
                    430: print('**** STABLE REPORT (what a production server should worry about)'."\n");
1.9       harris41  431: if (@stable_missing)
                    432:   {
1.6       harris41  433:     print('There are '.scalar(@stable_missing).' CPAN distributions missing '.
                    434: 	  'from this LON-CAPA system.'."\n");
1.9       harris41  435:   }
                    436: else
                    437:   {
1.6       harris41  438:     print('All perl modules needed by LON-CAPA appear to be present.'."\n");
1.9       harris41  439:   }
                    440: if (@stable_outdated)
                    441:   {
1.6       harris41  442:     print(scalar(@stable_outdated).' CPAN distributions are out-dated '.
                    443: 	  'on this LON-CAPA system.'."\n");
1.9       harris41  444:   }
                    445: if (@stable_veryokay)
                    446:   {
1.6       harris41  447:     print(scalar(@stable_veryokay).' CPAN distributions are an exact match '.
                    448: 	  '(based on version number).'."\n");
                    449: #    print @stable_veryokay;
1.9       harris41  450:   }
                    451: if (@stable_okay)
                    452:   {
1.6       harris41  453:     print(scalar(@stable_okay).' CPAN dists have a version number '.
                    454: 	  'higher than expected'.
                    455: 	  ' (probably okay).'. "\n");
1.9       harris41  456:   }
1.6       harris41  457: print("\n");
1.1       harris41  458: 
1.6       harris41  459: # ===================================================== The development report.
                    460: print('**** DEVELOPMENT REPORT (do not worry about this unless you are a'.
                    461:       ' coder)'."\n");
1.9       harris41  462: if (@dev_missing)
                    463:   {
1.6       harris41  464:     print('There are '.scalar(@dev_missing).' CPAN distributions missing '.
                    465: 	  'from this LON-CAPA system.'."\n");
1.9       harris41  466:   }
                    467: else
                    468:   {
1.6       harris41  469:     print('All perl modules needed by LON-CAPA appear to be present.'."\n");
1.9       harris41  470:   }
                    471: if (@dev_outdated)
                    472:   {
1.6       harris41  473:     print(scalar(@dev_outdated).' CPAN distributions are out-dated '.
                    474: 	  'on this LON-CAPA system.'."\n");
1.9       harris41  475:   }
                    476: if (@dev_veryokay)
                    477:   {
1.6       harris41  478:     print(scalar(@dev_veryokay).' CPAN distributions are an exact match '.
                    479: 	  '(based on version number).'."\n");
                    480: #    print @dev_veryokay;
1.9       harris41  481:   }
                    482: if (@dev_okay)
                    483:   {
1.6       harris41  484:     print(scalar(@stable_okay).' CPAN dists have a version number '.
                    485: 	  'higher than expected'.
                    486: 	  ' (probably okay).'. "\n");
1.9       harris41  487:   }
1.6       harris41  488: 
1.9       harris41  489: my $detailstream;
                    490: if ($mode eq 'synopsis')
                    491:   {
1.6       harris41  492:     print("\n".'**** NOTE ****'."\n".
                    493: 	  'After everything completes, please view the CPAN_STATUS_REPORT'.
                    494: 	  ' file for more '."\n".'information on resolving your perl modules.'.
                    495: 	  "\n");
                    496: 
                    497:     print('* HIT RETURN WHEN READY TO CONTINUE *'."\n");
                    498:     my $returnkey=<>;
1.9       harris41  499:     open(OUT,'>CPAN_STATUS_REPORT');
                    500:     $detailstream=\*OUT;
                    501:   }
                    502: else
                    503:   {
                    504:     $detailstream=\*STDOUT;
                    505:   }
                    506: print($detailstream 
                    507:       "\n".'DETAILED STATUS REPORT'."\n"); # Header of status report.
1.6       harris41  508: 
1.9       harris41  509: # Print advisory notices.
                    510: print($detailstream
                    511:       "\n".'(Consult loncapa/doc/otherfiles/perl_modules.txt for '.
                    512:       'information on'."\n".
                    513:       ' manual build instructions.)'."\n");
                    514: print($detailstream
                    515:       "\n".'(**** IMPORTANT NOTICE **** HTML-Parser needs to be patched '.
                    516:       "\n".' as described in loncapa/doc/otherfiles/perl_modules.txt)'.
                    517:       "\n");
                    518: 
                    519: print($detailstream
                    520:       "\n".'For manual installation of CPAN distributions, visit'."\n".
                    521:       'http://search.cpan.org/dist/DistName'."\n".
                    522:       'where DistName is something like "HTML-Parser" or "libwww-perl".'.
                    523:       "\n");
                    524: 
                    525: print($detailstream
                    526:       "\n".'For automatic installation of CPAN distributions, visit'."\n".
                    527:       'http://install.lon-capa.org/resources/cpanauto/DistName.bin'."\n".
                    528:       'where DistName.bin is something like "HTML-Parser.bin" or '.
                    529:       '"libwww-perl.bin".'."\n");
                    530: 
                    531: # Print detailed report of stable.
                    532: print($detailstream
                    533:       "\n".'STABLE (DETAILED REPORT)'."\n");
                    534: print $detailstream @stable_missing;
                    535: print $detailstream @stable_outdated;
                    536: print $detailstream @stable_veryokay;
                    537: print $detailstream @stable_okay;
                    538: print($detailstream "\n".'DEVELOPMENT (DETAILED REPORT)'."\n");
                    539: print $detailstream @dev_missing;
                    540: print $detailstream @dev_outdated;
                    541: print $detailstream @dev_veryokay;
                    542: print $detailstream @dev_okay;
1.6       harris41  543: 
1.9       harris41  544: if ($mode eq "html")
                    545:   {
1.6       harris41  546:     print(<<END);
                    547: </pre>
                    548: </body>
                    549: </html>
1.5       harris41  550: END
1.9       harris41  551:   }
1.6       harris41  552: 
                    553: # ================================================================ Subroutines.
                    554: # Note that "vers_cmp" and "have_vers" are adapted from a bugzilla version 2.16
                    555: # "checksetup.pl" script.
                    556: 
                    557: # ------------ vers_cmp : compare two version numbers and see which is greater.
                    558: # vers_cmp is adapted from Sort::Versions 1.3 1996/07/11 13:37:00 kjahds,
                    559: # which is not included with Perl by default, hence the need to copy it here.
                    560: # Seems silly to require it when this is the only place we need it...
                    561: sub vers_cmp
                    562:   {
                    563:     if (@_ < 2) { die "not enough parameters for vers_cmp" }
                    564:     if (@_ > 2) { die "too many parameters for vers_cmp" }
                    565:     my ($a, $b) = @_;
                    566:     my (@A) = ($a =~ /(\.|\d+|[^\.\d]+)/g);
                    567:     my (@B) = ($b =~ /(\.|\d+|[^\.\d]+)/g);
                    568:     my ($A,$B);
                    569:     while (@A and @B)
                    570:       {
                    571:         $A = shift @A;
                    572:         $B = shift @B;
                    573:         if ($A eq "." and $B eq ".")
                    574:           {
                    575:             next;
                    576:           }
                    577:         elsif ( $A eq "." )
                    578:           {
                    579:             return -1;
                    580:           }
                    581:         elsif ( $B eq "." )
                    582:           {
                    583:             return 1;
                    584:           }
                    585:         elsif ($A =~ /^\d+$/ and $B =~ /^\d+$/)
                    586:           {
                    587:             return $A <=> $B if $A <=> $B;
                    588:           }
                    589:         else
                    590:           {
                    591:             $A = uc $A;
                    592:             $B = uc $B;
                    593:             return $A cmp $B if $A cmp $B;
                    594:           }
                    595:       }
                    596:     @A <=> @B;
                    597:   }
                    598: 
                    599: # --------------- have_vers: syntax check the version number and call vers_cmp.
                    600: # This was originally clipped from the libnet Makefile.PL, adapted here to
                    601: # use the above vers_cmp routine for accurate version checking.
                    602: sub have_vers
                    603:   {
                    604:     my ($pkg, $wanted) = @_;
                    605:     my ($msg, $vnum, $vstr);
                    606:     no strict 'refs';
                    607:     # printf("Checking for %15s %-9s ", $pkg, !$wanted?'(any)':"(v$wanted)");
                    608: 
                    609:     eval { my $p; ($p = $pkg . ".pm") =~ s!::!/!g; require $p; };
                    610: 
                    611:     $vnum = ${"${pkg}::VERSION"} || ${"${pkg}::Version"} || 0;
                    612:     $vnum = -1 if $@;
                    613: 
                    614:     if ($vnum eq "-1") # string compare just in case it's non-numeric
                    615:       {
                    616:         $vstr = "not found";
                    617:       }
                    618:     elsif (vers_cmp($vnum,"0") > -1)
                    619:       {
                    620:         $vstr = "found v$vnum";
                    621:       }
                    622:     else
                    623:       {
                    624:         $vstr = "found unknown version";
                    625:       }
                    626: 
                    627:     my $vok = (vers_cmp($vnum,$wanted) > -1);
                    628:     # print ((($vok) ? "ok: " : " "), "$vstr\n");
                    629:     return ($vok,$vstr);
                    630:   }

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