1#!./perl -w
2
3BEGIN {
4    @INC = qw(lib);
5
6    # This needs to be at BEGIN time, before any use of Config
7    # install_lib itself loads and imports Config into main::
8    require './install_lib.pl';
9}
10
11use strict;
12
13use Getopt::Long;
14use ExtUtils::Packlist;
15use Pod::Man;
16our ( %opts, $packlist );
17
18require './Porting/pod_lib.pl';
19my %man1 = (map {($_->[0], $_->[1])} @{get_pod_metadata()->{master}});
20
21$ENV{SHELL} = 'sh' if $^O eq 'os2';
22
23my $patchlevel = substr($],3,2);
24die "Patchlevel of perl ($patchlevel)",
25    "and patchlevel of config.sh ($Config{'PERL_VERSION'}) don't match\n"
26	if $patchlevel != $Config{'PERL_VERSION'};
27
28my $usage =
29"Usage:  installman --man1dir=/usr/wherever --man1ext=1
30                   --man3dir=/usr/wherever --man3ext=3
31	           --notify --verbose --silent --help
32	Defaults are:
33	man1dir = $Config{'installman1dir'};
34	man1ext = $Config{'man1ext'};
35	man3dir = $Config{'installman3dir'};
36	man3ext = $Config{'man3ext'};
37	--notify  (or -n) just lists commands that would be executed.
38        --verbose (or -V) report all progress.
39        --silent  (or -S) be silent. Only report errors.\n";
40
41# --strip intentionally does nothing. By permitting installman to accept it
42# without error, the Makefile can pass the same options to installperl and
43# installman, which permits more simplification there than this comment costs.
44GetOptions( \%opts,
45            qw( man1dir=s man1ext=s man3dir=s man3ext=s
46                destdir:s notify|n help|h|? silent|S verbose|V strip))
47	|| die $usage;
48die $usage if $opts{help};
49$opts{destdir} //= '';
50
51foreach my $pre (qw(man1 man3)) {
52    $opts{"${pre}dir"} //= $opts{destdir} . $Config{"install${pre}dir"};
53    $opts{"${pre}ext"} //= $Config{"${pre}ext"};
54}
55$opts{verbose} ||= $opts{notify};
56
57# Explicitly disabled installation of man pages
58if ($opts{man1dir} eq '' && $opts{man3dir} eq '') {
59    warn "Manual page installation was disabled by Configure\n";
60    exit 0;
61}
62
63#Sanity checks
64
65-x  "./perl$Config{exe_ext}"
66  or warn "./perl$Config{exe_ext} not found!  Have you run make?\n";
67-d  "$opts{destdir}$Config{'installprivlib'}"
68	|| warn "Perl library directory $Config{'installprivlib'} not found.
69		Have you run make install?.  (Installing anyway.)\n";
70-x "t/perl$Config{exe_ext}"		|| warn "WARNING: You've never run 'make test'!!!",
71	"  (Installing anyway.)\n";
72
73$packlist = ExtUtils::Packlist->new("$opts{destdir}$Config{installarchlib}/.packlist");
74
75# Install the main pod pages.
76pod2man(\%man1, $opts{man1dir}, $opts{man1ext}, 'pod');
77
78# Install the pods for library modules.
79if ($opts{man3dir} ne '') {
80    my $found = pods_to_install();
81    pod2man($found->{$_}, $opts{man3dir}, $opts{man3ext}, 'lib')
82        foreach qw(MODULE PRAGMA);
83}
84
85# Install the pods embedded in the installed scripts
86if ($opts{man1dir} ne '') {
87    my $has_man1dir = -d $opts{man1dir};
88    my $fh = open_or_die('utils.lst');
89    while (<$fh>) {
90	next if /^#/;
91	chomp;
92	my ($path, $leaf) = m|^(\S*/(\S+))|;
93	# Have we already installed the manpage for this? (eg perldoc)
94	next if $man1{$leaf};
95	pod2man({$leaf, $path}, $opts{man1dir}, $opts{man1ext});
96	if ($has_man1dir) {
97	    if (my ($link) = m|#.*link\s*=\s*\S+/(\S+)|) {
98		my $old = "$opts{man1dir}/$leaf.$opts{man1ext}";
99		my $new = "$opts{man1dir}/$link.$opts{man1ext}";
100		unlink($new);
101		link($old, $new);
102		$old =~ s/^\Q$opts{destdir}\E// if $opts{destdir};
103		$new =~ s/^\Q$opts{destdir}\E// if $opts{destdir};
104		$packlist->{$new} = { from => $old, type => 'link' };
105	    }
106	}
107    }
108    close $fh or my_die("close 'utils.lst': $!");
109}
110
111sub pod2man {
112    my($modpods, $mandir, $manext, $where) = @_;
113    if ($mandir eq ' ' or $mandir eq '') {
114        if ($where) {
115            warn "Skipping installation of $where man pages.\n"
116        } else {
117            warn "Skipping installation of $_ man page.\n"
118                foreach values %$modpods;
119        }
120        return;
121    }
122
123    if ($opts{verbose}) {
124        if ($where) {
125            print "installing from $where\n";
126        } else {
127            print "installing $_\n"
128                foreach sort keys %$modpods;
129        }
130    }
131
132    mkpath($mandir);
133
134    foreach my $manpage (sort keys %$modpods) {
135        my $mod = $modpods->{$manpage};
136
137	# Skip files without pod docs
138	my $has_pod;
139        my $fh = open_or_die($mod);
140        while (my $line = <$fh>) {
141            if ($line =~ /^=head1\b/) {
142                ++$has_pod;
143                last;
144            }
145        }
146	close $fh or my_die("close '$mod': $!");
147        # Sadly it doesn't seem possible to re-use this handle for the call
148        # to parse_from_file() below, as Pod::Man relies on source_filename(),
149        # which Pod::Simple only sets accurately if it opens the file itself.
150
151	unless ($has_pod)
152	{
153	    print "no documentation in $mod\n" if $opts{verbose};
154	    next;
155	}
156
157	if ($^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'cygwin') {
158            $manpage =~ s#::#.#g;
159	}
160        my $tmp = "${mandir}/${manpage}.tmp";
161	$manpage = "${mandir}/${manpage}.${manext}";
162
163        my $parser = Pod::Man->new( section => $manext,
164                                    official=> 1,
165                                    center  => 'Perl Programmers Reference Guide'
166                                  );
167	my $xmanpage = $manpage;
168	$xmanpage =~ s/^\Q$opts{'destdir'}\E// if $opts{'destdir'};
169        print "  $xmanpage\n" unless $opts{silent};
170        if (!$opts{notify} && $parser->parse_from_file($mod, $tmp)) {
171            if (-s $tmp) {
172                # We've already emitted a progress message for this file, if
173                # needed, so ensure safe_rename() doesn't emit another one.
174                local $opts{silent} = 1;
175                if (safe_rename($tmp, $manpage)) {
176                    $packlist->{$xmanpage} = { type => 'file' };
177                    next;
178                }
179            }
180            unlink($tmp);
181	}
182    }
183}
184
185$packlist->write() unless $opts{notify};
186print "  Installation complete\n" if $opts{verbose};
187
188# ex: set ts=8 sts=4 sw=4 et:
189