filescript

   1 #!/usr/bin/perl -w
   2 ###APPNAME:     filescript
   3 ###APPAUTHOR:   xiaoranzzz
   4 ###APPDATE:     2009-06-19 22:41:01
   5 ###APPVER:      0.1
   6 ###APPDESC:     filescript
   7 ###APPUSAGE:
   8 ###APPEXAMPLE:  filescript
   9 ###APPOPTION:
  10 use strict;
  11
  12 #ENV variable MUST be defined somewhere,
  13 #FOR perl to search modules from,
  14 #OR nothing will work
  15 use lib $ENV{XR_PERL_MODULE_DIR};
  16
  17 use MyPlace::Script::Usage qw/help_required help_even_empty/;
  18 exit 0 if(help_required($0,@ARGV));
  19 #exit 0 if(help_even_empty($0,@ARGV));
  20
  21 my @blocks;
  22
  23 sub new_block {
  24     return {
  25         '+'=>[],
  26         '-'=>[],
  27         "<"=>[],
  28         '>'=>shift,
  29         "@"=>[],
  30         "#"=>[],
  31     };
  32 }
  33 sub add_block {
  34     push @blocks,@_ if(@_);
  35     return new_block();
  36 }
  37 use constant {
  38     OPG_NULL=>0,
  39     OPG_TEXT_INPUT => 1,
  40     OPG_NEW_BLOCK => 2,
  41     OPG_COMMENT => 3,
  42     OPG_TEXT_END =>4,
  43     OPG_CMD=>5,
  44     OPG_ARGS=>6,
  45 };
  46 sub is_text_end {
  47     return 1 if($_[0] && substr($_[0],0,1) eq ">");
  48     return undef;
  49 }
  50 sub is_comment {
  51     return 1 if($_[0] && substr($_[0],0,1) eq "#");
  52     return undef;
  53 }
  54
  55 my $f = 0;
  56 my $newblock = new_block();
  57 my $lastop="";
  58 while(<>) {
  59     chomp;
  60     #CHECK BLOCK TEXT INPUT
  61     if($lastop eq '<') {
  62         if(substr($_,0,1) eq '>') {
  63             $_ = substr($_,1);
  64             $lastop = '>';
  65         }
  66         else {
  67             push @{$newblock->{text}},$_;
  68             next;
  69         }
  70     }
  71     s/^\s+//g;
  72     s/\s+$//g;
  73     next unless($_);
  74     #CHECK COMMENTS
  75     if(substr($_,0,1) eq '#') {
  76         push @{$newblock->{'#'}},$_;
  77         next;
  78     }
  79     my $line = $_;
  80     my @words;
  81     foreach(split(/\t+/,$line)) {
  82         if(/^([-\+><])(.+)$/) {
  83             push @words,$1,$2;
  84         }
  85         elsif(/^(.+)([-\+><])$/) {
  86             push @words,$1,$2;
  87         }
  88         else {
  89             push @words,$_;
  90         }
  91     }
  92     my $text_input="";
  93     foreach(@words) {
  94         if($lastop eq '<' and (!$_ eq '>') ) {
  95                 $text_input = "$text_input $_";
  96         }
  97         elsif($lastop eq '>') {
  98             $newblock->{'>'}=$_;
  99             $lastop = '@';
 100         }
 101         elsif($_ eq '>' || $_ eq '<' || $_ eq '+' || $_ eq '-') {
 102             $newblock = add_block($newblock) if($newblock->{'>'});
 103             $lastop = $_;
 104         }
 105         else {
 106             push @{$newblock->{$lastop}},$_;
 107         }
 108    }
 109    push @{$newblock->{'<'}},$text_input if($text_input);
 110 }
 111 add_block($newblock) if($newblock->{'>'});
 112 use Data::Dumper;
 113 #print STDERR Dumper($newblock),"\n";
 114 #print STDERR Dumper(\@blocks),"\n";
 115 #exit 0;
 116
 117 my $source=".";
 118 my $target=".";
 119 my %cmds = (
 120     "write"=>"write",
 121     "source"=>"source",
 122     "target"=>"target",
 123     "delete"=>"delete",
 124     "copy"=>"copy"
 125 );
 126 sub buildpath {
 127         my ($src,$name) = @_;
 128     return $src . "/" unless($name);
 129     $name =~ s/\\/\//g;
 130     return $src . "/$name";
 131 }
 132 sub buildsource {
 133         return buildpath($source,@_);
 134 }
 135 sub buildtarget {
 136         return buildpath($target,@_);
 137 }
 138 sub getarray0 {
 139     my $arr = shift;
 140     return undef unless(ref $arr);
 141     return undef unless(@{$arr});
 142     return $arr->[0];
 143 }
 144 sub selectfiles {
 145     my ($src,$include,$exclude) = @_;
 146     my @include_exp = @{$include};
 147     @include_exp = ("*") unless(@include_exp);
 148     my @exclude_exp = @{$exclude};
 149     my @in_files;
 150     my @ex_files;
 151     foreach(@include_exp) {
 152                 my $exp = buildpath($src,$_);
 153                 push @in_files,glob($exp);
 154     }
 155     foreach(@exclude_exp) {
 156                 push @ex_files,glob(buildpath($src,$_));
 157     }
 158     my @files;
 159     foreach my $file (@in_files) {
 160         my $f=0;
 161         foreach(@ex_files) {
 162             if($file eq $_) {
 163                 $f=1;
 164                 last;
 165             }
 166         }
 167         push @files,$file unless($f);
 168     }
 169     return @files;
 170 }
 171 sub cmd_target {
 172     my ($include,$exclude,$text,$arg) = @_;
 173     my $val = getarray0($include);
 174     if($val) {
 175                 $target = $val;
 176                 $target =~ s/\\/\//g;
 177                 $target =~ s/\/+$//g;
 178                 return 1;
 179     }
 180     else {
 181                 return undef;
 182     }
 183 }
 184 sub cmd_source {
 185     my ($include,$exclude,$text,$arg) = @_;
 186     my $val = getarray0($include);
 187     if($val) {
 188                 $source = $val;
 189                 $source =~ s/\\/\//g;
 190                 $source =~ s/\/+$//g;
 191                 return 1;
 192     }
 193     else {
 194                 return undef;
 195     }
 196 }
 197 sub cmd_write {
 198     my ($include,$exclude,$text,$arg) = @_;
 199     if($arg && @{$arg}) {
 200         my $dst = buildtarget($arg->[0]);
 201         print STDERR "Writing ",$dst," ...";
 202         open FO,">",$dst or return undef;
 203         print FO join("\n",@{$text}) or return undef;
 204         close FO;
 205         print STDERR "\t[OK]\n";
 206     }
 207     else {
 208         print STDOUT join("\n",@{$text});
 209     }
 210     return 1;
 211 }
 212 sub cmd_copy {
 213     die("No source set.\n") unless($source);
 214     my ($include,$exclude,$text,$arg) = @_;
 215     my @files = selectfiles($source,$include,$exclude);
 216     return undef unless(@files);
 217     my $dst = buildtarget(getarray0($arg));
 218     if(system("cp","-av",@files,$dst)==0) {
 219         return 1;
 220     }
 221     return undef;
 222 }
 223 sub cmd_delete {
 224     die("No target set.\n") unless($target);
 225     my ($include,$exclude,$text,$arg) = @_;
 226     my @files = selectfiles($target,$include,$exclude);
 227     return undef unless(@files);
 228     if(system("rm","-v",,"--",@files)==0) {
 229         return 1;
 230     }
 231     return undef;
 232 }
 233 foreach(@blocks) {
 234     my $abort_flag=1;
 235     my $cmd = $_->{'>'};
 236     next unless($cmd);
 237     if(substr($cmd,0,1) eq '_') {
 238                 $cmd = substr($cmd,1);
 239                 $abort_flag=0;
 240     }
 241     if($cmds{$cmd}) {
 242                 my $realcmd = "cmd_" . $cmds{$cmd};
 243                 no strict;
 244                 my $r = &$realcmd($_->{'+'},$_->{'-'},$_->{'<'},$_->{'@'});
 245                 if($abort_flag and (!$r)) {
 246                         print STDERR "Error occured when running \'$cmd\'\n";
 247                         die("Abort!\n");
 248                 };
 249     }
 250     else {
 251                 die("Command not support:$cmd\n");
 252     }
 253 }
 254
 255
 256
 257
 258
 259
 260