lib/ExtUtils/Command.pm

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