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 [-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 qw(%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 # The useithreads Config variable plays a role in whether or not
  92 # threads and threads/shared work when C<use>d.  They apparently always
  93 # get installed on systems that can run Configure.
  94 my $useithreads = '';
  95 if (defined($Config{'useithreads'})) { $useithreads = $Config{'useithreads'}; }
  96
  97 print OUT <<"!GROK!THIS!";
  98 my \$perlpath = '$perlpath';
  99 my \$useithreads = '$useithreads';
 100 !GROK!THIS!
 101
 102 print OUT <<'!NO!SUBS!';
 103
 104 print "## Checking Perl binary via variable `\$perlpath' = $perlpath.\n" if $opt{'p'};
 105
 106 if (-x $perlpath) {
 107     print "## Perl binary `$perlpath' appears executable.\n" if $opt{'v'};
 108     print "ok 1\n";
 109     $pass__total++;
 110 }
 111 else {
 112     print "# Perl binary `$perlpath' does not appear executable.\n";
 113     print "not ok 1\n";
 114     $error_total++;
 115 }
 116 $tests_total++;
 117
 118
 119 print "## Checking Perl version via variable `\$]'.\n" if $opt{'p'};
 120
 121 !NO!SUBS!
 122
 123 print OUT <<"!GROK!THIS!";
 124 my \$ivp_VERSION = $];
 125
 126 !GROK!THIS!
 127 print OUT <<'!NO!SUBS!';
 128 if ($ivp_VERSION == $]) {
 129     print "## Perl version `$]' appears installed as expected.\n" if $opt{'v'};
 130     print "ok 2\n";
 131     $pass__total++;
 132 }
 133 else {
 134     print "# Perl version `$]' installed, expected $ivp_VERSION.\n";
 135     print "not ok 2\n";
 136     $error_total++;
 137 }
 138 $tests_total++;
 139
 140
 141 print "## Checking roots of the Perl library directory tree via variable `\@INC'.\n" if $opt{'p'};
 142
 143 my $INC_total = 0;
 144 my $INC_there = 0;
 145 foreach (@INC) {
 146     next if $_ eq '.'; # skip -d test here
 147     if ($^O eq 'MacOS') {
 148         next if $_ eq ':'; # skip -d test here
 149         next if $_ eq 'Dev:Pseudo:'; # why is this in @INC?
 150     }
 151     if (-d $_) {
 152         print "## Perl \@INC directory `$_' exists.\n" if $opt{'v'};
 153         $INC_there++;
 154     }
 155     else {
 156         print "# Perl \@INC directory `$_' does not appear to exist.\n";
 157     }
 158     $INC_total++;
 159 }
 160 if ($INC_total == $INC_there) {
 161     print "ok 3\n";
 162     $pass__total++;
 163 }
 164 else {
 165     print "not ok 3\n";
 166     $error_total++;
 167 }
 168 $tests_total++;
 169
 170
 171 print "## Checking installations of modules necessary for ivp.\n" if $opt{'p'};
 172
 173 my $needed_total = 0;
 174 my $needed_there = 0;
 175 foreach (qw(Config.pm ExtUtils/Installed.pm)) {
 176     $@ = undef;
 177     $needed_total++;
 178     eval "require \"$_\";";
 179     if (!$@) {
 180         print "## Module `$_' appears to be installed.\n" if $opt{'v'};
 181         $needed_there++;
 182     }
 183     else {
 184         print "# Needed module `$_' does not appear to be properly installed.\n";
 185     }
 186     $@ = undef;
 187 }
 188 if ($needed_total == $needed_there) {
 189     print "ok 4\n";
 190     $pass__total++;
 191 }
 192 else {
 193     print "not ok 4\n";
 194     $error_total++;
 195 }
 196 $tests_total++;
 197
 198
 199 print "## Checking installations of extensions built with perl.\n" if $opt{'p'};
 200
 201 use Config;
 202
 203 my $extensions_total = 0;
 204 my $extensions_there = 0;
 205 if (defined($Config{'extensions'})) {
 206     my @extensions = split(/\s+/,$Config{'extensions'});
 207     foreach (@extensions) {
 208         next if ($_ eq '');
 209         if ( $useithreads !~ /define/i ) {
 210             next if ($_ eq 'threads');
 211             next if ($_ eq 'threads/shared');
 212         }
 213         next if ($_ eq 'Devel/DProf');
 214            # VMS$ perl  -e "eval ""require \""Devel/DProf.pm\"";"" print $@"
 215            # \NT> perl  -e "eval \"require 'Devel/DProf.pm'\"; print $@"
 216            # DProf: run perl with -d to use DProf.
 217            # Compilation failed in require at (eval 1) line 1.
 218         eval " require \"$_.pm\"; ";
 219         if (!$@) {
 220             print "## Module `$_' appears to be installed.\n" if $opt{'v'};
 221             $extensions_there++;
 222         }
 223         else {
 224             print "# Required module `$_' does not appear to be properly installed.\n";
 225             $@ = undef;
 226         }
 227         $extensions_total++;
 228     }
 229
 230     # A silly name for a module (that hopefully won't ever exist).
 231     # Note that this test serves more as a check of the validity of the
 232     # actuall required module tests above.
 233     my $unnecessary = 'bLuRfle';
 234
 235     if (!grep(/$unnecessary/, @extensions)) {
 236         $@ = undef;
 237         eval " require \"$unnecessary.pm\"; ";
 238         if ($@) {
 239             print "## Unnecessary module `$unnecessary' does not appear to be installed.\n" if $opt{'v'};
 240         }
 241         else {
 242             print "# Unnecessary module `$unnecessary' appears to be installed.\n";
 243             $extensions_there++;
 244         }
 245     }
 246     $@ = undef;
 247 }
 248 if ($extensions_total == $extensions_there) {
 249     print "ok 5\n";
 250     $pass__total++;
 251 }
 252 else {
 253     print "not ok 5\n";
 254     $error_total++;
 255 }
 256 $tests_total++;
 257
 258
 259 print "## Checking installations of later additional extensions.\n" if $opt{'p'};
 260
 261 use ExtUtils::Installed;
 262
 263 my $installed_total = 0;
 264 my $installed_there = 0;
 265 my $version_check = 0;
 266 my $installed = ExtUtils::Installed -> new();
 267 my @modules = $installed -> modules();
 268 my @missing = ();
 269 my $version = undef;
 270 for (@modules) {
 271     $installed_total++;
 272     # Consider it there if it contains one or more files,
 273     # and has zero missing files,
 274     # and has a defined version
 275     $version = undef;
 276     $version = $installed -> version($_);
 277     if ($version) {
 278         print "## $_; $version\n" if $opt{'v'};
 279         $version_check++;
 280     }
 281     else {
 282         print "# $_; NO VERSION\n" if $opt{'v'};
 283     }
 284     $version = undef;
 285     @missing = ();
 286     @missing = $installed -> validate($_);
 287     if ($#missing >= 0) {
 288         print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
 289         print '# ',join(' ',@missing),"\n";
 290     }
 291     elsif ($#missing == -1) {
 292         $installed_there++;
 293     }
 294     @missing = ();
 295 }
 296 if (($installed_total == $installed_there) &&
 297     ($installed_total == $version_check)) {
 298     print "ok 6\n";
 299     $pass__total++;
 300 }
 301 else {
 302     print "not ok 6\n";
 303     $error_total++;
 304 }
 305 $tests_total++;
 306
 307
 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 # Final report (rather than feed ousrselves to Test::Harness::runtests()
 359 # we simply format some output on our own to keep things simple and
 360 # easier to "fix" - at least for now.
 361
 362 if ($error_total == 0 && $tests_total) {
 363     print "All tests successful.\n";
 364 } elsif ($tests_total==0){
 365         die "FAILED--no tests were run for some reason.\n";
 366 } else {
 367     my $rate = 0.0;
 368     if ($tests_total > 0) { $rate = sprintf "%.2f", 100.0 * ($pass__total / $tests_total); }
 369     printf " %d/%d subtests failed, %.2f%% okay.\n",
 370                               $error_total, $tests_total, $rate;
 371 }
 372
 373 =head1 NAME
 374
 375 B<perlivp> - Perl Installation Verification Procedure
 376
 377 =head1 SYNOPSIS
 378
 379 B<perlivp> [B<-p>] [B<-v>] [B<-h>]
 380
 381 =head1 DESCRIPTION
 382
 383 The B<perlivp> program is set up at Perl source code build time to test the
 384 Perl version it was built under.  It can be used after running:
 385
 386     make install
 387
 388 (or your platform's equivalent procedure) to verify that B<perl> and its
 389 libraries have been installed correctly.  A correct installation is verified
 390 by output that looks like:
 391
 392     ok 1
 393     ok 2
 394
 395 etc.
 396
 397 =head1 OPTIONS
 398
 399 =over 5
 400
 401 =item B<-h> help
 402
 403 Prints out a brief help message.
 404
 405 =item B<-p> print preface
 406
 407 Gives a description of each test prior to performing it.
 408
 409 =item B<-v> verbose
 410
 411 Gives more detailed information about each test, after it has been performed.
 412 Note that any failed tests ought to print out some extra information whether
 413 or not -v is thrown.
 414
 415 =back
 416
 417 =head1 DIAGNOSTICS
 418
 419 =over 4
 420
 421 =item * print "# Perl binary `$perlpath' does not appear executable.\n";
 422
 423 Likely to occur for a perl binary that was not properly installed.
 424 Correct by conducting a proper installation.
 425
 426 =item * print "# Perl version `$]' installed, expected $ivp_VERSION.\n";
 427
 428 Likely to occur for a perl that was not properly installed.
 429 Correct by conducting a proper installation.
 430
 431 =item * print "# Perl \@INC directory `$_' does not appear to exist.\n";
 432
 433 Likely to occur for a perl library tree that was not properly installed.
 434 Correct by conducting a proper installation.
 435
 436 =item * print "# Needed module `$_' does not appear to be properly installed.\n";
 437
 438 One of the two modules that is used by perlivp was not present in the
 439 installation.  This is a serious error since it adversely affects perlivp's
 440 ability to function.  You may be able to correct this by performing a
 441 proper perl installation.
 442
 443 =item * print "# Required module `$_' does not appear to be properly installed.\n";
 444
 445 An attempt to C<eval "require $module"> failed, even though the list of
 446 extensions indicated that it should succeed.  Correct by conducting a proper
 447 installation.
 448
 449 =item * print "# Unnecessary module `bLuRfle' appears to be installed.\n";
 450
 451 This test not coming out ok could indicate that you have in fact installed
 452 a bLuRfle.pm module or that the C<eval " require \"$module_name.pm\"; ">
 453 test may give misleading results with your installation of perl.  If yours
 454 is the latter case then please let the author know.
 455
 456 =item * print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
 457
 458 One or more files turned up missing according to a run of
 459 C<ExtUtils::Installed -E<gt> validate()> over your installation.
 460 Correct by conducting a proper installation.
 461
 462 =item * print "# Perl header `$_' does not appear to be properly installed.\n";
 463
 464 Correct by running B<h2ph> over your system's C header files.  If necessary,
 465 edit the resulting *.ph files to eliminate perl syntax errors.
 466
 467 =back
 468
 469 For further information on how to conduct a proper installation consult the
 470 INSTALL file that comes with the perl source and the README file for your
 471 platform.
 472
 473 =head1 AUTHOR
 474
 475 Peter Prymmer
 476
 477 =cut
 478
 479 !NO!SUBS!
 480
 481 close OUT or die "Can't close $file: $!";
 482 chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
 483 exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
 484 chdir $origdir;
 485