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                         my @out = DXCommandmode::run_cmd($dxchan, $l);
  61                         if ($dxchan->can('send_ans')) {
  62                                 $dxchan->send_ans(@out);
  63                         } else {
  64                                 dbg($_) for @out;
  65                         }
  66                         last if @out && $l =~ /^pri?v?/i;
  67                 }
  68         }
  69 }
  70
  71 sub store
  72 {
  73         my $call = clean(lc shift);
  74         my @out;
  75         my $ref = ref $_[0] ? shift : \@_;
  76         my $count;
  77         my $fn = "$base/$call";
  78
  79     rename $fn, "$fn.o" if -e $fn;
  80         my $f = IO::File->new(">$fn") || return undef;
  81         for (@$ref) {
  82                 $f->print("$_\n");
  83                 $count++;
  84         }
  85         $f->close;
  86         unlink $fn unless $count;
  87         return $count;
  88 }
  89
  90 sub lines
  91 {
  92         my $self = shift;
  93         return @{$self->{lines}};
  94 }
  95
  96 sub erase
  97 {
  98         my $call = clean(lc shift);
  99         my $fn = "$base/$call";
 100         unlink $fn;
 101 }