utils/perlivp.PL

   1 #!/usr/local/bin/perl
   2
   3 use Config;
   4 use File::Basename;
   5 use Cwd;
   6
   7 # List explicitly here the variables you want Configure to
   8 # generate.  Metaconfig only looks for shell variables, so you
   9 # have to mention them as if they were shell variables, not
  10 # %Config entries:
  11 #  $startperl
  12 #  $perlpath
  13 #  $eunicefix
  14
  15 # This forces PL files to create target in same directory as PL file.
  16 # This is so that make depend always knows where to find PL derivatives.
  17 my $origdir = cwd;
  18 chdir dirname($0);
  19 my $file = basename($0, '.PL');
  20 $file .= '.com' if $^O eq 'VMS';
  21
  22 # Create output file.
  23 open OUT,">$file" or die "Can't create $file: $!";
  24
  25 print "Extracting $file (with variable substitutions)\n";
  26
  27 # In this section, perl variables will be expanded during extraction.
  28 # You can use $Config{...} to use Configure variables.
  29
  30 print OUT <<"!GROK!THIS!";
  31 $Config{'startperl'}
  32     eval 'exec $Config{'perlpath'} -S \$0 \${1+"\$@"}'
  33         if \$running_under_some_shell;
  34 !GROK!THIS!
  35
  36 # In the following, perl variables are not expanded during extraction.
  37
  38 print OUT <<'!NO!SUBS!';
  39
  40 # perlivp V 0.02
  41
  42
  43 sub usage {
  44     warn "@_\n" if @_;
  45     print << "    EOUSAGE";
  46 Usage:
  47
  48     $0 [-a] [-p] [-v] | [-h]
  49
  50     -a Run all tests (default is to skip .ph tests)
  51     -p Print a preface before each test telling what it will test.
  52     -v Verbose mode in which extra information about test results
  53        is printed.  Test failures always print out some extra information
  54        regardless of whether or not this switch is set.
  55     -h Prints this help message.
  56     EOUSAGE
  57     exit;
  58 }
  59
  60 use vars qw(%opt); # allow testing with older versions (do not use our)
  61
  62 @opt{ qw/? H h P p V v/ } = qw(0 0 0 0 0 0 0);
  63
  64 while ($ARGV[0] =~ /^-/) {
  65     $ARGV[0] =~ s/^-//;
  66     for my $flag (split(//,$ARGV[0])) {
  67         usage() if '?' =~ /\Q$flag/;
  68         usage() if 'h' =~ /\Q$flag/;
  69         usage() if 'H' =~ /\Q$flag/;
  70         usage("unknown flag: `$flag'") unless 'HhPpVva' =~ /\Q$flag/;
  71         warn "$0: `$flag' flag already set\n" if $opt{$flag}++;
  72     }
  73     shift;
  74 }
  75
  76 $opt{p}++ if $opt{P};
  77 $opt{v}++ if $opt{V};
  78
  79 my $pass__total = 0;
  80 my $error_total = 0;
  81 my $tests_total = 0;
  82
  83 !NO!SUBS!
  84
  85 # We cannot merely check the variable `$^X' in general since on many
  86 # Unixes it is the basename rather than the full path to the perl binary.
  87 my $perlpath = '';
  88 if (defined($Config{'perlpath'})) { $perlpath = $Config{'perlpath'}; }
  89
  90 # The useithreads Config variable plays a role in whether or not
  91 # threads and threads/shared work when C<use>d.  They apparently always
  92 # get installed on systems that can run Configure.
  93 my $useithreads = '';
  94 if (defined($Config{'useithreads'})) { $useithreads = $Config{'useithreads'}; }
  95
  96 print OUT <<"!GROK!THIS!";
  97 my \$perlpath = '$perlpath';
  98 my \$useithreads = '$useithreads';
  99 !GROK!THIS!
 100
 101 print OUT <<'!NO!SUBS!';
 102
 103 print "## Checking Perl binary via variable `\$perlpath' = $perlpath.\n" if $opt{'p'};
 104
 105 if (-x $perlpath) {
 106     print "## Perl binary `$perlpath' appears executable.\n" if $opt{'v'};
 107     print "ok 1\n";
 108     $pass__total++;
 109 }
 110 else {
 111     print "# Perl binary `$perlpath' does not appear executable.\n";
 112     print "not ok 1\n";
 113     $error_total++;
 114 }
 115 $tests_total++;
 116
 117
 118 print "## Checking Perl version via variable `\$]'.\n" if $opt{'p'};
 119
 120 !NO!SUBS!
 121
 122 print OUT <<"!GROK!THIS!";
 123 my \$ivp_VERSION = $];
 124
 125 !GROK!THIS!
 126 print OUT <<'!NO!SUBS!';
 127 if ($ivp_VERSION eq $]) {
 128     print "## Perl version `$]' appears installed as expected.\n" if $opt{'v'};
 129     print "ok 2\n";
 130     $pass__total++;
 131 }
 132 else {
 133     print "# Perl version `$]' installed, expected $ivp_VERSION.\n";
 134     print "not ok 2\n";
 135     $error_total++;
 136 }
 137 $tests_total++;
 138
 139
 140 print "## Checking roots of the Perl library directory tree via variable `\@INC'.\n" if $opt{'p'};
 141
 142 my $INC_total = 0;
 143 my $INC_there = 0;
 144 foreach (@INC) {
 145     next if $_ eq '.'; # skip -d test here
 146     if ($^O eq 'MacOS') {
 147         next if $_ eq ':'; # skip -d test here
 148         next if $_ eq 'Dev:Pseudo:'; # why is this in @INC?
 149     }
 150     if (-d $_) {
 151         print "## Perl \@INC directory `$_' exists.\n" if $opt{'v'};
 152         $INC_there++;
 153     }
 154     else {
 155         print "# Perl \@INC directory `$_' does not appear to exist.\n";
 156     }
 157     $INC_total++;
 158 }
 159 if ($INC_total == $INC_there) {
 160     print "ok 3\n";
 161     $pass__total++;
 162 }
 163 else {
 164     print "not ok 3\n";
 165     $error_total++;
 166 }
 167 $tests_total++;
 168
 169
 170 print "## Checking installations of modules necessary for ivp.\n" if $opt{'p'};
 171
 172 my $needed_total = 0;
 173 my $needed_there = 0;
 174 foreach (qw(Config.pm ExtUtils/Installed.pm)) {
 175     $@ = undef;
 176     $needed_total++;
 177     eval "require \"$_\";";
 178     if (!$@) {
 179         print "## Module `$_' appears to be installed.\n" if $opt{'v'};
 180         $needed_there++;
 181     }
 182     else {
 183         print "# Needed module `$_' does not appear to be properly installed.\n";
 184     }
 185     $@ = undef;
 186 }
 187 if ($needed_total == $needed_there) {
 188     print "ok 4\n";
 189     $pass__total++;
 190 }
 191 else {
 192     print "not ok 4\n";
 193     $error_total++;
 194 }
 195 $tests_total++;
 196
 197
 198 print "## Checking installations of extensions built with perl.\n" if $opt{'p'};
 199
 200 use Config;
 201
 202 my $extensions_total = 0;
 203 my $extensions_there = 0;
 204 if (defined($Config{'extensions'})) {
 205     my @extensions = split(/\s+/,$Config{'extensions'});
 206     foreach (@extensions) {
 207         next if ($_ eq '');
 208         if ( $useithreads !~ /define/i ) {
 209             next if ($_ eq 'threads');
 210             next if ($_ eq 'threads/shared');
 211         }
 212         next if ($_ eq 'Devel/DProf');
 213            # VMS$ perl  -e "eval ""require \""Devel/DProf.pm\"";"" print $@"
 214            # \NT> perl  -e "eval \"require 'Devel/DProf.pm'\"; print $@"
 215            # DProf: run perl with -d to use DProf.
 216            # Compilation failed in require at (eval 1) line 1.
 217         eval " require \"$_.pm\"; ";
 218         if (!$@) {
 219             print "## Module `$_' appears to be installed.\n" if $opt{'v'};
 220             $extensions_there++;
 221         }
 222         else {
 223             print "# Required module `$_' does not appear to be properly installed.\n";
 224             $@ = undef;
 225         }
 226         $extensions_total++;
 227     }
 228
 229     # A silly name for a module (that hopefully won't ever exist).
 230     # Note that this test serves more as a check of the validity of the
 231     # actuall required module tests above.
 232     my $unnecessary = 'bLuRfle';
 233
 234     if (!grep(/$unnecessary/, @extensions)) {
 235         $@ = undef;
 236         eval " require \"$unnecessary.pm\"; ";
 237         if ($@) {
 238             print "## Unnecessary module `$unnecessary' does not appear to be installed.\n" if $opt{'v'};
 239         }
 240         else {
 241             print "# Unnecessary module `$unnecessary' appears to be installed.\n";
 242             $extensions_there++;
 243         }
 244     }
 245     $@ = undef;
 246 }
 247 if ($extensions_total == $extensions_there) {
 248     print "ok 5\n";
 249     $pass__total++;
 250 }
 251 else {
 252     print "not ok 5\n";
 253     $error_total++;
 254 }
 255 $tests_total++;
 256
 257
 258 print "## Checking installations of later additional extensions.\n" if $opt{'p'};
 259
 260 use ExtUtils::Installed;
 261
 262 my $installed_total = 0;
 263 my $installed_there = 0;
 264 my $version_check = 0;
 265 my $installed = ExtUtils::Installed -> new();
 266 my @modules = $installed -> modules();
 267 my @missing = ();
 268 my $version = undef;
 269 for (@modules) {
 270     $installed_total++;
 271     # Consider it there if it contains one or more files,
 272     # and has zero missing files,
 273     # and has a defined version
 274     $version = undef;
 275     $version = $installed -> version($_);
 276     if ($version) {
 277         print "## $_; $version\n" if $opt{'v'};
 278         $version_check++;
 279     }
 280     else {
 281         print "# $_; NO VERSION\n" if $opt{'v'};
 282     }
 283     $version = undef;
 284     @missing = ();
 285     @missing = $installed -> validate($_);
 286     if ($#missing >= 0) {
 287         print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
 288         print '# ',join(' ',@missing),"\n";
 289     }
 290     elsif ($#missing == -1) {
 291         $installed_there++;
 292     }
 293     @missing = ();
 294 }
 295 if (($installed_total == $installed_there) &&
 296     ($installed_total == $version_check)) {
 297     print "ok 6\n";
 298     $pass__total++;
 299 }
 300 else {
 301     print "not ok 6\n";
 302     $error_total++;
 303 }
 304 $tests_total++;
 305
 306
 307 if ($opt{'a'}) {
 308 print "## Checking installations of *.h -> *.ph header files.\n" if $opt{'p'};
 309 my $ph_there = 0;
 310 my $var = undef;
 311 my $val = undef;
 312 my $h_file = undef;
 313 # Just about "any" C implementation ought to have a stdio.h (even if
 314 # Config.pm may not list a i_stdio var).
 315 my @ph_files = qw(stdio.ph);
 316 # Add the ones that we know that perl thinks are there:
 317 while (($var, $val) = each %Config) {
 318     if ($var =~ m/i_(.+)/ && $val eq 'define') {
 319         $h_file = $1;
 320         # Some header and symbol names don't match for hysterical raisins.
 321         $h_file = 'arpa/inet'    if $h_file eq 'arpainet';
 322         $h_file = 'netinet/in'   if $h_file eq 'niin';
 323         $h_file = 'netinet/tcp'  if $h_file eq 'netinettcp';
 324         $h_file = 'sys/resource' if $h_file eq 'sysresrc';
 325         $h_file = 'sys/select'   if $h_file eq 'sysselct';
 326         $h_file = 'sys/security' if $h_file eq 'syssecrt';
 327         $h_file = 'rpcsvc/dbm'   if $h_file eq 'rpcsvcdbm';
 328         # This ought to distinguish syslog from sys/syslog.
 329         # (NB syslog.ph is heavily used for the DBI pre-requisites).
 330         $h_file =~ s{^sys(\w.+)}{sys/$1} unless $h_file eq 'syslog';
 331         push(@ph_files, "$h_file.ph");
 332     }
 333 }
 334 #foreach (qw(stdio.ph syslog.ph)) {
 335 foreach (@ph_files) {
 336     $@ = undef;
 337     eval "require \"$_\";";
 338     if (!$@) {
 339         print "## Perl header `$_' appears to be installed.\n" if $opt{'v'};
 340         $ph_there++;
 341     }
 342     else {
 343         print "# Perl header `$_' does not appear to be properly installed.\n";
 344     }
 345     $@ = undef;
 346 }
 347
 348 if (scalar(@ph_files) == $ph_there) {
 349     print "ok 7\n";
 350     $pass__total++;
 351 }
 352 else {
 353     print "not ok 7\n";
 354     $error_total++;
 355 }
 356 $tests_total++;
 357 }
 358 else {
 359     print "##  Skip checking of *.ph header files.\n" if $opt{'p'};
 360 }
 361
 362 # Final report (rather than feed ousrselves to Test::Harness::runtests()
 363 # we simply format some output on our own to keep things simple and
 364 # easier to "fix" - at least for now.
 365
 366 if ($error_total == 0 && $tests_total) {
 367     print "All tests successful.\n";
 368 } elsif ($tests_total==0){
 369         die "FAILED--no tests were run for some reason.\n";
 370 } else {
 371     my $rate = 0.0;
 372     if ($tests_total > 0) { $rate = sprintf "%.2f", 100.0 * ($pass__total / $tests_total); }
 373     printf " %d/%d subtests failed, %.2f%% okay.\n",
 374                               $error_total, $tests_total, $rate;
 375 }
 376
 377 =head1 NAME
 378
 379 perlivp - Perl Installation Verification Procedure
 380
 381 =head1 SYNOPSIS
 382
 383 B<perlivp> [B<-a>] [B<-p>] [B<-v>] [B<-h>]
 384
 385 =head1 DESCRIPTION
 386
 387 The B<perlivp> program is set up at Perl source code build time to test the
 388 Perl version it was built under.  It can be used after running:
 389
 390     make install
 391
 392 (or your platform's equivalent procedure) to verify that B<perl> and its
 393 libraries have been installed correctly.  A correct installation is verified
 394 by output that looks like:
 395
 396     ok 1
 397     ok 2
 398
 399 etc.
 400
 401 =head1 OPTIONS
 402
 403 =over 5
 404
 405 =item B<-h> help
 406
 407 Prints out a brief help message.
 408
 409 =item B<-a> run all tests
 410
 411 Normally tests for optional features are skipped.  With -a all tests
 412 are executed.
 413
 414 =item B<-p> print preface
 415
 416 Gives a description of each test prior to performing it.
 417
 418 =item B<-v> verbose
 419
 420 Gives more detailed information about each test, after it has been performed.
 421 Note that any failed tests ought to print out some extra information whether
 422 or not -v is thrown.
 423
 424 =back
 425
 426 =head1 DIAGNOSTICS
 427
 428 =over 4
 429
 430 =item * print "# Perl binary `$perlpath' does not appear executable.\n";
 431
 432 Likely to occur for a perl binary that was not properly installed.
 433 Correct by conducting a proper installation.
 434
 435 =item * print "# Perl version `$]' installed, expected $ivp_VERSION.\n";
 436
 437 Likely to occur for a perl that was not properly installed.
 438 Correct by conducting a proper installation.
 439
 440 =item * print "# Perl \@INC directory `$_' does not appear to exist.\n";
 441
 442 Likely to occur for a perl library tree that was not properly installed.
 443 Correct by conducting a proper installation.
 444
 445 =item * print "# Needed module `$_' does not appear to be properly installed.\n";
 446
 447 One of the two modules that is used by perlivp was not present in the
 448 installation.  This is a serious error since it adversely affects perlivp's
 449 ability to function.  You may be able to correct this by performing a
 450 proper perl installation.
 451
 452 =item * print "# Required module `$_' does not appear to be properly installed.\n";
 453
 454 An attempt to C<eval "require $module"> failed, even though the list of
 455 extensions indicated that it should succeed.  Correct by conducting a proper
 456 installation.
 457
 458 =item * print "# Unnecessary module `bLuRfle' appears to be installed.\n";
 459
 460 This test not coming out ok could indicate that you have in fact installed
 461 a bLuRfle.pm module or that the C<eval " require \"$module_name.pm\"; ">
 462 test may give misleading results with your installation of perl.  If yours
 463 is the latter case then please let the author know.
 464
 465 =item * print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
 466
 467 One or more files turned up missing according to a run of
 468 C<ExtUtils::Installed -E<gt> validate()> over your installation.
 469 Correct by conducting a proper installation.
 470
 471 =item * print "# Perl header `$_' does not appear to be properly installed.\n";
 472
 473 Correct by running B<h2ph> over your system's C header files.  If necessary,
 474 edit the resulting *.ph files to eliminate perl syntax errors.
 475
 476 =back
 477
 478 For further information on how to conduct a proper installation consult the
 479 INSTALL file that comes with the perl source and the README file for your
 480 platform.
 481
 482 =head1 AUTHOR
 483
 484 Peter Prymmer
 485
 486 =cut
 487
 488 !NO!SUBS!
 489
 490 close OUT or die "Can't close $file: $!";
 491 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
 492 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
 493 chdir $origdir;
 494