]> www.dxcluster.org Git - spider.git/blob - perl/DB0SDX.pm
only the first slot in PC92C should have version nos
[spider.git] / perl / DB0SDX.pm
1 #!/usr/bin/perl -w
2
3 package K4UTE;
4
5 use HTML::Parser;
6 use Data::Dumper;
7
8 @ISA = qw( HTML::Parser );
9
10 use strict;
11
12 sub new
13 {
14     my $pkg = shift;
15         my $self = SUPER::new $pkg;
16         $self->{list} = [];
17         $self->{state} = 'pre';
18     $self->{sort} = undef;
19         $self->{debug} = 0;
20     $self->{call} = uc shift;
21         return $self;
22 }
23
24 sub start
25 {
26         my ($self, $tag, $attr, $attrseq, $origtext) = @_;
27         if ($self->{debug}) {
28                 print "$self->{state} $tag";
29         if ($attr) {
30                         my $dd = new Data::Dumper([$attr], [qw(attr)]);
31                         $dd->Terse(1);
32                         $dd->Indent(0);
33                         $dd->Quotekeys(0);
34                         print " ", $dd->Dumpxs;
35                 }
36                 print "\n";
37         }
38         if ($tag eq 'tr' ) {
39                 if ($self->{state} eq 't1') {
40                         $self->state('t1r');
41                 } elsif ($self->{state} eq 't1r') {
42                         $self->state('t1d1');
43                 } elsif ($self->{state} eq 't2') {
44                         $self->state('t2r');
45                 } elsif ($self->{state} eq 't2r') {
46                         $self->state('t2d1');
47                 }
48         } 
49 }
50
51 sub text
52 {
53         my ($self, $text) = @_;
54         $text =~ s/^[\s\r\n]+//g;
55         $text =~ s/[\s\r\n]+$//g;
56     print "$self->{state} text $text\n" if $self->{debug};      
57         if (length $text) {
58                 if ($self->{state} eq 'pre' && $text =~ /$self->{call}/i ) {
59                         $self->state('t1');
60                         $self->{addr} = "";
61                         $self->{laddr} = 0;
62                 } elsif ($self->{state} eq 't1d1') {
63                         $self->{dxcall} = $text;
64                         $self->state('t1d2');
65                 } elsif ($self->{state} eq 't1d2') {
66                         $self->{dxmgr} = $text;
67                         $self->state('t1d3');
68                 } elsif ($self->{state} eq 't1d3') {
69                         $self->{dxdate} = amdate($text);
70                         $self->state('t1d4');
71                 } elsif ($self->{state} eq 't1d4') {
72                         push @{$self->{list}}, "$self->{dxcall}|mgr|$self->{dxmgr}|$self->{dxdate}|$text";
73                         $self->state('t1e');
74                 } elsif ($self->{state} eq 't2d1') {
75                         $self->{dxcall} = $text;
76                         $self->state('t2d2');
77                 } elsif ($self->{state} eq 't2d2') {
78                         $self->{dxaddr} = $text;
79                         $self->state('t2d3');
80                 } elsif ($self->{state} eq 't2d3') {
81                         $self->{dxdate} = amdate($text);
82                         $self->state('t2d4');
83                 } elsif ($self->{state} eq 't2d4') {
84                         push @{$self->{list}}, "$self->{dxcall}|addr|$self->{dxaddr}|$self->{dxdate}|$text";
85                         $self->state('t2e');
86                 } elsif ($self->{state} eq 't2' && $text =~ /did\s+not\s+return/i) {
87                         $self->state('last');
88                 }
89         }
90 }
91
92 sub end
93 {
94         my ($self, $tag, $origtext) = @_;
95     print "$self->{state} /$tag\n" if $self->{debug};
96         if ($self->{state} =~ /^t1/ && $tag eq 'table') {
97                 $self->state('t2');
98         } elsif ($self->{state} =~ /^t2/ && $tag eq 'table') {
99                 $self->state('last');
100         }
101 }
102
103 sub amdate
104 {
105         my $text = shift;
106         my ($m, $d, $y) = split m{/}, $text;
107         $y += 1900;
108         $y += 100 if $y < 1990;
109         return sprintf "%02d-%s-%d", $d, (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$m-1], $y;
110 }
111
112 sub state
113 {
114         my $self = shift;
115         $self->{state} = shift if @_;
116         return $self->{state};
117 }
118
119 sub debug
120 {
121         my ($self, $val) = @_;
122         $self->{debug} = $val;
123 }
124
125 sub answer
126 {
127         my $self = shift;
128         return @{$self->{list}};
129 }
130
131 1;
132