perl/Script.pm

   1 #
   2 # module to do startup script handling
   3 #
   4 # Copyright (c) 2001 Dirk Koopman G1TLH
   5 #
   6 # $Id$
   7 #
   8
   9 package Script;
  10
  11 use strict;
  12
  13 use DXUtil;
  14 use DXDebug;
  15 use DXChannel;
  16 use DXCommandmode;
  17 use DXVars;
  18 use IO::File;
  19
  20 use vars qw($VERSION $BRANCH);
  21 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
  22 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
  23 $main::build += $VERSION;
  24 $main::branch += $BRANCH;
  25
  26 my $base = "$main::root/scripts";
  27
  28 sub clean
  29 {
  30         my $s = shift;
  31         $s =~ s/[^-\w\.]//g;
  32         return $s;
  33 }
  34
  35 sub new
  36 {
  37         my $pkg = shift;
  38         my $script = clean(shift);
  39         my $mybase = shift || $base;
  40         my $fn = "$mybase/$script";
  41
  42         my $self = {call => $script};
  43         my $fh = IO::File->new($fn);
  44         if ($fh) {
  45                 $self->{fn} = $fn;
  46         } else {
  47                 $fh = IO::File->new(lc $fn);
  48                 if ($fh) {
  49                         $self->{fn} = $fn;
  50                 } else {
  51                         return undef;
  52                 }
  53         }
  54         my @lines;
  55         while (<$fh>) {
  56                 chomp;
  57                 push @lines, $_;
  58         }
  59         $fh->close;
  60         $self->{lines} = \@lines;
  61         $self->{inscript} = 1;
  62         return bless $self, $pkg;
  63 }
  64
  65 sub run
  66 {
  67         my $self = shift;
  68         my $dxchan = shift;
  69         my $return_output = shift;
  70         my @out;
  71
  72         foreach my $l (@{$self->{lines}}) {
  73                 unless ($l =~ /^\s*\#/ || $l =~ /^\s*$/) {
  74                         $dxchan->inscript(1) if $self->{inscript};
  75                         push @out, DXCommandmode::run_cmd($dxchan, $l);
  76                         $dxchan->inscript(0) if $self->{inscript};
  77                         last if @out && $l =~ /^pri?v?/i;
  78                 }
  79         }
  80         if ($return_output) {
  81                 return @out;
  82         } else {
  83                 if ($dxchan->can('send_ans')) {
  84                         $dxchan->send_ans(@out);
  85                 } else {
  86                         dbg($_) for @out;
  87                 }
  88         }
  89         return ();
  90 }
  91
  92 sub inscript
  93 {
  94         my $self = shift;
  95         $self->{inscript} = shift if @_;
  96         return $self->{inscript};
  97 }
  98
  99 sub store
 100 {
 101         my $call = clean(lc shift);
 102         my @out;
 103         my $ref = ref $_[0] ? shift : \@_;
 104         my $count;
 105         my $fn = "$base/$call";
 106
 107     rename $fn, "$fn.o" if -e $fn;
 108         my $f = IO::File->new(">$fn") || return undef;
 109         for (@$ref) {
 110                 $f->print("$_\n");
 111                 $count++;
 112         }
 113         $f->close;
 114         unlink $fn unless $count;
 115         return $count;
 116 }
 117
 118 sub lines
 119 {
 120         my $self = shift;
 121         return @{$self->{lines}};
 122 }
 123
 124 sub erase
 125 {
 126         my $self = shift;
 127         unlink $self->{fn};
 128 }