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