zipfolder

   1 #!/usr/bin/perl -w
   2 ###APPNAME:     zipfolder
   3 ###APPAUTHOR:   xiaoranzzz
   4 ###APPDATE:     Wed Oct 17 07:51:57 2007
   5 ###APPVER:      0.1
   6 ###APPDESC:     Packup a folder as a zip file,with pathname excluded.
   7 ###APPUSAGE:    [OPTIONS] (Directories...)
   8 ###APPOPTION:   -m [0-9]:Compress Level|-d:Delete directory after successful zipped|-e:Ext Name
   9 ###APPEXAMPLE:  zipfolder -d -m9 -e .zip music/ pictures/\n\tzipfolder music/ pictures
  10 use strict;
  11 use Getopt::Std;
  12 use File::Glob qw/bsd_glob/;
  13 use lib $ENV{XR_PERL_MODULE_DIR};
  14 use MyPlace::Script::Usage qw/help_even_empty format_help/;
  15
  16 exit 0 if(help_even_empty($0,@ARGV));
  17
  18 my $OptFlag='hdm:e:';
  19 my %OPT;
  20 exit(format_help $0) unless(getopts($OptFlag,\%OPT));
  21
  22 my $lvl = $OPT{m};
  23 $lvl = 5 if((!defined $lvl) or $lvl<0 or $lvl>9);
  24 my $do_unlink = $OPT{d} ? 1 : 0;
  25 my $ext = $OPT{e} ? $OPT{e} : ".zip";
  26 my @dirs;
  27 foreach(@ARGV) {
  28     foreach(bsd_glob($_)) {
  29     if(-d $_) {
  30         push(@dirs,$_);
  31         next;
  32     }
  33     print STDERR ("\"$_\" Ingored\n");
  34     }
  35 }
  36 die("Nothing to do\n") unless(@dirs);
  37
  38 my $USER=$ENV{USER} || "xiaoranzzz";
  39 my $HOSTNAME=`hostname` || "myplace.hell";
  40 my $MACHINE=`uname -omsr` || "windows";
  41 my $DATE =  localtime;
  42 my $COMMENT="Creator  :  $USER\n" .
  43             "Host     :  $HOSTNAME" .
  44             "Machine  :  $MACHINE" .
  45             "Date     :  $DATE";
  46
  47 my $ZIPPROGRAM="zip -Xrz";
  48
  49 sub resetLine {
  50     print "\r" . " "x50;
  51     print "\r";
  52 }
  53 sub dosys {
  54     return system(@_);
  55 }
  56
  57 use Cwd qw/cwd/;
  58 use File::Spec::Functions;
  59
  60 my $pwd=cwd();
  61
  62
  63 foreach my $idx(0 .. $#dirs) {
  64     my $src = $dirs[$idx];
  65     chdir($pwd) or die("$!\n");
  66     my $bn=$src;
  67     $bn =~ s/[\/\\]$|^.*[\/\\]//g;
  68     $bn .= $ext;
  69     my $fn= File::Spec->rel2abs($src,$pwd) . $ext;
  70     my $comment="Filename  : $bn\n" . $COMMENT;
  71     print("$src->$bn\n$comment");
  72     if(!chdir($src)) {print STDERR ("$!\n");next;}
  73
  74     open ZIPP,"|-","$ZIPPROGRAM -$lvl \"$fn\" ." or die("$!\n");
  75     print ZIPP ($comment);
  76     close ZIPP;
  77
  78     if(-f $fn) {
  79         resetLine;
  80         print("[",$idx+1,"/",$#dirs+1,"] \"$src\"->\"$bn\" [Done]\n");
  81         if($do_unlink) {
  82             chdir($pwd);
  83             print("Deleting \"$src\" ...");
  84             if(dosys("rm","-fdr","--",$src)==0) {
  85                 resetLine;
  86                 print("Deleting \"$src\" [OK]\n");
  87             }
  88             else {
  89                 resetLine;
  90                 print("Deleting \"$src\" [Failed]\n");
  91             }
  92         }
  93     }
  94     else {
  95         resetLine;
  96         print("\"$src\"->\"$bn\" [Failed]\n");
  97     }
  98 }
  99
 100
 101