1#!/usr/local/bin/perl
2
3use Config;
4use File::Basename;
5use 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.
17my $origdir = cwd;
18chdir dirname($0);
19my $file = basename($0, '.PL');
20$file .= '.com' if $^O eq 'VMS';
21
22# Create output file.
23open OUT,">$file" or die "Can't create $file: $!";
24
25print "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
30print 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
38print OUT <<'!NO!SUBS!';
39
40# perlivp V 0.02
41
42
43sub usage {
44    warn "@_\n" if @_;
45    print << "    EOUSAGE";
46Usage:
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
60use 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
64while ($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
79my $pass__total = 0;
80my $error_total = 0;
81my $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.
87my $perlpath = '';
88if (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.
93my $useithreads = '';
94if (defined($Config{'useithreads'})) { $useithreads = $Config{'useithreads'}; }
95
96print OUT <<"!GROK!THIS!";
97my \$perlpath = '$perlpath';
98my \$useithreads = '$useithreads';
99!GROK!THIS!
100
101print OUT <<'!NO!SUBS!';
102
103print "## Checking Perl binary via variable `\$perlpath' = $perlpath.\n" if $opt{'p'};
104
105if (-x $perlpath) {
106    print "## Perl binary `$perlpath' appears executable.\n" if $opt{'v'};
107    print "ok 1\n";
108    $pass__total++;
109}
110else {
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
118print "## Checking Perl version via variable `\$]'.\n" if $opt{'p'};
119
120!NO!SUBS!
121
122print OUT <<"!GROK!THIS!";
123my \$ivp_VERSION = $];
124
125!GROK!THIS!
126print OUT <<'!NO!SUBS!';
127if ($ivp_VERSION eq $]) {
128    print "## Perl version `$]' appears installed as expected.\n" if $opt{'v'};
129    print "ok 2\n";
130    $pass__total++;
131}
132else {
133    print "# Perl version `$]' installed, expected $ivp_VERSION.\n";
134    print "not ok 2\n";
135    $error_total++;
136}
137$tests_total++;
138
139
140print "## Checking roots of the Perl library directory tree via variable `\@INC'.\n" if $opt{'p'};
141
142my $INC_total = 0;
143my $INC_there = 0;
144foreach (@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}
159if ($INC_total == $INC_there) {
160    print "ok 3\n";
161    $pass__total++;
162}
163else {
164    print "not ok 3\n";
165    $error_total++;
166}
167$tests_total++;
168
169
170print "## Checking installations of modules necessary for ivp.\n" if $opt{'p'};
171
172my $needed_total = 0;
173my $needed_there = 0;
174foreach (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}
187if ($needed_total == $needed_there) {
188    print "ok 4\n";
189    $pass__total++;
190}
191else {
192    print "not ok 4\n";
193    $error_total++;
194}
195$tests_total++;
196
197
198print "## Checking installations of extensions built with perl.\n" if $opt{'p'};
199
200use Config;
201
202my $extensions_total = 0;
203my $extensions_there = 0;
204if (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}
247if ($extensions_total == $extensions_there) {
248    print "ok 5\n";
249    $pass__total++;
250}
251else {
252    print "not ok 5\n";
253    $error_total++;
254}
255$tests_total++;
256
257
258print "## Checking installations of later additional extensions.\n" if $opt{'p'};
259
260use ExtUtils::Installed;
261
262my $installed_total = 0;
263my $installed_there = 0;
264my $version_check = 0;
265my $installed = ExtUtils::Installed -> new();
266my @modules = $installed -> modules();
267my @missing = ();
268my $version = undef;
269for (@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}
295if (($installed_total == $installed_there) &&
296    ($installed_total == $version_check)) {
297    print "ok 6\n";
298    $pass__total++;
299}
300else {
301    print "not ok 6\n";
302    $error_total++;
303}
304$tests_total++;
305
306
307if ($opt{'a'}) {
308print "## Checking installations of *.h -> *.ph header files.\n" if $opt{'p'};
309my $ph_there = 0;
310my $var = undef;
311my $val = undef;
312my $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).
315my @ph_files = qw(stdio.ph);
316# Add the ones that we know that perl thinks are there:
317while (($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)) {
335foreach (@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
348if (scalar(@ph_files) == $ph_there) {
349    print "ok 7\n";
350    $pass__total++;
351}
352else {
353    print "not ok 7\n";
354    $error_total++;
355}
356$tests_total++;
357}
358else {
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
366if ($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
379perlivp - Perl Installation Verification Procedure
380
381=head1 SYNOPSIS
382
383B<perlivp> [B<-a>] [B<-p>] [B<-v>] [B<-h>]
384
385=head1 DESCRIPTION
386
387The B<perlivp> program is set up at Perl source code build time to test the
388Perl 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
393libraries have been installed correctly.  A correct installation is verified
394by output that looks like:
395
396    ok 1
397    ok 2
398
399etc.
400
401=head1 OPTIONS
402
403=over 5
404
405=item B<-h> help
406
407Prints out a brief help message.
408
409=item B<-a> run all tests
410
411Normally tests for optional features are skipped.  With -a all tests
412are executed.
413
414=item B<-p> print preface
415
416Gives a description of each test prior to performing it.
417
418=item B<-v> verbose
419
420Gives more detailed information about each test, after it has been performed.
421Note that any failed tests ought to print out some extra information whether
422or 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
432Likely to occur for a perl binary that was not properly installed.
433Correct by conducting a proper installation.
434
435=item * print "# Perl version `$]' installed, expected $ivp_VERSION.\n";
436
437Likely to occur for a perl that was not properly installed.
438Correct by conducting a proper installation.
439
440=item * print "# Perl \@INC directory `$_' does not appear to exist.\n";
441
442Likely to occur for a perl library tree that was not properly installed.
443Correct by conducting a proper installation.
444
445=item * print "# Needed module `$_' does not appear to be properly installed.\n";
446
447One of the two modules that is used by perlivp was not present in the
448installation.  This is a serious error since it adversely affects perlivp's
449ability to function.  You may be able to correct this by performing a
450proper perl installation.
451
452=item * print "# Required module `$_' does not appear to be properly installed.\n";
453
454An attempt to C<eval "require $module"> failed, even though the list of
455extensions indicated that it should succeed.  Correct by conducting a proper
456installation.
457
458=item * print "# Unnecessary module `bLuRfle' appears to be installed.\n";
459
460This test not coming out ok could indicate that you have in fact installed
461a bLuRfle.pm module or that the C<eval " require \"$module_name.pm\"; ">
462test may give misleading results with your installation of perl.  If yours
463is the latter case then please let the author know.
464
465=item * print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
466
467One or more files turned up missing according to a run of
468C<ExtUtils::Installed -E<gt> validate()> over your installation.
469Correct by conducting a proper installation.
470
471=item * print "# Perl header `$_' does not appear to be properly installed.\n";
472
473Correct by running B<h2ph> over your system's C header files.  If necessary,
474edit the resulting *.ph files to eliminate perl syntax errors.
475
476=back
477
478For further information on how to conduct a proper installation consult the
479INSTALL file that comes with the perl source and the README file for your
480platform.
481
482=head1 AUTHOR
483
484Peter Prymmer
485
486=cut
487
488!NO!SUBS!
489
490close OUT or die "Can't close $file: $!";
491chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
492exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
493chdir $origdir;
494
495