home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / ptar < prev    next >
Encoding:
Text File  |  1998-07-28  |  1.5 KB  |  78 lines
  1. #!/usr/bin/perl -w
  2.  
  3. use Archive::Tar;
  4. use File::Find;
  5.  
  6. $switches = shift @ARGV;
  7. $tarfile = "./default.tar";
  8. $create=0;
  9. $list=0;
  10. $extract=0;
  11. $debug=0;
  12.  
  13. if (!$switches) {
  14.     print<<EOF;
  15. usage: tar [xct][v][f][z] [archive_file] [files...]
  16.     x    Extract from archive_file
  17.     c    Make archive_file from files
  18.     t    Print contents of archive_file
  19.     f    First argument is name of archive_file, default is ./default.tar
  20.     v    Print filenames as they are added to archive_file
  21.     z    Read/write gnuzip-compressed archive_file (not always available)
  22. EOF
  23.     exit;
  24. }
  25.  
  26. foreach (split(//,$switches)) {
  27.     if ($_ eq "x") {
  28.     $extract = 1;
  29.     }
  30.     elsif ($_ eq "t") {
  31.     $list = 1;
  32.     }
  33.     elsif ($_ eq "c") {
  34.     $create = 1;
  35.     }
  36.     elsif ($_ eq "z") {
  37.     $compress = 1;
  38.     }
  39.     elsif ($_ eq "f") {
  40.     $tarfile = shift @ARGV;
  41.     }
  42.     elsif ($_ eq "v") {
  43.     $verbose = 1;
  44.     }
  45.     elsif ($_ eq "d") {
  46.     $debug = 1;
  47.     }
  48.     elsif ($_ eq "-") {
  49.     # Oh, a leading dash! How cute!
  50.     }
  51.     else {
  52.     warn "Unknown switch: $_\n";
  53.     }
  54. }
  55.  
  56. if ($extract+$list+$create>1) {
  57.     die "More than one of x, c and t doesn't make sense.\n";
  58. }
  59.  
  60. if ($list) {
  61.     $arc = Archive::Tar->new($tarfile,$compress);
  62.     print join "\n", $arc->list_files,"";
  63. }
  64.  
  65. if ($extract) {
  66.     $arc = Archive::Tar->new($tarfile,$compress);
  67.     $arc->extract($arc->list_files);
  68. }
  69.  
  70. if ($create) {
  71.     my @f;
  72.     
  73.     $arc = Archive::Tar->new();
  74.     finddepth(sub {push @f,$File::Find::name; print $File::Find::name,"\n" if $verbose},@ARGV);
  75.     $arc->add_files(@f);
  76.     $arc->write($tarfile,$compress);
  77. }
  78.