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(lc shift);
  39         my $fn = "$base/$script";
  40
  41         my $fh = new IO::File $fn;
  42         return undef unless $fh;
  43         my $self = bless {call => $script}, $pkg;
  44         my @lines;
  45         while (<$fh>) {
  46                 chomp;
  47                 push @lines, $_;
  48         }
  49         $fh->close;
  50         $self->{lines} = \@lines;
  51         return bless $self, $pkg;
  52 }
  53
  54 sub run
  55 {
  56         my $self = shift;
  57         my $dxchan = shift;
  58         foreach my $l (@{$self->{lines}}) {
  59                 unless ($l =~ /^\s*\#/ || $l =~ /^\s*$/) {
  60                         $dxchan->inscript(1);
  61                         my @out = DXCommandmode::run_cmd($dxchan, $l);
  62                         $dxchan->inscript(0);
  63                         if ($dxchan->can('send_ans')) {
  64                                 $dxchan->send_ans(@out);
  65                         } else {
  66                                 dbg($_) for @out;
  67                         }
  68                         last if @out && $l =~ /^pri?v?/i;
  69                 }
  70         }
  71 }
  72
  73 sub store
  74 {
  75         my $call = clean(lc shift);
  76         my @out;
  77         my $ref = ref $_[0] ? shift : \@_;
  78         my $count;
  79         my $fn = "$base/$call";
  80
  81     rename $fn, "$fn.o" if -e $fn;
  82         my $f = IO::File->new(">$fn") || return undef;
  83         for (@$ref) {
  84                 $f->print("$_\n");
  85                 $count++;
  86         }
  87         $f->close;
  88         unlink $fn unless $count;
  89         return $count;
  90 }
  91
  92 sub lines
  93 {
  94         my $self = shift;
  95         return @{$self->{lines}};
  96 }
  97
  98 sub erase
  99 {
 100         my $call = clean(lc shift);
 101         my $fn = "$base/$call";
 102         unlink $fn;
 103 }