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