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 @EXPORT_OK $VERSION);
  12 @ISA       = qw(Exporter);
  13 @EXPORT    = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f chmod
  14                 dos2unix);
  15 $VERSION = '1.07';
  16
  17 my $Is_VMS = $^O eq 'VMS';
  18
  19 =head1 NAME
  20
  21 ExtUtils::Command - utilities to replace common UNIX commands in Makefiles etc.
  22
  23 =head1 SYNOPSIS
  24
  25   perl -MExtUtils::Command       -e cat files... > destination
  26   perl -MExtUtils::Command       -e mv source... destination
  27   perl -MExtUtils::Command       -e cp source... destination
  28   perl -MExtUtils::Command       -e touch files...
  29   perl -MExtUtils::Command       -e rm_f files...
  30   perl -MExtUtils::Command       -e rm_rf directories...
  31   perl -MExtUtils::Command       -e mkpath directories...
  32   perl -MExtUtils::Command       -e eqtime source destination
  33   perl -MExtUtils::Command       -e test_f file
  34   perl -MExtUtils::Command       -e chmod mode files...
  35   ...
  36
  37 =head1 DESCRIPTION
  38
  39 The module is used to replace common UNIX commands.  In all cases the
  40 functions work from @ARGV rather than taking arguments.  This makes
  41 them easier to deal with in Makefiles.
  42
  43   perl -MExtUtils::Command -e some_command some files to work on
  44
  45 I<NOT>
  46
  47   perl -MExtUtils::Command -e 'some_command qw(some files to work on)'
  48
  49 Filenames with * and ? will be glob expanded.
  50
  51 =over 4
  52
  53 =cut
  54
  55 # VMS uses % instead of ? to mean "one character"
  56 my $wild_regex = $Is_VMS ? '*%' : '*?';
  57 sub expand_wildcards
  58 {
  59  @ARGV = map(/[$wild_regex]/o ? glob($_) : $_,@ARGV);
  60 }
  61
  62
  63 =item cat
  64
  65 Concatenates all files mentioned on command line to STDOUT.
  66
  67 =cut
  68
  69 sub cat ()
  70 {
  71  expand_wildcards();
  72  print while (<>);
  73 }
  74
  75 =item eqtime src dst
  76
  77 Sets modified time of dst to that of src
  78
  79 =cut
  80
  81 sub eqtime
  82 {
  83  my ($src,$dst) = @ARGV;
  84  local @ARGV = ($dst);  touch();  # in case $dst doesn't exist
  85  utime((stat($src))[8,9],$dst);
  86 }
  87
  88 =item rm_rf files....
  89
  90 Removes directories - recursively (even if readonly)
  91
  92 =cut
  93
  94 sub rm_rf
  95 {
  96  expand_wildcards();
  97  rmtree([grep -e $_,@ARGV],0,0);
  98 }
  99
 100 =item rm_f files....
 101
 102 Removes files (even if readonly)
 103
 104 =cut
 105
 106 sub rm_f
 107 {
 108  expand_wildcards();
 109  foreach (@ARGV)
 110   {
 111    next unless -f $_;
 112    next if unlink($_);
 113    chmod(0777,$_);
 114    next if unlink($_);
 115    carp "Cannot delete $_:$!";
 116   }
 117 }
 118
 119 =item touch files ...
 120
 121 Makes files exist, with current timestamp
 122
 123 =cut
 124
 125 sub touch {
 126     my $t    = time;
 127     expand_wildcards();
 128     foreach my $file (@ARGV) {
 129         open(FILE,">>$file") || die "Cannot write $file:$!";
 130         close(FILE);
 131         utime($t,$t,$file);
 132     }
 133 }
 134
 135 =item mv source... destination
 136
 137 Moves source to destination.  Multiple sources are allowed if
 138 destination is an existing directory.
 139
 140 Returns true if all moves succeeded, false otherwise.
 141
 142 =cut
 143
 144 sub mv {
 145     expand_wildcards();
 146     my @src = @ARGV;
 147     my $dst = pop @src;
 148
 149     croak("Too many arguments") if (@src > 1 && ! -d $dst);
 150
 151     my $nok = 0;
 152     foreach my $src (@src) {
 153         $nok ||= !move($src,$dst);
 154     }
 155     return !$nok;
 156 }
 157
 158 =item cp source... destination
 159
 160 Copies source to destination.  Multiple sources are allowed if
 161 destination is an existing directory.
 162
 163 Returns true if all copies succeeded, false otherwise.
 164
 165 =cut
 166
 167 sub cp {
 168     expand_wildcards();
 169     my @src = @ARGV;
 170     my $dst = pop @src;
 171
 172     croak("Too many arguments") if (@src > 1 && ! -d $dst);
 173
 174     my $nok = 0;
 175     foreach my $src (@src) {
 176         $nok ||= !copy($src,$dst);
 177     }
 178     return $nok;
 179 }
 180
 181 =item chmod mode files...
 182
 183 Sets UNIX like permissions 'mode' on all the files.  e.g. 0666
 184
 185 =cut
 186
 187 sub chmod {
 188     local @ARGV = @ARGV;
 189     my $mode = shift(@ARGV);
 190     expand_wildcards();
 191     chmod(oct $mode,@ARGV) || die "Cannot chmod ".join(' ',$mode,@ARGV).":$!";
 192 }
 193
 194 =item mkpath directory...
 195
 196 Creates directory, including any parent directories.
 197
 198 =cut
 199
 200 sub mkpath
 201 {
 202  expand_wildcards();
 203  File::Path::mkpath([@ARGV],0,0777);
 204 }
 205
 206 =item test_f file
 207
 208 Tests if a file exists
 209
 210 =cut
 211
 212 sub test_f
 213 {
 214  exit !-f $ARGV[0];
 215 }
 216
 217 =item dos2unix
 218
 219 Converts DOS and OS/2 linefeeds to Unix style recursively.
 220
 221 =cut
 222
 223 sub dos2unix {
 224     require File::Find;
 225     File::Find::find(sub {
 226         return if -d;
 227         return unless -w _;
 228         return unless -r _;
 229         return if -B _;
 230
 231         local $\;
 232
 233         my $orig = $_;
 234         my $temp = '.dos2unix_tmp';
 235         open ORIG, $_ or do { warn "dos2unix can't open $_: $!"; return };
 236         open TEMP, ">$temp" or
 237             do { warn "dos2unix can't create .dos2unix_tmp: $!"; return };
 238         while (my $line = <ORIG>) {
 239             $line =~ s/\015\012/\012/g;
 240             print TEMP $line;
 241         }
 242         close ORIG;
 243         close TEMP;
 244         rename $temp, $orig;
 245
 246     }, @ARGV);
 247 }
 248
 249 =back
 250
 251 =head1 BUGS
 252
 253 Should probably be Auto/Self loaded.
 254
 255 =head1 SEE ALSO
 256
 257 ExtUtils::MakeMaker, ExtUtils::MM_Unix, ExtUtils::MM_Win32
 258
 259 =head1 AUTHOR
 260
 261 Nick Ing-Simmons C<ni-s@cpan.org>
 262
 263 Currently maintained by Michael G Schwern C<schwern@pobox.com>.
 264
 265 =cut
 266