r-test

   1 #!/usr/bin/perl -w
   2 ###APPNAME:     r-test
   3 ###APPAUTHOR:   duel
   4 ###APPDATE:     2008-08-27 12:46:27
   5 ###APPVER:      0.1
   6 ###APPDESC:     test for CONDITIONS, if true perform ACTIONS on testing output
   7 ###APPUSAGE:    [Options] -if (COND) [-do (ACTION)]
   8 ###APPEXAMPLE:  r-test -key .c -if find /src/ -do echo
   9 ###APPOPTION:   -key (key):the key to test|-from-file (file):read options from file|-if (COND):support "find" "grep"|-do (ACTION):buildin actions are "rm" "mv" "cp" "echo"|-dest [text]:append text as arguments for action
  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 #use MyPlace::Script::Debug qw/dump_var/;
  19 exit 0 if(help_required($0,@ARGV));
  20 #exit 0 if(help_even_empty($0,@ARGV));
  21
  22 my $option_exp = qr/^(:?-key|-if|-do|-from-file|-dest)$/;
  23 my $mul_exp = qr/^(:?-key|-from-file|-dest)/;
  24 my $alias_exp = qr/^(:?-find|-grep|-move|-copy|-delete|-echo)$/;
  25 my %alias = (
  26     "-find"=>["-if","find"],
  27     "-grep"=>["-if","grep"],
  28     "-move"=>["-do","mv"],
  29     "-copy"=>["-do","cp"],
  30     "-echo"=>["-do","echo"]
  31 );
  32
  33 my @last_test;
  34 my @test_result;
  35
  36 sub getopt(@) {
  37     my @args = @_;
  38     my $opt_key = "";
  39     my %result;
  40     foreach my $opt(@args) {
  41         if($opt_key) {
  42             if($opt =~ $option_exp) {
  43                 $opt_key = $opt;
  44                 @{$result{$opt}}=() unless($opt =~ $mul_exp);
  45             }
  46             elsif($opt =~ $alias_exp) {
  47                 $opt_key = "";
  48                 redo;
  49             }
  50             else {
  51                 push @{$result{$opt_key}},$opt;
  52             }
  53         }
  54         else {
  55             if($opt =~ $option_exp) {
  56                 $opt_key = $opt;
  57                 if($opt !~ $mul_exp) {
  58                     @{$result{$opt}}=();
  59                 }
  60             }
  61             elsif ($opt =~ $alias_exp) {
  62                 ($opt_key,$opt) = @{$alias{$opt}};
  63                 redo;
  64             }
  65             else {
  66                 push @{$result{"default"}},$opt;
  67             }
  68         }
  69     }
  70     return \%result;
  71 }
  72
  73 sub do_if_key($$$$) {
  74     my @keys = @{ shift @_};
  75     my @conds = @{ shift @_};
  76     my @actions = @{ shift @_ };
  77     my @dests = @{ shift @_ };
  78
  79     my $action = @actions ? shift @actions : "echo";
  80     my $test = @conds ? shift @conds : "find";
  81     my @prev_act;
  82     my @post_act;
  83
  84     if($action eq "mv" or $action eq "cp") {
  85         my $dstdir = shift @actions;
  86         $dstdir = shift @dests if(@dests and !$dstdir);
  87         $dstdir = join("_",@keys) unless($dstdir);
  88         mkdir $dstdir unless(-d $dstdir);
  89         @prev_act = ($action,"-v","--");
  90         @post_act = ($dstdir);
  91     }
  92     elsif($action eq "rm") {
  93         @prev_act = ("rm","-v","--");
  94     }
  95     elsif($action eq "rmdir") {
  96         @prev_act = ("rm","-fdr");
  97     }
  98     else {
  99         push @prev_act,$action;
 100         my $post=0;
 101         foreach(@actions) {
 102             if($post) {
 103                 push @post_act,$_;
 104             }
 105             else {
 106                 if($_ eq '{}') {
 107                     $post = 1;
 108                 }
 109                 else {
 110                     push @prev_act,$_;
 111                 }
 112             }
 113         }
 114         push @post_act,@dests;
 115     }
 116     if($test eq "find") {
 117         foreach(@keys) {
 118             push @conds,"-iname","*$_*","-or";
 119         }
 120         pop @conds if(@keys);
 121     }
 122     elsif($test eq "grep") {
 123         my $pattern;
 124         foreach(@keys) {
 125             if($pattern) {
 126                 $pattern = $pattern . "|$_";
 127             }
 128             else {
 129                 $pattern = $_;
 130             }
 131         }
 132         push @conds,"-H","-q",$pattern;
 133     }
 134     print STDERR "Key:",join(" ",@keys);
 135     my @test_result = ();
 136     unless(open FI,"-|",$test,@conds) {
 137         print STDERR "\nCan't fork $test ",join(" ",@conds),"\n";
 138         return;
 139     }
 140     while(<FI>) {
 141         chomp;
 142         push @test_result,$_ if($_);
 143     }
 144     close FI;
 145     print STDERR " (",$#{test_result} + 1," matched)\n";
 146     system(@prev_act,$_,@post_act) foreach(@test_result);
 147 }
 148
 149 sub process(@) {
 150     my @PARGS = @_;
 151     my $options = &getopt(@PARGS);
 152     my @keys = $options->{"-key"} ? @{$options->{"-key"}} : ();
 153     my @conds = $options->{"-if"} ? @{$options->{"-if"}} : ();
 154     my @actions = $options->{"-do"} ? @{$options->{"-do"}} : ("echo");
 155     my @files = $options->{"-from-file"} ? @{$options->{"-from-file"}} : ();
 156     my @dests = $options->{"-dest"} ? @{$options->{"-dest"}} : ();
 157     #dump_var(\@_,$options,\@keys,\@conds,\@actions,\@dests,\@files);
 158
 159     if(@files) {
 160         foreach my $file(@files) {
 161             $file="/dev/stdin" if($file eq "-");
 162             if(!-e $file) {
 163                 print STDERR "File not exists:$file...\n";
 164                 next;
 165             }
 166             if(!open FI,"<",$file) {
 167                 print STDERR ("File not readable:$file...\n");
 168                 next;
 169             }
 170             print STDERR "From file : $file\n";
 171             my @LINES = <FI>;
 172             close FI;
 173             foreach(@LINES){
 174                 chomp;
 175                 my @args = split(" ",$_);
 176                 &process("-key",@keys,"-if",@conds,"-do",@actions,"-dest",@dests,@args) if(@args);
 177             }
 178         }
 179     }
 180     else {
 181         &do_if_key(\@keys,\@conds,\@actions,\@dests);
 182     }
 183 }
 184
 185 process(@ARGV);
 186