home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / perl / 5.8.8 / ExtUtils / Command / MM.pm
Encoding:
Perl POD Document  |  2006-07-07  |  6.0 KB  |  266 lines

  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;
  266.