X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FScript.pm;h=05f408eca6daa26e82289de97da5ac29233e7e6c;hb=b9dffeff7239952814342dad19db3a51def6fab7;hp=24593aee92fa22e85b436a2efca7c134b467cdc3;hpb=5f2487385b59dbe88dc763fa9c26fe5a9b4a6b30;p=spider.git diff --git a/perl/Script.pm b/perl/Script.pm index 24593aee..05f408ec 100644 --- a/perl/Script.pm +++ b/perl/Script.pm @@ -17,12 +17,6 @@ use DXCommandmode; use DXVars; 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,0)); -$main::build += $VERSION; -$main::branch += $BRANCH; - my $base = "$main::root/scripts"; sub clean @@ -35,12 +29,22 @@ sub clean sub new { my $pkg = shift; - my $script = clean(lc shift); - my $fn = "$base/$script"; + my $script = clean(shift); + my $mybase = shift || $base; + my $fn = "$mybase/$script"; - my $fh = new IO::File $fn; - return undef unless $fh; - my $self = bless {call => $script}, $pkg; + my $self = {call => $script}; + my $fh = IO::File->new($fn); + if ($fh) { + $self->{fn} = $fn; + } else { + $fh = IO::File->new(lc $fn); + if ($fh) { + $self->{fn} = $fn; + } else { + return undef; + } + } my @lines; while (<$fh>) { chomp; @@ -48,6 +52,7 @@ sub new } $fh->close; $self->{lines} = \@lines; + $self->{inscript} = 1; return bless $self, $pkg; } @@ -55,19 +60,34 @@ sub run { my $self = shift; my $dxchan = shift; + my $return_output = shift; + my @out; + 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; - } + $dxchan->inscript(1) if $self->{inscript}; + push @out, DXCommandmode::run_cmd($dxchan, $l); + $dxchan->inscript(0) if $self->{inscript}; last if @out && $l =~ /^pri?v?/i; } } + if ($return_output) { + return @out; + } else { + if ($dxchan->can('send_ans')) { + $dxchan->send_ans(@out); + } else { + dbg($_) for @out; + } + } + return (); +} + +sub inscript +{ + my $self = shift; + $self->{inscript} = shift if @_; + return $self->{inscript}; } sub store @@ -97,7 +117,6 @@ sub lines sub erase { - my $call = clean(lc shift); - my $fn = "$base/$call"; - unlink $fn; + my $self = shift; + unlink $self->{fn}; }