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