[Summary view] [Print] [Text view]

   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 = '6.42';
  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      do {{  # so 'next' works
 121          my ($pod, $man) = splice(@ARGV, 0, 2);
 122  
 123          next if ((-e $man) &&
 124                   (-M $man < -M $pod) &&
 125                   (-M $man < -M "Makefile"));
 126  
 127          print "Manifying $man\n";
 128  
 129          my $parser = Pod::Man->new(%options);
 130          $parser->parse_from_file($pod, $man)
 131            or do { warn("Could not install $man\n");  next };
 132  
 133          if (length $options{perm_rw}) {
 134              chmod(oct($options{perm_rw}), $man)
 135                or do { warn("chmod $options{perm_rw} $man: $!\n"); next };
 136          }
 137      }} while @ARGV;
 138  
 139      return 1;
 140  }
 141  
 142  
 143  =item B<warn_if_old_packlist>
 144  
 145    perl "-MExtUtils::Command::MM" -e warn_if_old_packlist <somefile>
 146  
 147  Displays a warning that an old packlist file was found.  Reads the
 148  filename from @ARGV.
 149  
 150  =cut
 151  
 152  sub warn_if_old_packlist {
 153      my $packlist = $ARGV[0];
 154  
 155      return unless -f $packlist;
 156      print <<"PACKLIST_WARNING";
 157  WARNING: I have found an old package in
 158      $packlist.
 159  Please make sure the two installations are not conflicting
 160  PACKLIST_WARNING
 161  
 162  }
 163  
 164  
 165  =item B<perllocal_install>
 166  
 167      perl "-MExtUtils::Command::MM" -e perllocal_install 
 168          <type> <module name> <key> <value> ...
 169  
 170      # VMS only, key|value pairs come on STDIN
 171      perl "-MExtUtils::Command::MM" -e perllocal_install
 172          <type> <module name> < <key>|<value> ...
 173  
 174  Prints a fragment of POD suitable for appending to perllocal.pod.
 175  Arguments are read from @ARGV.
 176  
 177  'type' is the type of what you're installing.  Usually 'Module'.
 178  
 179  'module name' is simply the name of your module.  (Foo::Bar)
 180  
 181  Key/value pairs are extra information about the module.  Fields include:
 182  
 183      installed into      which directory your module was out into
 184      LINKTYPE            dynamic or static linking
 185      VERSION             module version number
 186      EXE_FILES           any executables installed in a space seperated 
 187                          list
 188  
 189  =cut
 190  
 191  sub perllocal_install {
 192      my($type, $name) = splice(@ARGV, 0, 2);
 193  
 194      # VMS feeds args as a piped file on STDIN since it usually can't
 195      # fit all the args on a single command line.
 196      @ARGV = split /\|/, <STDIN> if $Is_VMS;
 197  
 198      my $pod;
 199      $pod = sprintf <<POD, scalar localtime;
 200   =head2 %s: C<$type> L<$name|$name>
 201   
 202   =over 4
 203   
 204  POD
 205  
 206      do {
 207          my($key, $val) = splice(@ARGV, 0, 2);
 208  
 209          $pod .= <<POD
 210   =item *
 211   
 212   C<$key: $val>
 213   
 214  POD
 215  
 216      } while(@ARGV);
 217  
 218      $pod .= "=back\n\n";
 219      $pod =~ s/^ //mg;
 220      print $pod;
 221  
 222      return 1;
 223  }
 224  
 225  =item B<uninstall>
 226  
 227      perl "-MExtUtils::Command::MM" -e uninstall <packlist>
 228  
 229  A wrapper around ExtUtils::Install::uninstall().  Warns that
 230  uninstallation is deprecated and doesn't actually perform the
 231  uninstallation.
 232  
 233  =cut
 234  
 235  sub uninstall {
 236      my($packlist) = shift @ARGV;
 237  
 238      require ExtUtils::Install;
 239  
 240      print <<'WARNING';
 241  
 242  Uninstall is unsafe and deprecated, the uninstallation was not performed.
 243  We will show what would have been done.
 244  
 245  WARNING
 246  
 247      ExtUtils::Install::uninstall($packlist, 1, 1);
 248  
 249      print <<'WARNING';
 250  
 251  Uninstall is unsafe and deprecated, the uninstallation was not performed.
 252  Please check the list above carefully, there may be errors.
 253  Remove the appropriate files manually.
 254  Sorry for the inconvenience.
 255  
 256  WARNING
 257  
 258  }
 259  
 260  =back
 261  
 262  =cut
 263  
 264  1;