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

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

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