]> gb7djk.dxcluster.net Git - spider.git/blob - perl/Script.pm
add dbg line to dxcron::spawn_cmd
[spider.git] / 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\.]//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         unlink $self->{fn};
122 }