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