home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 December (Special) / PCWorld_2005-12_Special_cd.bin / Bezpecnost / lsti / lsti.exe / framework-2.5.exe / Command.pm < prev    next >
Text File  |  2005-01-27  |  4KB  |  220 lines
  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.  
  220.