1 | package ExtUtils::Command::MM;
|
---|
2 |
|
---|
3 | use strict;
|
---|
4 |
|
---|
5 | require 5.005_03;
|
---|
6 | require Exporter;
|
---|
7 | use vars qw($VERSION @ISA @EXPORT);
|
---|
8 | @ISA = qw(Exporter);
|
---|
9 |
|
---|
10 | @EXPORT = qw(test_harness pod2man perllocal_install uninstall
|
---|
11 | warn_if_old_packlist);
|
---|
12 | $VERSION = '0.05';
|
---|
13 |
|
---|
14 | my $Is_VMS = $^O eq 'VMS';
|
---|
15 |
|
---|
16 |
|
---|
17 | =head1 NAME
|
---|
18 |
|
---|
19 | ExtUtils::Command::MM - Commands for the MM's to use in Makefiles
|
---|
20 |
|
---|
21 | =head1 SYNOPSIS
|
---|
22 |
|
---|
23 | perl "-MExtUtils::Command::MM" -e "function" "--" arguments...
|
---|
24 |
|
---|
25 |
|
---|
26 | =head1 DESCRIPTION
|
---|
27 |
|
---|
28 | B<FOR INTERNAL USE ONLY!> The interface is not stable.
|
---|
29 |
|
---|
30 | ExtUtils::Command::MM encapsulates code which would otherwise have to
|
---|
31 | be done with large "one" liners.
|
---|
32 |
|
---|
33 | Any $(FOO) used in the examples are make variables, not Perl.
|
---|
34 |
|
---|
35 | =over 4
|
---|
36 |
|
---|
37 | =item B<test_harness>
|
---|
38 |
|
---|
39 | test_harness($verbose, @test_libs);
|
---|
40 |
|
---|
41 | Runs the tests on @ARGV via Test::Harness passing through the $verbose
|
---|
42 | flag. Any @test_libs will be unshifted onto the test's @INC.
|
---|
43 |
|
---|
44 | @test_libs are run in alphabetical order.
|
---|
45 |
|
---|
46 | =cut
|
---|
47 |
|
---|
48 | sub test_harness {
|
---|
49 | require Test::Harness;
|
---|
50 | require File::Spec;
|
---|
51 |
|
---|
52 | $Test::Harness::verbose = shift;
|
---|
53 |
|
---|
54 | # Because Windows doesn't do this for us and listing all the *.t files
|
---|
55 | # out on the command line can blow over its exec limit.
|
---|
56 | require ExtUtils::Command;
|
---|
57 | my @argv = ExtUtils::Command::expand_wildcards(@ARGV);
|
---|
58 |
|
---|
59 | local @INC = @INC;
|
---|
60 | unshift @INC, map { File::Spec->rel2abs($_) } @_;
|
---|
61 | Test::Harness::runtests(sort { lc $a cmp lc $b } @argv);
|
---|
62 | }
|
---|
63 |
|
---|
64 |
|
---|
65 |
|
---|
66 | =item B<pod2man>
|
---|
67 |
|
---|
68 | pod2man( '--option=value',
|
---|
69 | $podfile1 => $manpage1,
|
---|
70 | $podfile2 => $manpage2,
|
---|
71 | ...
|
---|
72 | );
|
---|
73 |
|
---|
74 | # or args on @ARGV
|
---|
75 |
|
---|
76 | pod2man() is a function performing most of the duties of the pod2man
|
---|
77 | program. Its arguments are exactly the same as pod2man as of 5.8.0
|
---|
78 | with the addition of:
|
---|
79 |
|
---|
80 | --perm_rw octal permission to set the resulting manpage to
|
---|
81 |
|
---|
82 | And the removal of:
|
---|
83 |
|
---|
84 | --verbose/-v
|
---|
85 | --help/-h
|
---|
86 |
|
---|
87 | If no arguments are given to pod2man it will read from @ARGV.
|
---|
88 |
|
---|
89 | =cut
|
---|
90 |
|
---|
91 | sub pod2man {
|
---|
92 | require Pod::Man;
|
---|
93 | require Getopt::Long;
|
---|
94 |
|
---|
95 | my %options = ();
|
---|
96 |
|
---|
97 | # We will cheat and just use Getopt::Long. We fool it by putting
|
---|
98 | # our arguments into @ARGV. Should be safe.
|
---|
99 | local @ARGV = @_ ? @_ : @ARGV;
|
---|
100 | Getopt::Long::config ('bundling_override');
|
---|
101 | Getopt::Long::GetOptions (\%options,
|
---|
102 | 'section|s=s', 'release|r=s', 'center|c=s',
|
---|
103 | 'date|d=s', 'fixed=s', 'fixedbold=s', 'fixeditalic=s',
|
---|
104 | 'fixedbolditalic=s', 'official|o', 'quotes|q=s', 'lax|l',
|
---|
105 | 'name|n=s', 'perm_rw:i'
|
---|
106 | );
|
---|
107 |
|
---|
108 | # If there's no files, don't bother going further.
|
---|
109 | return 0 unless @ARGV;
|
---|
110 |
|
---|
111 | # Official sets --center, but don't override things explicitly set.
|
---|
112 | if ($options{official} && !defined $options{center}) {
|
---|
113 | $options{center} = q[Perl Programmer's Reference Guide];
|
---|
114 | }
|
---|
115 |
|
---|
116 | # This isn't a valid Pod::Man option and is only accepted for backwards
|
---|
117 | # compatibility.
|
---|
118 | delete $options{lax};
|
---|
119 |
|
---|
120 | my $parser = Pod::Man->new(%options);
|
---|
121 |
|
---|
122 | do {{ # so 'next' works
|
---|
123 | my ($pod, $man) = splice(@ARGV, 0, 2);
|
---|
124 |
|
---|
125 | next if ((-e $man) &&
|
---|
126 | (-M $man < -M $pod) &&
|
---|
127 | (-M $man < -M "Makefile"));
|
---|
128 |
|
---|
129 | print "Manifying $man\n";
|
---|
130 |
|
---|
131 | $parser->parse_from_file($pod, $man)
|
---|
132 | or do { warn("Could not install $man\n"); next };
|
---|
133 |
|
---|
134 | if (length $options{perm_rw}) {
|
---|
135 | chmod(oct($options{perm_rw}), $man)
|
---|
136 | or do { warn("chmod $options{perm_rw} $man: $!\n"); next };
|
---|
137 | }
|
---|
138 | }} while @ARGV;
|
---|
139 |
|
---|
140 | return 1;
|
---|
141 | }
|
---|
142 |
|
---|
143 |
|
---|
144 | =item B<warn_if_old_packlist>
|
---|
145 |
|
---|
146 | perl "-MExtUtils::Command::MM" -e warn_if_old_packlist <somefile>
|
---|
147 |
|
---|
148 | Displays a warning that an old packlist file was found. Reads the
|
---|
149 | filename from @ARGV.
|
---|
150 |
|
---|
151 | =cut
|
---|
152 |
|
---|
153 | sub warn_if_old_packlist {
|
---|
154 | my $packlist = $ARGV[0];
|
---|
155 |
|
---|
156 | return unless -f $packlist;
|
---|
157 | print <<"PACKLIST_WARNING";
|
---|
158 | WARNING: I have found an old package in
|
---|
159 | $packlist.
|
---|
160 | Please make sure the two installations are not conflicting
|
---|
161 | PACKLIST_WARNING
|
---|
162 |
|
---|
163 | }
|
---|
164 |
|
---|
165 |
|
---|
166 | =item B<perllocal_install>
|
---|
167 |
|
---|
168 | perl "-MExtUtils::Command::MM" -e perllocal_install
|
---|
169 | <type> <module name> <key> <value> ...
|
---|
170 |
|
---|
171 | # VMS only, key|value pairs come on STDIN
|
---|
172 | perl "-MExtUtils::Command::MM" -e perllocal_install
|
---|
173 | <type> <module name> < <key>|<value> ...
|
---|
174 |
|
---|
175 | Prints a fragment of POD suitable for appending to perllocal.pod.
|
---|
176 | Arguments are read from @ARGV.
|
---|
177 |
|
---|
178 | 'type' is the type of what you're installing. Usually 'Module'.
|
---|
179 |
|
---|
180 | 'module name' is simply the name of your module. (Foo::Bar)
|
---|
181 |
|
---|
182 | Key/value pairs are extra information about the module. Fields include:
|
---|
183 |
|
---|
184 | installed into which directory your module was out into
|
---|
185 | LINKTYPE dynamic or static linking
|
---|
186 | VERSION module version number
|
---|
187 | EXE_FILES any executables installed in a space seperated
|
---|
188 | list
|
---|
189 |
|
---|
190 | =cut
|
---|
191 |
|
---|
192 | sub perllocal_install {
|
---|
193 | my($type, $name) = splice(@ARGV, 0, 2);
|
---|
194 |
|
---|
195 | # VMS feeds args as a piped file on STDIN since it usually can't
|
---|
196 | # fit all the args on a single command line.
|
---|
197 | @ARGV = split /\|/, <STDIN> if $Is_VMS;
|
---|
198 |
|
---|
199 | my $pod;
|
---|
200 | $pod = sprintf <<POD, scalar localtime;
|
---|
201 | =head2 %s: C<$type> L<$name|$name>
|
---|
202 |
|
---|
203 | =over 4
|
---|
204 |
|
---|
205 | POD
|
---|
206 |
|
---|
207 | do {
|
---|
208 | my($key, $val) = splice(@ARGV, 0, 2);
|
---|
209 |
|
---|
210 | $pod .= <<POD
|
---|
211 | =item *
|
---|
212 |
|
---|
213 | C<$key: $val>
|
---|
214 |
|
---|
215 | POD
|
---|
216 |
|
---|
217 | } while(@ARGV);
|
---|
218 |
|
---|
219 | $pod .= "=back\n\n";
|
---|
220 | $pod =~ s/^ //mg;
|
---|
221 | print $pod;
|
---|
222 |
|
---|
223 | return 1;
|
---|
224 | }
|
---|
225 |
|
---|
226 | =item B<uninstall>
|
---|
227 |
|
---|
228 | perl "-MExtUtils::Command::MM" -e uninstall <packlist>
|
---|
229 |
|
---|
230 | A wrapper around ExtUtils::Install::uninstall(). Warns that
|
---|
231 | uninstallation is deprecated and doesn't actually perform the
|
---|
232 | uninstallation.
|
---|
233 |
|
---|
234 | =cut
|
---|
235 |
|
---|
236 | sub uninstall {
|
---|
237 | my($packlist) = shift @ARGV;
|
---|
238 |
|
---|
239 | require ExtUtils::Install;
|
---|
240 |
|
---|
241 | print <<'WARNING';
|
---|
242 |
|
---|
243 | Uninstall is unsafe and deprecated, the uninstallation was not performed.
|
---|
244 | We will show what would have been done.
|
---|
245 |
|
---|
246 | WARNING
|
---|
247 |
|
---|
248 | ExtUtils::Install::uninstall($packlist, 1, 1);
|
---|
249 |
|
---|
250 | print <<'WARNING';
|
---|
251 |
|
---|
252 | Uninstall is unsafe and deprecated, the uninstallation was not performed.
|
---|
253 | Please check the list above carefully, there may be errors.
|
---|
254 | Remove the appropriate files manually.
|
---|
255 | Sorry for the inconvenience.
|
---|
256 |
|
---|
257 | WARNING
|
---|
258 |
|
---|
259 | }
|
---|
260 |
|
---|
261 | =back
|
---|
262 |
|
---|
263 | =cut
|
---|
264 |
|
---|
265 | 1;
|
---|