added inscript test to selected commands

[spider.git] / perl / Script.pm

diff --git a/perl/Script.pm b/perl/Script.pm
index 276aae5d3c32b7007fc2080b46da12f2f3e9ab1f..24593aee92fa22e85b436a2efca7c134b467cdc3 100644 (file)
--- a/perl/Script.pm
+++ b/perl/Script.pm
@@ -19,16 +19,23 @@ use IO::File;
 
 use vars qw($VERSION $BRANCH);
 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
-$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
+$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
 $main::build += $VERSION;
 $main::branch += $BRANCH;
 
 my $base = "$main::root/scripts";
 
+sub clean
+{
+       my $s = shift;
+       $s =~ s/[^-\w\.]//g;
+       return $s;
+}
+
 sub new
 {
        my $pkg = shift;
-       my $script = shift;
+       my $script = clean(lc shift);
        my $fn = "$base/$script";
 
        my $fh = new IO::File $fn;
@@ -41,7 +48,7 @@ sub new
        }
        $fh->close;
        $self->{lines} = \@lines;
-       return $self;
+       return bless $self, $pkg;
 }
 
 sub run
@@ -50,12 +57,47 @@ sub run
        my $dxchan = shift;
        foreach my $l (@{$self->{lines}}) {
                unless ($l =~ /^\s*\#/ || $l =~ /^\s*$/) {
+                       $dxchan->inscript(1);
                        my @out = DXCommandmode::run_cmd($dxchan, $l);
+                       $dxchan->inscript(0);
                        if ($dxchan->can('send_ans')) {
                                $dxchan->send_ans(@out);
                        } else {
                                dbg($_) for @out;
                        }
+                       last if @out && $l =~ /^pri?v?/i;
                }
        }
 }
+
+sub store
+{
+       my $call = clean(lc shift);
+       my @out;
+       my $ref = ref $_[0] ? shift : \@_;
+       my $count;
+       my $fn = "$base/$call";
+
+    rename $fn, "$fn.o" if -e $fn;
+       my $f = IO::File->new(">$fn") || return undef;
+       for (@$ref) {
+               $f->print("$_\n");
+               $count++;
+       }
+       $f->close;
+       unlink $fn unless $count;
+       return $count;
+}
+
+sub lines
+{
+       my $self = shift;
+       return @{$self->{lines}};
+}
+
+sub erase
+{
+       my $call = clean(lc shift);
+       my $fn = "$base/$call";
+       unlink $fn;
+}