lib/ExtUtils/Command.pm

   1 package ExtUtils::Command;
   2
   3 use 5.00503;
   4 use strict;
   5 use Carp;
   6 use File::Copy;
   7 use File::Compare;
   8 use File::Basename;
   9 use File::Path qw(rmtree);
  10 require Exporter;
  11 use vars qw(@ISA @EXPORT $VERSION);
  12 @ISA     = qw(Exporter);
  13 @EXPORT  = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f);
  14 $VERSION = '1.04';
  15
  16 my $Is_VMS = $^O eq 'VMS';
  17
  18 =head1 NAME
  19
  20 ExtUtils::Command - utilities to replace common UNIX commands in Makefiles etc.
  21
  22 =head1 SYNOPSIS
  23
  24   perl -MExtUtils::Command -e cat files... > destination
  25   perl -MExtUtils::Command -e mv source... destination
  26   perl -MExtUtils::Command -e cp source... destination
  27   perl -MExtUtils::Command -e touch files...
  28   perl -MExtUtils::Command -e rm_f file...
  29   perl -MExtUtils::Command -e rm_rf directories...
  30   perl -MExtUtils::Command -e mkpath directories...
  31   perl -MExtUtils::Command -e eqtime source destination
  32   perl -MExtUtils::Command -e chmod mode files...
  33   perl -MExtUtils::Command -e test_f file
  34
  35 =head1 DESCRIPTION
  36
  37 The module is used to replace common UNIX commands.  In all cases the
  38 functions work from @ARGV rather than taking arguments.  This makes
  39 them easier to deal with in Makefiles.
  40
  41   perl -MExtUtils::Command -e some_command some files to work on
  42
  43 I<NOT>
  44
  45   perl -MExtUtils::Command -e 'some_command qw(some files to work on)'
  46
  47 Filenames with * and ? will be glob expanded.
  48
  49 =over 4
  50
  51 =cut
  52
  53 # VMS uses % instead of ? to mean "one character"
  54 my $wild_regex = $Is_VMS ? '*%' : '*?';
  55 sub expand_wildcards
  56 {
  57  @ARGV = map(/[$wild_regex]/o ? glob($_) : $_,@ARGV);
  58 }
  59
  60 =item cat
  61
  62 Concatenates all files mentioned on command line to STDOUT.
  63
  64 =cut
  65
  66 sub cat ()
  67 {
  68  expand_wildcards();
  69  print while (<>);
  70 }
  71
  72 =item eqtime src dst
  73
  74 Sets modified time of dst to that of src
  75
  76 =cut
  77
  78 sub eqtime
  79 {
  80  my ($src,$dst) = @ARGV;
  81  open(F,">>$dst");
  82  close(F);
  83  utime((stat($src))[8,9],$dst);
  84 }
  85
  86 =item rm_rf files....
  87
  88 Removes directories - recursively (even if readonly)
  89
  90 =cut
  91
  92 sub rm_rf
  93 {
  94  expand_wildcards();
  95  rmtree([grep -e $_,@ARGV],0,0);
  96 }
  97
  98 =item rm_f files....
  99
 100 Removes files (even if readonly)
 101
 102 =cut
 103
 104 sub rm_f
 105 {
 106  expand_wildcards();
 107  foreach (@ARGV)
 108   {
 109    next unless -f $_;
 110    next if unlink($_);
 111    chmod(0777,$_);
 112    next if unlink($_);
 113    carp "Cannot delete $_:$!";
 114   }
 115 }
 116
 117 =item touch files ...
 118
 119 Makes files exist, with current timestamp
 120
 121 =cut
 122
 123 sub touch
 124 {
 125  my $t    = time;
 126  expand_wildcards();
 127  while (@ARGV)
 128   {
 129    my $file = shift(@ARGV);
 130    open(FILE,">>$file") || die "Cannot write $file:$!";
 131    close(FILE);
 132    utime($t,$t,$file);
 133   }
 134 }
 135
 136 =item mv source... destination
 137
 138 Moves source to destination.
 139 Multiple sources are allowed if destination is an existing directory.
 140
 141 =cut
 142
 143 sub mv
 144 {
 145  my $dst = pop(@ARGV);
 146  expand_wildcards();
 147  croak("Too many arguments") if (@ARGV > 1 && ! -d $dst);
 148  while (@ARGV)
 149   {
 150    my $src = shift(@ARGV);
 151    move($src,$dst);
 152   }
 153 }
 154
 155 =item cp source... destination
 156
 157 Copies source to destination.
 158 Multiple sources are allowed if destination is an existing directory.
 159
 160 =cut
 161
 162 sub cp
 163 {
 164  my $dst = pop(@ARGV);
 165  expand_wildcards();
 166  croak("Too many arguments") if (@ARGV > 1 && ! -d $dst);
 167  while (@ARGV)
 168   {
 169    my $src = shift(@ARGV);
 170    copy($src,$dst);
 171   }
 172 }
 173
 174 =item chmod mode files...
 175
 176 Sets UNIX like permissions 'mode' on all the files.
 177
 178 =cut
 179
 180 sub chmod
 181 {
 182  my $mode = shift(@ARGV);
 183  expand_wildcards();
 184  chmod($mode,@ARGV) || die "Cannot chmod ".join(' ',$mode,@ARGV).":$!";
 185 }
 186
 187 =item mkpath directory...
 188
 189 Creates directory, including any parent directories.
 190
 191 =cut
 192
 193 sub mkpath
 194 {
 195  expand_wildcards();
 196  File::Path::mkpath([@ARGV],0,0777);
 197 }
 198
 199 =item test_f file
 200
 201 Tests if a file exists
 202
 203 =cut
 204
 205 sub test_f
 206 {
 207  exit !-f shift(@ARGV);
 208 }
 209
 210
 211 1;
 212 __END__
 213
 214 =back
 215
 216 =head1 BUGS
 217
 218 Should probably be Auto/Self loaded.
 219
 220 =head1 SEE ALSO
 221
 222 ExtUtils::MakeMaker, ExtUtils::MM_Unix, ExtUtils::MM_Win32
 223
 224 =head1 AUTHOR
 225
 226 Nick Ing-Simmons <F<nick@ni-s.u-net.com>>.
 227
 228 =cut
 229