lib/ExtUtils/Command.pm

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