1N/Apackage ExtUtils::Command::MM;
1N/A
1N/Ause strict;
1N/A
1N/Arequire 5.005_03;
1N/Arequire Exporter;
1N/Ause vars qw($VERSION @ISA @EXPORT);
1N/A@ISA = qw(Exporter);
1N/A
1N/A@EXPORT = qw(test_harness pod2man perllocal_install uninstall
1N/A warn_if_old_packlist);
1N/A$VERSION = '0.03';
1N/A
1N/Amy $Is_VMS = $^O eq 'VMS';
1N/A
1N/A=head1 NAME
1N/A
1N/AExtUtils::Command::MM - Commands for the MM's to use in Makefiles
1N/A
1N/A=head1 SYNOPSIS
1N/A
1N/A perl "-MExtUtils::Command::MM" -e "function" "--" arguments...
1N/A
1N/A
1N/A=head1 DESCRIPTION
1N/A
1N/AB<FOR INTERNAL USE ONLY!> The interface is not stable.
1N/A
1N/AExtUtils::Command::MM encapsulates code which would otherwise have to
1N/Abe done with large "one" liners.
1N/A
1N/AAny $(FOO) used in the examples are make variables, not Perl.
1N/A
1N/A=over 4
1N/A
1N/A=item B<test_harness>
1N/A
1N/A test_harness($verbose, @test_libs);
1N/A
1N/ARuns the tests on @ARGV via Test::Harness passing through the $verbose
1N/Aflag. Any @test_libs will be unshifted onto the test's @INC.
1N/A
1N/A@test_libs are run in alphabetical order.
1N/A
1N/A=cut
1N/A
1N/Asub test_harness {
1N/A require Test::Harness;
1N/A require File::Spec;
1N/A
1N/A $Test::Harness::verbose = shift;
1N/A
1N/A local @INC = @INC;
1N/A unshift @INC, map { File::Spec->rel2abs($_) } @_;
1N/A Test::Harness::runtests(sort { lc $a cmp lc $b } @ARGV);
1N/A}
1N/A
1N/A
1N/A
1N/A=item B<pod2man>
1N/A
1N/A pod2man( '--option=value',
1N/A $podfile1 => $manpage1,
1N/A $podfile2 => $manpage2,
1N/A ...
1N/A );
1N/A
1N/A # or args on @ARGV
1N/A
1N/Apod2man() is a function performing most of the duties of the pod2man
1N/Aprogram. Its arguments are exactly the same as pod2man as of 5.8.0
1N/Awith the addition of:
1N/A
1N/A --perm_rw octal permission to set the resulting manpage to
1N/A
1N/AAnd the removal of:
1N/A
1N/A --verbose/-v
1N/A --help/-h
1N/A
1N/AIf no arguments are given to pod2man it will read from @ARGV.
1N/A
1N/A=cut
1N/A
1N/Asub pod2man {
1N/A require Pod::Man;
1N/A require Getopt::Long;
1N/A
1N/A my %options = ();
1N/A
1N/A # We will cheat and just use Getopt::Long. We fool it by putting
1N/A # our arguments into @ARGV. Should be safe.
1N/A local @ARGV = @_ ? @_ : @ARGV;
1N/A Getopt::Long::config ('bundling_override');
1N/A Getopt::Long::GetOptions (\%options,
1N/A 'section|s=s', 'release|r=s', 'center|c=s',
1N/A 'date|d=s', 'fixed=s', 'fixedbold=s', 'fixeditalic=s',
1N/A 'fixedbolditalic=s', 'official|o', 'quotes|q=s', 'lax|l',
1N/A 'name|n=s', 'perm_rw:i'
1N/A );
1N/A
1N/A # If there's no files, don't bother going further.
1N/A return 0 unless @ARGV;
1N/A
1N/A # Official sets --center, but don't override things explicitly set.
1N/A if ($options{official} && !defined $options{center}) {
1N/A $options{center} = 'Perl Programmers Reference Guide';
1N/A }
1N/A
1N/A # This isn't a valid Pod::Man option and is only accepted for backwards
1N/A # compatibility.
1N/A delete $options{lax};
1N/A
1N/A my $parser = Pod::Man->new(%options);
1N/A
1N/A do {{ # so 'next' works
1N/A my ($pod, $man) = splice(@ARGV, 0, 2);
1N/A
1N/A next if ((-e $man) &&
1N/A (-M $man < -M $pod) &&
1N/A (-M $man < -M "Makefile"));
1N/A
1N/A print "Manifying $man\n";
1N/A
1N/A $parser->parse_from_file($pod, $man)
1N/A or do { warn("Could not install $man\n"); next };
1N/A
1N/A if (length $options{perm_rw}) {
1N/A chmod(oct($options{perm_rw}), $man)
1N/A or do { warn("chmod $options{perm_rw} $man: $!\n"); next };
1N/A }
1N/A }} while @ARGV;
1N/A
1N/A return 1;
1N/A}
1N/A
1N/A
1N/A=item B<warn_if_old_packlist>
1N/A
1N/A perl "-MExtUtils::Command::MM" -e warn_if_old_packlist <somefile>
1N/A
1N/ADisplays a warning that an old packlist file was found. Reads the
1N/Afilename from @ARGV.
1N/A
1N/A=cut
1N/A
1N/Asub warn_if_old_packlist {
1N/A my $packlist = $ARGV[0];
1N/A
1N/A return unless -f $packlist;
1N/A print <<"PACKLIST_WARNING";
1N/AWARNING: I have found an old package in
1N/A $packlist.
1N/APlease make sure the two installations are not conflicting
1N/APACKLIST_WARNING
1N/A
1N/A}
1N/A
1N/A
1N/A=item B<perllocal_install>
1N/A
1N/A perl "-MExtUtils::Command::MM" -e perllocal_install
1N/A <type> <module name> <key> <value> ...
1N/A
1N/A # VMS only, key/value pairs come on STDIN
1N/A perl "-MExtUtils::Command::MM" -e perllocal_install
1N/A <type> <module name> < <key> <value> ...
1N/A
1N/APrints a fragment of POD suitable for appending to perllocal.pod.
1N/AArguments are read from @ARGV.
1N/A
1N/A'type' is the type of what you're installing. Usually 'Module'.
1N/A
1N/A'module name' is simply the name of your module. (Foo::Bar)
1N/A
1N/AKey/value pairs are extra information about the module. Fields include:
1N/A
1N/A installed into which directory your module was out into
1N/A LINKTYPE dynamic or static linking
1N/A VERSION module version number
1N/A EXE_FILES any executables installed in a space seperated
1N/A list
1N/A
1N/A=cut
1N/A
1N/Asub perllocal_install {
1N/A my($type, $name) = splice(@ARGV, 0, 2);
1N/A
1N/A # VMS feeds args as a piped file on STDIN since it usually can't
1N/A # fit all the args on a single command line.
1N/A @ARGV = split /\|/, <STDIN> if $Is_VMS;
1N/A
1N/A my $pod;
1N/A $pod = sprintf <<POD, scalar localtime;
1N/A =head2 %s: C<$type> L<$name|$name>
1N/A
1N/A =over 4
1N/A
1N/APOD
1N/A
1N/A do {
1N/A my($key, $val) = splice(@ARGV, 0, 2);
1N/A
1N/A $pod .= <<POD
1N/A =item *
1N/A
1N/A C<$key: $val>
1N/A
1N/APOD
1N/A
1N/A } while(@ARGV);
1N/A
1N/A $pod .= "=back\n\n";
1N/A $pod =~ s/^ //mg;
1N/A print $pod;
1N/A
1N/A return 1;
1N/A}
1N/A
1N/A=item B<uninstall>
1N/A
1N/A perl "-MExtUtils::Command::MM" -e uninstall <packlist>
1N/A
1N/AA wrapper around ExtUtils::Install::uninstall(). Warns that
1N/Auninstallation is deprecated and doesn't actually perform the
1N/Auninstallation.
1N/A
1N/A=cut
1N/A
1N/Asub uninstall {
1N/A my($packlist) = shift;
1N/A
1N/A require ExtUtils::Install;
1N/A
1N/A print <<'WARNING';
1N/A
1N/AUninstall is unsafe and deprecated, the uninstallation was not performed.
1N/AWe will show what would have been done.
1N/A
1N/AWARNING
1N/A
1N/A ExtUtils::Install::uninstall($packlist, 1, 1);
1N/A
1N/A print <<'WARNING';
1N/A
1N/AUninstall is unsafe and deprecated, the uninstallation was not performed.
1N/APlease check the list above carefully, there may be errors.
1N/ARemove the appropriate files manually.
1N/ASorry for the inconvenience.
1N/A
1N/AWARNING
1N/A
1N/A}
1N/A
1N/A=back
1N/A
1N/A=cut
1N/A
1N/A1;