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.05';
  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 files...
  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 test_f file
  33   perl -MExtUtils::Command=chmod -e chmod mode files...
  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
  61 =item cat
  62
  63 Concatenates all files mentioned on command line to STDOUT.
  64
  65 =cut
  66
  67 sub cat ()
  68 {
  69  expand_wildcards();
  70  print while (<>);
  71 }
  72
  73 =item eqtime src dst
  74
  75 Sets modified time of dst to that of src
  76
  77 =cut
  78
  79 sub eqtime
  80 {
  81  my ($src,$dst) = @ARGV;
  82  local @ARGV = ($dst);  touch();  # in case $dst doesn't exist
  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     my $t    = time;
 125     expand_wildcards();
 126     foreach my $file (@ARGV) {
 127         open(FILE,">>$file") || die "Cannot write $file:$!";
 128         close(FILE);
 129         utime($t,$t,$file);
 130     }
 131 }
 132
 133 =item mv source... destination
 134
 135 Moves source to destination.
 136 Multiple sources are allowed if destination is an existing directory.
 137
 138 =cut
 139
 140 sub mv {
 141     my $dst = pop(@ARGV);
 142     expand_wildcards();
 143     croak("Too many arguments") if (@ARGV > 1 && ! -d $dst);
 144     foreach my $src (@ARGV) {
 145         move($src,$dst);
 146     }
 147 }
 148
 149 =item cp source... destination
 150
 151 Copies source to destination.
 152 Multiple sources are allowed if destination is an existing directory.
 153
 154 =cut
 155
 156 sub cp {
 157     my $dst = pop(@ARGV);
 158     expand_wildcards();
 159     croak("Too many arguments") if (@ARGV > 1 && ! -d $dst);
 160     foreach my $src (@ARGV) {
 161         copy($src,$dst);
 162     }
 163 }
 164
 165 =item chmod mode files...
 166
 167 Sets UNIX like permissions 'mode' on all the files.  e.g. 0666
 168
 169 =cut
 170
 171 sub chmod {
 172     my $mode = shift(@ARGV);
 173     expand_wildcards();
 174     chmod(oct $mode,@ARGV) || die "Cannot chmod ".join(' ',$mode,@ARGV).":$!";
 175 }
 176
 177 =item mkpath directory...
 178
 179 Creates directory, including any parent directories.
 180
 181 =cut
 182
 183 sub mkpath
 184 {
 185  expand_wildcards();
 186  File::Path::mkpath([@ARGV],0,0777);
 187 }
 188
 189 =item test_f file
 190
 191 Tests if a file exists
 192
 193 =cut
 194
 195 sub test_f
 196 {
 197  exit !-f shift(@ARGV);
 198 }
 199
 200
 201 1;
 202 __END__
 203
 204 =back
 205
 206 =head1 BUGS
 207
 208 Should probably be Auto/Self loaded.
 209
 210 =head1 SEE ALSO
 211
 212 ExtUtils::MakeMaker, ExtUtils::MM_Unix, ExtUtils::MM_Win32
 213
 214 =head1 AUTHOR
 215
 216 Nick Ing-Simmons <F<nick@ni-s.u-net.com>>.
 217
 218 =cut
 219