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