perl/Script.pm

   1 #
   2 # module to do startup script handling
   3 #
   4 # Copyright (c) 2001 Dirk Koopman G1TLH
   5 #
   6 #
   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 my $base = "$main::root/scripts";
  21
  22 sub clean
  23 {
  24         my $s = shift;
  25         $s =~ s/([-\w\d_]+)/$1/g;
  26         return $s;
  27 }
  28
  29 sub new
  30 {
  31         my $pkg = shift;
  32         my $script = clean(shift);
  33         my $mybase = shift || $base;
  34         my $fn = "$mybase/$script";
  35
  36         my $self = {call => $script};
  37         my $fh = IO::File->new($fn);
  38         if ($fh) {
  39                 $self->{fn} = $fn;
  40         } else {
  41                 $fh = IO::File->new(lc $fn);
  42                 if ($fh) {
  43                         $self->{fn} = $fn;
  44                 } else {
  45                         return undef;
  46                 }
  47         }
  48         my @lines;
  49         while (<$fh>) {
  50                 chomp;
  51                 push @lines, $_;
  52         }
  53         $fh->close;
  54         $self->{lines} = \@lines;
  55         $self->{inscript} = 1;
  56         return bless $self, $pkg;
  57 }
  58
  59 sub run
  60 {
  61         my $self = shift;
  62         my $dxchan = shift;
  63         my $return_output = shift;
  64         my @out;
  65
  66         foreach my $l (@{$self->{lines}}) {
  67                 unless ($l =~ /^\s*\#/ || $l =~ /^\s*$/) {
  68                         $dxchan->inscript(1) if $self->{inscript};
  69                         push @out, DXCommandmode::run_cmd($dxchan, $l);
  70                         $dxchan->inscript(0) if $self->{inscript};
  71                         last if @out && $l =~ /^pri?v?/i;
  72                 }
  73         }
  74         if ($return_output) {
  75                 return @out;
  76         } else {
  77                 if ($dxchan->can('send_ans')) {
  78                         $dxchan->send_ans(@out);
  79                 } else {
  80                         dbg($_) for @out;
  81                 }
  82         }
  83         return ();
  84 }
  85
  86 sub inscript
  87 {
  88         my $self = shift;
  89         $self->{inscript} = shift if @_;
  90         return $self->{inscript};
  91 }
  92
  93 sub store
  94 {
  95         my $call = clean(lc shift);
  96         my @out;
  97         my $ref = ref $_[0] ? shift : \@_;
  98         my $count;
  99         my $fn = "$base/$call";
 100
 101     rename $fn, "$fn.o" if -e $fn;
 102         my $f = IO::File->new(">$fn") || return undef;
 103         for (@$ref) {
 104                 $f->print("$_\n");
 105                 $count++;
 106         }
 107         $f->close;
 108         unlink $fn unless $count;
 109         return $count;
 110 }
 111
 112 sub lines
 113 {
 114         my $self = shift;
 115         return @{$self->{lines}};
 116 }
 117
 118 sub erase
 119 {
 120         my $self = shift;
 121         my $call = clean($self->call);
 122
 123         my $fn;
 124         my $try;
 125
 126         $try = "$base/" . clean(lc $self->call);
 127         if (-w $try) {
 128                 $fn = $try;
 129         } else {
 130                 $try = "$base/" . clean(uc $self->call);
 131                 if (-w $try) {
 132                         $fn = $try;
 133                 }
 134         }
 135
 136         if ($fn && -w $fn) {
 137                 unless (unlink $fn) {
 138                         return ($self->msg('m22'. $call));
 139                 }
 140                 return ($self->msg('m20', $call));
 141         }
 142         return ($self->msg('e3', "unset/startup", $call));
 143 }