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.bat < prev    next >
Encoding:
DOS Batch File  |  2003-11-16  |  2.0 KB  |  94 lines
  1. @rem = '--*-Perl-*--
  2. @echo off
  3. if "%OS%" == "Windows_NT" goto WinNT
  4. perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
  5. goto endofperl
  6. :WinNT
  7. perl -x -S %0 %*
  8. if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
  9. if %errorlevel% == 9009 echo You do not have Perl in your PATH.
  10. if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
  11. goto endofperl
  12. @rem ';
  13. #!/usr/bin/perl -w
  14. #line 15
  15.  
  16. use Archive::Tar;
  17. use File::Find;
  18.  
  19. $switches = shift @ARGV;
  20. $tarfile = "./default.tar";
  21. $create=0;
  22. $list=0;
  23. $extract=0;
  24. $debug=0;
  25.  
  26. if (!$switches) {
  27.     print<<EOF;
  28. usage: tar [xct][v][f][z] [archive_file] [files...]
  29.     x    Extract from archive_file
  30.     c    Make archive_file from files
  31.     t    Print contents of archive_file
  32.     f    First argument is name of archive_file, default is ./default.tar
  33.     v    Print filenames as they are added to archive_file
  34.     z    Read/write gnuzip-compressed archive_file (not always available)
  35. EOF
  36.     exit;
  37. }
  38.  
  39. foreach (split(//,$switches)) {
  40.     if ($_ eq "x") {
  41.     $extract = 1;
  42.     }
  43.     elsif ($_ eq "t") {
  44.     $list = 1;
  45.     }
  46.     elsif ($_ eq "c") {
  47.     $create = 1;
  48.     }
  49.     elsif ($_ eq "z") {
  50.     $compress = 1;
  51.     }
  52.     elsif ($_ eq "f") {
  53.     $tarfile = shift @ARGV;
  54.     }
  55.     elsif ($_ eq "v") {
  56.     $verbose = 1;
  57.     }
  58.     elsif ($_ eq "d") {
  59.     $debug = 1;
  60.     }
  61.     elsif ($_ eq "-") {
  62.     # Oh, a leading dash! How cute!
  63.     }
  64.     else {
  65.     warn "Unknown switch: $_\n";
  66.     }
  67. }
  68.  
  69. if ($extract+$list+$create>1) {
  70.     die "More than one of x, c and t doesn't make sense.\n";
  71. }
  72.  
  73. if ($list) {
  74.     $arc = Archive::Tar->new($tarfile,$compress);
  75.     print join "\n", $arc->list_files,"";
  76. }
  77.  
  78. if ($extract) {
  79.     $arc = Archive::Tar->new($tarfile,$compress);
  80.     $arc->extract($arc->list_files);
  81. }
  82.  
  83. if ($create) {
  84.     my @f;
  85.     
  86.     $arc = Archive::Tar->new();
  87.     finddepth(sub {push @f,$File::Find::name; print $File::Find::name,"\n" if $verbose},@ARGV);
  88.     $arc->add_files(@f);
  89.     $arc->write($tarfile,$compress);
  90. }
  91.  
  92. __END__
  93. :endofperl
  94.