Annotation of loncom/build/system_dependencies/perltest.pl, revision 1.12
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.12 ! albertel 5: # $Id: perltest.pl,v 1.11 2003/08/22 19:56:02 albertel 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.12 ! albertel 161: my $VERSION = sprintf("%d.%02d", q$Revision: 1.11 $ =~ /(\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;
1.12 ! albertel 328: my @dev_to_update;
1.6 harris41 329: my @stable_missing;
330: my @stable_outdated;
331: my @stable_okay;
332: my @stable_veryokay;
1.12 ! albertel 333: my @stable_to_update;
1.6 harris41 334:
335: # ===== Loop through all of the needed CPAN distributions and probe the system.
1.11 albertel 336: foreach my $dist (keys %dist_module_hash) {
1.6 harris41 337: my $module = $dist_module_hash{$dist};
338: my $fs = $modulefs_hash{$module};
339: my $fsflag = 0;
1.11 albertel 340: if ($big_module_string =~ /$fs/) { $fsflag = 1; }
1.6 harris41 341: my ($vok,$vstr);
1.11 albertel 342: foreach my $type ('dev','stable') {
343: my ($vers_mod,$vers_dist);
1.12 ! albertel 344: my ($missing,$outdated,$veryokay,$okay,$to_update);
1.11 albertel 345: if ($type eq 'dev') {
346: $vers_mod=$module_dev_version_hash{$module};
347: $vers_dist=$dist_dev_version_hash{$dist};
1.12 ! albertel 348: ($missing,$outdated,$veryokay,$okay,$to_update)=
! 349: (\@dev_missing,\@dev_outdated,\@dev_veryokay,\@dev_okay,
! 350: \@dev_to_update);
1.11 albertel 351: } elsif ($type eq 'stable') {
352: $vers_mod=$module_stable_version_hash{$module};
353: $vers_dist=$dist_stable_version_hash{$dist};
1.12 ! albertel 354: ($missing,$outdated,$veryokay,$okay,$to_update)=
1.11 albertel 355: (\@stable_missing,\@stable_outdated,\@stable_veryokay,
1.12 ! albertel 356: \@stable_okay,\@stable_to_update);
1.11 albertel 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/) {
1.12 ! albertel 361: push(@$missing,'MISSING '.$dist.' (want distribution '.
1.11 albertel 362: $module.' version '. $vers_dist.') ?'."\n");
1.12 ! albertel 363: push(@$to_update,$dist);
1.11 albertel 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/) {
1.12 ! albertel 369: push(@$missing,'MISSING '.$dist.' (want distribution '.
1.11 albertel 370: $module.' version '.$vers_dist.')'."\n");
1.12 ! albertel 371: push(@$to_update,$dist);
1.11 albertel 372: } elsif ($fsflag and !$vok and $vstr!~/not found/) {
1.12 ! albertel 373: push(@$outdated,'OUTDATED '.$dist.' wanted module: v'.
1.11 albertel 374: $vers_mod.'; '.$vstr.' (VERSION_FROM is '.
375: $fs.') want dist '.$module.' version '.$vers_dist.'.'. "\n");
1.12 ! albertel 376: push(@$to_update,$dist);
1.11 albertel 377: } elsif ($fsflag) {
378: $vstr=~/found v(.*)/;
379: my $vc=$1;
380: if ($vc eq $vers_mod) {
1.12 ! albertel 381: push(@$veryokay,'VERYOKAY '.$dist.' wanted: v'.
1.11 albertel 382: $vers_mod.'; '.$vstr.' (VERSION_FROM is '.$fs.
383: ') want dist '.$module.' version '.$vers_dist."\n");
384: } else {
1.12 ! albertel 385: push(@$okay,'OKAY '.$dist.' wanted: v'.
1.11 albertel 386: $vers_mod.'; '.$vstr.' (VERSION_FROM is '.$fs.').'."\n");
387: }
388: }
389: }
390: }
1.1 harris41 391:
1.6 harris41 392: print("\n".'SYNOPSIS'."\n");
393:
394: # ========================================================== The stable report.
395: print('**** STABLE REPORT (what a production server should worry about)'."\n");
1.9 harris41 396: if (@stable_missing)
397: {
1.6 harris41 398: print('There are '.scalar(@stable_missing).' CPAN distributions missing '.
399: 'from this LON-CAPA system.'."\n");
1.9 harris41 400: }
401: else
402: {
1.6 harris41 403: print('All perl modules needed by LON-CAPA appear to be present.'."\n");
1.9 harris41 404: }
405: if (@stable_outdated)
406: {
1.6 harris41 407: print(scalar(@stable_outdated).' CPAN distributions are out-dated '.
408: 'on this LON-CAPA system.'."\n");
1.9 harris41 409: }
410: if (@stable_veryokay)
411: {
1.6 harris41 412: print(scalar(@stable_veryokay).' CPAN distributions are an exact match '.
413: '(based on version number).'."\n");
414: # print @stable_veryokay;
1.9 harris41 415: }
416: if (@stable_okay)
417: {
1.6 harris41 418: print(scalar(@stable_okay).' CPAN dists have a version number '.
419: 'higher than expected'.
420: ' (probably okay).'. "\n");
1.9 harris41 421: }
1.6 harris41 422: print("\n");
1.1 harris41 423:
1.6 harris41 424: # ===================================================== The development report.
425: print('**** DEVELOPMENT REPORT (do not worry about this unless you are a'.
426: ' coder)'."\n");
1.9 harris41 427: if (@dev_missing)
428: {
1.6 harris41 429: print('There are '.scalar(@dev_missing).' CPAN distributions missing '.
430: 'from this LON-CAPA system.'."\n");
1.9 harris41 431: }
432: else
433: {
1.6 harris41 434: print('All perl modules needed by LON-CAPA appear to be present.'."\n");
1.9 harris41 435: }
436: if (@dev_outdated)
437: {
1.6 harris41 438: print(scalar(@dev_outdated).' CPAN distributions are out-dated '.
439: 'on this LON-CAPA system.'."\n");
1.9 harris41 440: }
441: if (@dev_veryokay)
442: {
1.6 harris41 443: print(scalar(@dev_veryokay).' CPAN distributions are an exact match '.
444: '(based on version number).'."\n");
445: # print @dev_veryokay;
1.9 harris41 446: }
447: if (@dev_okay)
448: {
1.6 harris41 449: print(scalar(@stable_okay).' CPAN dists have a version number '.
450: 'higher than expected'.
451: ' (probably okay).'. "\n");
1.9 harris41 452: }
1.6 harris41 453:
1.9 harris41 454: my $detailstream;
455: if ($mode eq 'synopsis')
456: {
1.6 harris41 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=<>;
1.9 harris41 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.
1.6 harris41 473:
1.9 harris41 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;
1.6 harris41 508:
1.9 harris41 509: if ($mode eq "html")
510: {
1.6 harris41 511: print(<<END);
512: </pre>
513: </body>
514: </html>
1.5 harris41 515: END
1.9 harris41 516: }
1.6 harris41 517:
1.12 ! albertel 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: }
1.6 harris41 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>
![[BACK]](/icons/back.gif){kind=icon}
Return to perltest.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / build / system_dependencies