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