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
36print OUT "\n# perlivp $^V\n";
37
38# In the following, perl variables are not expanded during extraction.
39
40print OUT <<'!NO!SUBS!';
41
42BEGIN { pop @INC if $INC[-1] eq '.' }
43
44sub usage {
45    warn "@_\n" if @_;
46    print << "    EOUSAGE";
47Usage:
48
49    $0 [-p] [-v] | [-h]
50
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 'HhPpVv' =~ /\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
105my $label = 'Executable perl binary';
106
107if (-x $perlpath) {
108    print "## Perl binary '$perlpath' appears executable.\n" if $opt{'v'};
109    print "ok 1 $label\n";
110    $pass__total++;
111}
112else {
113    print "# Perl binary '$perlpath' does not appear executable.\n";
114    print "not ok 1 $label\n";
115    $error_total++;
116}
117$tests_total++;
118
119
120print "## Checking Perl version via variable '\$]'.\n" if $opt{'p'};
121
122!NO!SUBS!
123
124print OUT <<"!GROK!THIS!";
125my \$ivp_VERSION = "$]";
126
127!GROK!THIS!
128print OUT <<'!NO!SUBS!';
129
130$label = 'Perl version correct';
131if ($ivp_VERSION eq $]) {
132    print "## Perl version '$]' appears installed as expected.\n" if $opt{'v'};
133    print "ok 2 $label\n";
134    $pass__total++;
135}
136else {
137    print "# Perl version '$]' installed, expected $ivp_VERSION.\n";
138    print "not ok 2 $label\n";
139    $error_total++;
140}
141$tests_total++;
142
143# We have the right perl and version, so now reset @INC so we ignore
144# PERL5LIB and '.'
145{
146    local $ENV{PERL5LIB};
147    my $perl_V = qx($perlpath -V);
148    $perl_V =~ s{.*\@INC:\n}{}ms;
149    @INC = grep { length && $_ ne '.' } split ' ', $perl_V;
150}
151
152print "## Checking roots of the Perl library directory tree via variable '\@INC'.\n" if $opt{'p'};
153
154my $INC_total = 0;
155my $INC_there = 0;
156foreach (@INC) {
157    next if $_ eq '.'; # skip -d test here
158    if (-d $_) {
159        print "## Perl \@INC directory '$_' exists.\n" if $opt{'v'};
160        $INC_there++;
161    }
162    else {
163        print "# Perl \@INC directory '$_' does not appear to exist.\n";
164    }
165    $INC_total++;
166}
167
168$label = '@INC directoreis exist';
169if ($INC_total == $INC_there) {
170    print "ok 3 $label\n";
171    $pass__total++;
172}
173else {
174    print "not ok 3 $label\n";
175    $error_total++;
176}
177$tests_total++;
178
179
180print "## Checking installations of modules necessary for ivp.\n" if $opt{'p'};
181
182my $needed_total = 0;
183my $needed_there = 0;
184foreach (qw(Config.pm ExtUtils/Installed.pm)) {
185    $@ = undef;
186    $needed_total++;
187    eval "require \"$_\";";
188    if (!$@) {
189        print "## Module '$_' appears to be installed.\n" if $opt{'v'};
190        $needed_there++;
191    }
192    else {
193        print "# Needed module '$_' does not appear to be properly installed.\n";
194    }
195    $@ = undef;
196}
197$label = 'Modules needed for rest of perlivp exist';
198if ($needed_total == $needed_there) {
199    print "ok 4 $label\n";
200    $pass__total++;
201}
202else {
203    print "not ok 4 $label\n";
204    $error_total++;
205}
206$tests_total++;
207
208
209print "## Checking installations of extensions built with perl.\n" if $opt{'p'};
210
211use Config;
212
213my $extensions_total = 0;
214my $extensions_there = 0;
215if (defined($Config{'extensions'})) {
216    my @extensions = split(/\s+/,$Config{'extensions'});
217    foreach (@extensions) {
218        next if ($_ eq '');
219        if ( $useithreads !~ /define/i ) {
220            next if ($_ eq 'threads');
221            next if ($_ eq 'threads/shared');
222        }
223        # that's a distribution name, not a module name
224        next if $_ eq 'IO/Compress';
225        next if $_ eq 'Devel/DProf';
226        next if $_ eq 'libnet';
227        next if $_ eq 'Locale/Codes';
228        next if $_ eq 'podlators';
229        next if $_ eq 'perlfaq';
230        # test modules
231        next if $_ eq 'XS/APItest';
232        next if $_ eq 'XS/Typemap';
233           # VMS$ perl  -e "eval ""require \""Devel/DProf.pm\"";"" print $@"
234           # \NT> perl  -e "eval \"require './Devel/DProf.pm'\"; print $@"
235           # DProf: run perl with -d to use DProf.
236           # Compilation failed in require at (eval 1) line 1.
237        eval " require \"$_.pm\"; ";
238        if (!$@) {
239            print "## Module '$_' appears to be installed.\n" if $opt{'v'};
240            $extensions_there++;
241        }
242        else {
243            print "# Required module '$_' does not appear to be properly installed.\n";
244            $@ = undef;
245        }
246        $extensions_total++;
247    }
248
249    # A silly name for a module (that hopefully won't ever exist).
250    # Note that this test serves more as a check of the validity of the
251    # actual required module tests above.
252    my $unnecessary = 'bLuRfle';
253
254    if (!grep(/$unnecessary/, @extensions)) {
255        $@ = undef;
256        eval " require \"$unnecessary.pm\"; ";
257        if ($@) {
258            print "## Unnecessary module '$unnecessary' does not appear to be installed.\n" if $opt{'v'};
259        }
260        else {
261            print "# Unnecessary module '$unnecessary' appears to be installed.\n";
262            $extensions_there++;
263        }
264    }
265    $@ = undef;
266}
267$label = 'All (and only) expected extensions installed';
268if ($extensions_total == $extensions_there) {
269    print "ok 5 $label\n";
270    $pass__total++;
271}
272else {
273    print "not ok 5 $label\n";
274    $error_total++;
275}
276$tests_total++;
277
278
279print "## Checking installations of later additional extensions.\n" if $opt{'p'};
280
281use ExtUtils::Installed;
282
283my $installed_total = 0;
284my $installed_there = 0;
285my $version_check = 0;
286my $installed = ExtUtils::Installed -> new();
287my @modules = $installed -> modules();
288my @missing = ();
289my $version = undef;
290for (@modules) {
291    $installed_total++;
292    # Consider it there if it contains one or more files,
293    # and has zero missing files,
294    # and has a defined version
295    $version = undef;
296    $version = $installed -> version($_);
297    if ($version) {
298        print "## $_; $version\n" if $opt{'v'};
299        $version_check++;
300    }
301    else {
302        print "# $_; NO VERSION\n" if $opt{'v'};
303    }
304    $version = undef;
305    @missing = ();
306    @missing = $installed -> validate($_);
307
308    # .bs files are optional
309    @missing = grep { ! /\.bs$/ } @missing;
310    # man files are often compressed
311    @missing = grep { ! ( -s "$_.gz" || -s "$_.bz2" ) } @missing;
312
313    if ($#missing >= 0) {
314        print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
315        print '# ',join(' ',@missing),"\n";
316    }
317    elsif ($#missing == -1) {
318        $installed_there++;
319    }
320    @missing = ();
321}
322$label = 'Module files correctly installed';
323if (($installed_total == $installed_there) &&
324    ($installed_total == $version_check)) {
325    print "ok 6 $label\n";
326    $pass__total++;
327}
328else {
329    print "not ok 6 $label\n";
330    $error_total++;
331}
332$tests_total++;
333
334# Final report (rather than feed ousrselves to Test::Harness::runtests()
335# we simply format some output on our own to keep things simple and
336# easier to "fix" - at least for now.
337
338if ($error_total == 0 && $tests_total) {
339    print "All tests successful.\n";
340} elsif ($tests_total==0){
341        die "FAILED--no tests were run for some reason.\n";
342} else {
343    my $rate = 0.0;
344    if ($tests_total > 0) { $rate = sprintf "%.2f", 100.0 * ($pass__total / $tests_total); }
345    printf " %d/%d subtests failed, %.2f%% okay.\n",
346                              $error_total, $tests_total, $rate;
347}
348
349=head1 NAME
350
351perlivp - Perl Installation Verification Procedure
352
353=head1 SYNOPSIS
354
355B<perlivp> [B<-p>] [B<-v>] [B<-h>]
356
357=head1 DESCRIPTION
358
359The B<perlivp> program is set up at Perl source code build time to test the
360Perl version it was built under.  It can be used after running:
361
362    make install
363
364(or your platform's equivalent procedure) to verify that B<perl> and its
365libraries have been installed correctly.  A correct installation is verified
366by output that looks like:
367
368    ok 1
369    ok 2
370
371etc.
372
373=head1 OPTIONS
374
375=over 5
376
377=item B<-h> help
378
379Prints out a brief help message.
380
381=item B<-p> print preface
382
383Gives a description of each test prior to performing it.
384
385=item B<-v> verbose
386
387Gives more detailed information about each test, after it has been performed.
388Note that any failed tests ought to print out some extra information whether
389or not -v is thrown.
390
391=back
392
393=head1 DIAGNOSTICS
394
395=over 4
396
397=item * print "# Perl binary '$perlpath' does not appear executable.\n";
398
399Likely to occur for a perl binary that was not properly installed.
400Correct by conducting a proper installation.
401
402=item * print "# Perl version '$]' installed, expected $ivp_VERSION.\n";
403
404Likely to occur for a perl that was not properly installed.
405Correct by conducting a proper installation.
406
407=item * print "# Perl \@INC directory '$_' does not appear to exist.\n";
408
409Likely to occur for a perl library tree that was not properly installed.
410Correct by conducting a proper installation.
411
412=item * print "# Needed module '$_' does not appear to be properly installed.\n";
413
414One of the two modules that is used by perlivp was not present in the
415installation.  This is a serious error since it adversely affects perlivp's
416ability to function.  You may be able to correct this by performing a
417proper perl installation.
418
419=item * print "# Required module '$_' does not appear to be properly installed.\n";
420
421An attempt to C<eval "require $module"> failed, even though the list of
422extensions indicated that it should succeed.  Correct by conducting a proper
423installation.
424
425=item * print "# Unnecessary module 'bLuRfle' appears to be installed.\n";
426
427This test not coming out ok could indicate that you have in fact installed
428a bLuRfle.pm module or that the C<eval " require \"$module_name.pm\"; ">
429test may give misleading results with your installation of perl.  If yours
430is the latter case then please let the author know.
431
432=item * print "# file",+($#missing == 0) ? '' : 's'," missing from installation:\n";
433
434One or more files turned up missing according to a run of
435C<ExtUtils::Installed -E<gt> validate()> over your installation.
436Correct by conducting a proper installation.
437
438=back
439
440For further information on how to conduct a proper installation consult the
441INSTALL file that comes with the perl source and the README file for your
442platform.
443
444=head1 AUTHOR
445
446Peter Prymmer
447
448=cut
449
450!NO!SUBS!
451
452close OUT or die "Can't close $file: $!";
453chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
454exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
455chdir $origdir;
456
457