Annotation of loncom/build/system_dependencies/perltest.pl, revision 1.8
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.8 ! harris41 5: # $Id: perltest.pl,v 1.7 2002/08/14 16:54:35 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: #
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
1.7 harris41 35: at the file location of F</home/httpd/cgi-bin/perltest.pl>.
1.6 harris41 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.
1.8 ! harris41 167: my $VERSION = sprintf("%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/);
1.6 harris41 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:
1.8 ! harris41 190: <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
! 191: "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1.6 harris41 192: <html>
193: <head>
1.8 ! harris41 194: <meta http-equiv="Content-Type" content="text/html; charset=utf-8"></meta>
1.6 harris41 195: <title>CPAN perl status report; $hostname; $date</title>
196: </head>
1.8 ! harris41 197: <body bgcolor="white">
1.6 harris41 198: <h1>CPAN perl status report</h1>
199: <pre>
200: END
201: }
202:
203: print('Running perltest.pl, version '.$VERSION.'.'."\n");
204: print('(Test status of perl modules installed on a LON-CAPA system).'."\n");
205:
206: # This program is only a "modest" effort to LOOK and see whether
1.1 harris41 207: # necessary perl system dependencies are present. I do not yet
208: # try to actually run tests against each needed perl module.
1.6 harris41 209: # Eventually, all modules will be version-checked, and reasonable
210: # testing implemented.
211:
212: # ================================ Make sure the perl version is suitably high.
213: print('Checking version of perl'."\n");
214: print(`perl --version`);
215: unless (eval("require 5.005"))
216: {
217: die('**** ERROR **** DEPENDENCY FAILURE: require perl version >= 5.005.'.
218: "\n".'Do you even have perl installed on your system?'."\n");
219: }
220: else
221: {
222: print('Perl >= 5.005...okay'."\n");
223: }
224:
225: # ========================================= Make sure we have the find command.
226: my $ret = system("find --version 1>/dev/null");
227: if ($ret)
228: {
229: die('**** ERROR **** DEPENDENCY FAILURE: perltest.pl requires the GNU '.
230: "'find'".' utility.'."\n");
231: }
232: else
233: {
234: print('find command exists...okay'."\n");
235: }
236:
237: # ==================== Scan for all the perl modules present on the filesystem.
238: print('Scanning for perl modules...'."\n");
239: my $big_module_string; # All the modules glued together in a string.
240: my $number_of_modules = 0; # The total number of modules available in system.
241: # --- Build a pattern matching string.
242: foreach my $inc (@INC)
243: {
244: my @m = `find $inc -maxdepth 2000 -type f -name '*.pm'`;
245: foreach my $module (@m)
246: {
247: $big_module_string .= $module;
248: $number_of_modules++;
249: }
250: }
251: # --- Notify user of the number of modules.
252: print('There are '.$number_of_modules.
253: ' perl modules present on your filesystem.'."\n");
254:
255: my %dist_module_hash; # Relate the distributions to their VersionFrom modules.
256: my %module_name_on_filesystem; # Relate module name to filesystem syntax.
257: my %dist_dev_version_hash; # Expected development version of CPAN distribution.
258: my %dist_stable_version_hash; # Expected stable version of CPAN distribution.
259: my %module_dev_version_hash; # development version of versionfrom_module.
260: my %module_stable_version_hash; # stable version of versionfrom_module.
261:
262: # ============================================= Read in cpan_distributions.txt.
263:
264: # A brief description of CPAN (Comprehensive Perl Archive Network):
265: # CPAN software is not released as separate perl modules.
266: # CPAN software is released as "distributions" (also called "dists").
267: # Each distribution consists of multiple perl modules.
268: # For instance, the dist HTML-Tree (http://search.cpan.org/dist/HTML-Tree/)
269: # consists of the modules HTML::AsSubs, HTML::Element, HTML::Element::traverse,
270: # HTML::Parse, HTML::TreeBuilder, and HTML::Tree.
271: # Most (but not all) distributions have versions which are defined
272: # by one of their modules. For the syntax of cpan_distributions.txt,
273: # please read the comments inside cpan_distributions.txt.
274:
275: # Open cpan_distributions.txt.
276: open(IN,'<cpan_distributions.txt') or
277: die('**** ERROR **** Cannot find cpan_distributions.txt'."\n");
278:
279: while(<IN>) # Loop through the lines.
280: {
281: next if /^\#/; # Ignore commented lines.
282: next unless /\S/; # Ignore blank lines.
283:
284: chomp; # Get rid of the newline at the end of the line.
285:
286: # Parse the line.
287: my ($dist_name,$dist_dev_version,$dist_stable_version,$versionfrom_info) =
288: split(/\s+/); # Parse apart the line fields.
289: $versionfrom_info =~ /^(.*)\((.*)\)$/; # Parse apart the versionfrom info.
290: my ($version_module,$version_match) = ($1,$2); # Parse vals into variables.
291:
292: # Calculate DevVersion and StableVersion for the VersionFrom module.
293: my $module_dev_version;
294: my $module_stable_version;
295: if ($version_match eq "*") # There is a dist=module version relationship.
296: {
297: $module_dev_version = $dist_dev_version; # module=dist.
298: $module_stable_version = $dist_stable_version; # module=dist.
299: }
300: else # There is not a dist=module version relationship.
301: {
302: ($module_dev_version,$module_stable_version) =
303: split(/\,/,$version_match); # module set to customized settings.
304: }
305:
306: $dist_module_hash{$dist_name} = $version_module; # The big dist index.
307:
308: # What the module "looks like" on the filesystem.
309: my $version_modulefs = $version_module;
310: $version_modulefs =~ s!::!/!g; $version_modulefs.='.pm';
311: $modulefs_hash{$version_module} = $version_modulefs;
312:
313: # Indexing the expected versions.
314: $module_dev_version_hash{$version_module} = $module_dev_version;
315: $module_stable_version_hash{$version_module} = $module_stable_version;
316: $dist_dev_version_hash{$dist_name} = $dist_dev_version;
317: $dist_stable_version_hash{$dist_name} = $dist_stable_version;
318: }
319: close(IN);
320:
321: # "MISSING" means that no module is present inside the include path.
322: # "OUTDATED" means that a module is present inside the include path but is
323: # an earlier version than expected.
324: # "VERYOKAY" means that the module version is an exact match for the expected
325: # version.
326: # "OKAY" means that the module version is more recent than the expected
327: # version, so things are "probably" okay.... It is still possible
328: # that LON-CAPA is incompatible with the newer distribution version
329: # (corresponding to the module version).
330: my @dev_missing;
331: my @dev_outdated;
332: my @dev_okay;
333: my @dev_veryokay;
334: my @stable_missing;
335: my @stable_outdated;
336: my @stable_okay;
337: my @stable_veryokay;
338:
339: # ===== Loop through all of the needed CPAN distributions and probe the system.
340: foreach my $dist (keys %dist_module_hash)
341: {
342: my $module = $dist_module_hash{$dist};
343: my $fs = $modulefs_hash{$module};
344: my $fsflag = 0;
345: if ($big_module_string =~ /$fs/)
346: {
347: $fsflag = 1;
348: }
349: my ($vok,$vstr);
350: ($vok,$vstr) = have_vers($module,$module_dev_version_hash{$module});
351: # print "fsflag: $fsflag, vok: $vok, vstr: $vstr, fs: $fs\n";
352: if ($fsflag and !$vok and $vstr=~/not found/)
353: {
354: push(@dev_missing,'MISSING '.$dist.' (want distribution version '.
355: $dist_dev_version_hash{$dist}.') ?'."\n");
356: # The question mark indicates there was a pattern match in the
357: # big_module_string which would be unexpected.
358: # There is no usual reason to tell the normal LON-CAPA user about this
359: # question mark. This is just source code magic.
360: }
361: elsif (!$fsflag and !$vok and $vstr=~/not found/)
362: {
363: push(@dev_missing,'MISSING '.$dist.' (want distribution version '.
364: $dist_dev_version_hash{$dist}.')'."\n");
365: }
366: elsif ($fsflag and !$vok and $vstr!~/not found/)
367: {
368: push(@dev_outdated,'OUTDATED '.$dist.' wanted module: v'.
369: $module_dev_version_hash{$module}.'; '.$vstr.' (VERSION_FROM is '.
370: $fs.') want dist version '.$dist_dev_version_hash{$dist}.'.'.
371: "\n");
372: }
373: elsif ($fsflag)
374: {
375: $vstr=~/found v(.*)/;
376: my $vc=$1;
377: if ($vc eq $module_dev_version_hash{$module})
378: {
379: push(@dev_veryokay,'VERYOKAY '.$dist.' wanted: v'.
380: $module_dev_version_hash{$module}.'; '.$vstr.
381: ' (VERSION_FROM is '.$fs.') want dist version '.
382: $dist_dev_version_hash{$dist}."\n");
383: }
384: else
385: {
386: push(@dev_okay,'OKAY '.$dist.' wanted: v'.
387: $module_dev_version_hash{$module}.'; '.$vstr.
388: ' (VERSION_FROM is '.$fs.').'."\n");
389: }
390: }
391: ($vok,$vstr) = have_vers($module,$module_stable_version_hash{$module});
392: if ($fsflag and !$vok and $vstr=~/not found/)
393: {
394: push(@stable_missing,'MISSING '.$dist.' (want distribution version '.
395: $dist_stable_version_hash{$dist}.') ?'."\n");
396: # The question mark indicates there was a pattern match in the
397: # big_module_string which would be unexpected.
398: # There is no usual reason to tell the normal LON-CAPA user about this
399: # question mark. This is just source code magic.
400: }
401: elsif (!$fsflag and !$vok and $vstr=~/not found/)
402: {
403: push(@stable_missing,'MISSING '.$dist.' (want distribution version '.
404: $dist_stable_version_hash{$dist}.')'."\n");
405: }
406: elsif ($fsflag and !$vok and $vstr!~/not found/)
407: {
408: push(@stable_outdated,'OUTDATED '.$dist.' wanted module: v'.
409: $module_stable_version_hash{$module}.'; '.$vstr.
410: ' (VERSION_FROM is '.$fs.') want dist version '.
411: $dist_stable_version_hash{$dist}.'.'."\n");
412: }
413: elsif ($fsflag)
414: {
415: $vstr=~/found v(.*)/;
416: my $vc=$1;
417: if ($vc eq $module_stable_version_hash{$module})
418: {
419: push(@stable_veryokay,'VERYOKAY '.$dist.' wanted: v'.
420: $module_stable_version_hash{$module}.'; '.$vstr.
421: ' (VERSION_FROM is '.$fs.') want dist version '.
422: $dist_stable_version_hash{$dist}."\n");
423: }
424: else
425: {
426: push(@stable_okay,'OKAY '.$dist.' wanted: v'.
427: $module_stable_version_hash{$module}.'; '.$vstr.
428: ' (VERSION_FROM is '.$fs.').'."\n");
429: }
430: }
431: }
1.1 harris41 432:
1.6 harris41 433: print("\n".'SYNOPSIS'."\n");
434:
435: # ========================================================== The stable report.
436: print('**** STABLE REPORT (what a production server should worry about)'."\n");
437: if (@stable_missing) {
438: print('There are '.scalar(@stable_missing).' CPAN distributions missing '.
439: 'from this LON-CAPA system.'."\n");
440: }
441: else {
442: print('All perl modules needed by LON-CAPA appear to be present.'."\n");
443: }
444: if (@stable_outdated) {
445: print(scalar(@stable_outdated).' CPAN distributions are out-dated '.
446: 'on this LON-CAPA system.'."\n");
1.1 harris41 447: }
1.6 harris41 448: if (@stable_veryokay) {
449: print(scalar(@stable_veryokay).' CPAN distributions are an exact match '.
450: '(based on version number).'."\n");
451: # print @stable_veryokay;
452: }
453: if (@stable_okay) {
454: print(scalar(@stable_okay).' CPAN dists have a version number '.
455: 'higher than expected'.
456: ' (probably okay).'. "\n");
457: }
458: print("\n");
1.1 harris41 459:
1.6 harris41 460: # ===================================================== The development report.
461: print('**** DEVELOPMENT REPORT (do not worry about this unless you are a'.
462: ' coder)'."\n");
463: if (@dev_missing) {
464: print('There are '.scalar(@dev_missing).' CPAN distributions missing '.
465: 'from this LON-CAPA system.'."\n");
1.2 harris41 466: }
1.5 harris41 467: else {
1.6 harris41 468: print('All perl modules needed by LON-CAPA appear to be present.'."\n");
469: }
470: if (@dev_outdated) {
471: print(scalar(@dev_outdated).' CPAN distributions are out-dated '.
472: 'on this LON-CAPA system.'."\n");
473: }
474: if (@dev_veryokay) {
475: print(scalar(@dev_veryokay).' CPAN distributions are an exact match '.
476: '(based on version number).'."\n");
477: # print @dev_veryokay;
478: }
479: if (@dev_okay) {
480: print(scalar(@stable_okay).' CPAN dists have a version number '.
481: 'higher than expected'.
482: ' (probably okay).'. "\n");
483: }
484:
485: if ($mode eq 'synopsis') {
486: print("\n".'**** NOTE ****'."\n".
487: 'After everything completes, please view the CPAN_STATUS_REPORT'.
488: ' file for more '."\n".'information on resolving your perl modules.'.
489: "\n");
490:
491: print('* HIT RETURN WHEN READY TO CONTINUE *'."\n");
492: my $returnkey=<>;
493: }
494: else {
495: print("\n".'DETAILED STATUS REPORT'."\n"); # Header of status report.
496:
497: # Print advisory notices.
498: print("\n".'(Consult loncapa/doc/otherfiles/perl_modules.txt for '.
499: 'information on'."\n".
500: ' manual build instructions.)'."\n");
501: print("\n".'(**** IMPORTANT NOTICE **** HTML-Parser needs to be patched '.
502: "\n".' as described in loncapa/doc/otherfiles/perl_modules.txt)'.
503: "\n");
504:
505: print("\n".'For manual installation of CPAN distributions, visit'."\n".
506: 'http://search.cpan.org/dist/DistName'."\n".
507: 'where DistName is something like "HTML-Parser" or "libwww-perl".'.
508: "\n");
509:
510: print("\n".'For automatic installation of CPAN distributions, visit'."\n".
511: 'http://install.lon-capa.org/resources/cpanauto/DistName.bin'."\n".
512: 'where DistName.bin is something like "HTML-Parser.bin" or '.
513: '"libwww-perl.bin".'."\n");
514:
515: # Print detailed report of stable.
516: print("\n".'STABLE (DETAILED REPORT)'."\n");
517: print @stable_missing;
518: print @stable_outdated;
519: print @stable_veryokay;
520: print @stable_okay;
521: print("\n".'DEVELOPMENT (DETAILED REPORT)'."\n");
522: print @dev_missing;
523: print @dev_outdated;
524: print @dev_veryokay;
525: print @dev_okay;
526: }
527:
528: if ($mode eq "html") {
529: print(<<END);
530: </pre>
531: </body>
532: </html>
1.5 harris41 533: END
534: }
1.6 harris41 535:
536: # ================================================================ Subroutines.
537: # Note that "vers_cmp" and "have_vers" are adapted from a bugzilla version 2.16
538: # "checksetup.pl" script.
539:
540: # ------------ vers_cmp : compare two version numbers and see which is greater.
541: # vers_cmp is adapted from Sort::Versions 1.3 1996/07/11 13:37:00 kjahds,
542: # which is not included with Perl by default, hence the need to copy it here.
543: # Seems silly to require it when this is the only place we need it...
544: sub vers_cmp
545: {
546: if (@_ < 2) { die "not enough parameters for vers_cmp" }
547: if (@_ > 2) { die "too many parameters for vers_cmp" }
548: my ($a, $b) = @_;
549: my (@A) = ($a =~ /(\.|\d+|[^\.\d]+)/g);
550: my (@B) = ($b =~ /(\.|\d+|[^\.\d]+)/g);
551: my ($A,$B);
552: while (@A and @B)
553: {
554: $A = shift @A;
555: $B = shift @B;
556: if ($A eq "." and $B eq ".")
557: {
558: next;
559: }
560: elsif ( $A eq "." )
561: {
562: return -1;
563: }
564: elsif ( $B eq "." )
565: {
566: return 1;
567: }
568: elsif ($A =~ /^\d+$/ and $B =~ /^\d+$/)
569: {
570: return $A <=> $B if $A <=> $B;
571: }
572: else
573: {
574: $A = uc $A;
575: $B = uc $B;
576: return $A cmp $B if $A cmp $B;
577: }
578: }
579: @A <=> @B;
580: }
581:
582: # --------------- have_vers: syntax check the version number and call vers_cmp.
583: # This was originally clipped from the libnet Makefile.PL, adapted here to
584: # use the above vers_cmp routine for accurate version checking.
585: sub have_vers
586: {
587: my ($pkg, $wanted) = @_;
588: my ($msg, $vnum, $vstr);
589: no strict 'refs';
590: # printf("Checking for %15s %-9s ", $pkg, !$wanted?'(any)':"(v$wanted)");
591:
592: eval { my $p; ($p = $pkg . ".pm") =~ s!::!/!g; require $p; };
593:
594: $vnum = ${"${pkg}::VERSION"} || ${"${pkg}::Version"} || 0;
595: $vnum = -1 if $@;
596:
597: if ($vnum eq "-1") # string compare just in case it's non-numeric
598: {
599: $vstr = "not found";
600: }
601: elsif (vers_cmp($vnum,"0") > -1)
602: {
603: $vstr = "found v$vnum";
604: }
605: else
606: {
607: $vstr = "found unknown version";
608: }
609:
610: my $vok = (vers_cmp($vnum,$wanted) > -1);
611: # print ((($vok) ? "ok: " : " "), "$vstr\n");
612: return ($vok,$vstr);
613: }
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