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         # This ought to distinguish syslog from sys/syslog.
 317         # (NB syslog.ph is heavily used for the DBI pre-requisites).
 318         $h_file =~ s{^sys(\w.+)}{sys/$1} unless $h_file eq 'syslog';
 319         push(@ph_files, "$h_file.ph");
 320     }
 321 }
 322 #foreach (qw(stdio.ph syslog.ph)) {
 323 foreach (@ph_files) {
 324     $@ = undef;
 325     eval "require \"$_\";";
 326     if (!$@) {
 327         print "## Perl header `$_' appears to be installed.\n" if $opt{'v'};
 328         $ph_there++;
 329     }
 330     else {
 331         print "# Perl header `$_' does not appear to be properly installed ($@).\n";
 332     }
 333     $@ = undef;
 334 }
 335
 336 if (scalar(@ph_files) == $ph_there) {
 337     print "ok 7\n";
 338     $pass__total++;
 339 }
 340 else {
 341     print "not ok 7\n";
 342     $error_total++;
 343 }
 344 $tests_total++;
 345
 346 # Final report (rather than feed ousrselves to Test::Harness::runtests()
 347 # we simply format some output on our own to keep things simple and
 348 # easier to "fix" - at least for now.
 349
 350 if ($error_total == 0 && $tests_total) {
 351     print "All tests successful.\n";
 352 } elsif ($tests_total==0){
 353         die "FAILED--no tests were run for some reason.\n";
 354 } else {
 355     my $rate = 0.0;
 356     if ($tests_total > 0) { $rate = sprintf "%.2f", 100.0 * ($pass__total / $tests_total); }
 357     printf " %d/%d subtests failed, %.2f%% okay.\n",
 358                               $error_total, $tests_total, $rate;
 359 }
 360
 361 =head1 NAME
 362
 363 B<perlivp> - Perl Installation Verification Procedure
 364
 365 =head1 SYNOPSIS
 366
 367 B<perlivp> [B<-p>] [B<-v>] [B<-h>]
 368
 369 =head1 DESCRIPTION
 370
 371 The B<perlivp> program is set up at Perl source code build time to test the
 372 Perl version it was built under.  It can be used after running:
 373
 374     make install
 375
 376 (or your platform's equivalent procedure) to verify that B<perl> and its
 377 libraries have been installed correctly.  A correct installation is verified
 378 by output that looks like:
 379
 380     ok 1
 381     ok 2
 382
 383 etc.
 384
 385 =head1 OPTIONS
 386
 387 =over 5
 388
 389 =item B<-h> help
 390
 391 Prints out a brief help message.
 392
 393 =item B<-p> print preface
 394
 395 Gives a description of each test prior to performing it.
 396
 397 =item B<-v> verbose
 398
 399 Gives more detailed information about each test, after it has been performed.
 400 Note that any failed tests ought to print out some extra information whether
 401 or not -v is thrown.
 402
 403 =back
 404
 405 =head1 DIAGNOSTICS
 406
 407 =over 4
 408
 409 =item * print "# Perl binary `$perlpath' does not appear executable.\n";
 410
 411 Likely to occur for a perl binary that was not properly installed.
 412 Correct by conducting a proper installation.
 413
 414 =item * print "# Perl version `$]' installed, expected $ivp_VERSION.\n";
 415
 416 Likely to occur for a perl that was not properly installed.
 417 Correct by conducting a proper installation.
 418
 419 =item * print "# Perl \@INC directory `$_' does not appear to exist.\n";
 420
 421 Likely to occur for a perl library tree that was not properly installed.
 422 Correct by conducting a proper installation.
 423
 424 =item * print "# Needed module `$_' does not appear to be properly installed.\n";
 425
 426 One of the two modules that is used by perlivp was not present in the
 427 installation.  This is a serious error since it adversely affects perlivp's
 428 ability to function.  You may be able to correct this by performing a
 429 proper perl installation.
 430
 431 =item * print "# Required module `$_' does not appear to be properly installed.\n";
 432
 433 An attempt to C<eval "require $module"> failed, even though the list of
 434 extensions indicated that it should succeed.  Correct by conducting a proper
 435 installation.
 436
 437 =item * print "# Unnecessary module `bLuRfle' appears to be installed.\n";
 438
 439 This test not coming out ok could indicate that you have in fact installed
 440 a bLuRfle.pm module or that the C<eval " require \"$module_name.pm\"; ">
 441 test may give misleading results with your installation of perl.  If yours
 442 is the latter case then please let the author know.
 443
 444 =item * print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
 445
 446 One or more files turned up missing according to a run of
 447 C<ExtUtils::Installed -E<gt> validate()> over your installation.
 448 Correct by conducting a proper installation.
 449
 450 =item * print "# Perl header `$_' does not appear to be properly installed.\n";
 451
 452 Correct by running B<h2ph> over your system's C header files.  If necessary,
 453 edit the resulting *.ph files to eliminate perl syntax errors.
 454
 455 =back
 456
 457 For further information on how to conduct a proper installation consult the
 458 INSTALL file that comes with the perl source and the README file for your
 459 platform.
 460
 461 =head1 AUTHOR
 462
 463 Peter Prymmer
 464
 465 =cut
 466
 467 !NO!SUBS!
 468
 469 close OUT or die "Can't close $file: $!";
 470 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
 471 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
 472 chdir $origdir;
 473