]> scm.dxcluster.org Git - spider.git/blob - perl/AnnTalk.pm
move ::process things back into persec
[spider.git] / perl / AnnTalk.pm
1 #
2 # Announce and Talk Handling routines
3 #
4 # Copyright (c) 2000 Dirk Koopman
5 #
6 #
7 #
8
9 package AnnTalk;
10
11 use strict;
12
13 use DXUtil;
14 use DXDebug;
15 use DXDupe;
16 use DXVars;
17
18 use vars qw(%dup $duplth $dupage $filterdef);
19
20 $duplth = 30;                                   # the length of text to use in the deduping
21 $dupage = 18*3600;                              # the length of time to hold ann dups
22 $filterdef = bless ([
23                           # tag, sort, field, priv, special parser 
24                           ['by', 'c', 0],
25                           ['dest', 'c', 1],
26                           ['info', 't', 2],
27                           ['group', 't', 3],
28                           ['origin', 'c', 4],
29                           ['wx', 't', 5],
30                           ['channel', 'c', 6],
31                           ['by_dxcc', 'nc', 7],
32                           ['by_itu', 'ni', 8],
33                           ['by_zone', 'nz', 9],
34                           ['origin_dxcc', 'nc', 10],
35                           ['origin_itu', 'ni', 11],
36                           ['origin_zone', 'nz', 12],
37                           ['by_state', 'nz', 13],
38                           ['origin_state', 'nz', 14],
39                          ], 'Filter::Cmd');
40
41 # enter the spot for dup checking and return true if it is already a dup
42 sub dup
43 {
44         my ($call, $to, $text, $t) = @_; 
45
46         $t ||= $main::systime + $dupage;
47         chomp $text;
48         unpad($text);
49         $text =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
50 #       $text = Encode::encode("iso-8859-1", $text) if $main::can_encode && Encode::is_utf8($text, 1);
51         $text =~ s/[^\#a-zA-Z0-9]//g;
52         $text = substr($text, 0, $duplth) if length $text > $duplth; 
53         my $dupkey = "A$call|$to|\L$text";
54         return DXDupe::check($dupkey, $t);
55 }
56
57 sub listdups
58 {
59         return DXDupe::listdups('A', $dupage, @_);
60 }
61
62 # is this text field a likely announce to talk substitution?
63 # this may involve all sorts of language dependant heuristics, but 
64 # then again, it might not
65 sub is_talk_candidate
66 {
67         my ($from, $text) = @_;
68         my $call;
69
70         ($call) = $text =~ /^\s*(?:[Xx]|[Tt][Oo]?:?)\s+([\w-]+)/;
71         ($call) = $text =~ /^\s*>\s*([\w-]+)\b/ unless $call;
72         ($call) = $text =~ /^\s*([\w-]+):?\b/ unless $call;
73         if ($call) {
74                 $call = uc $call;
75                 return is_callsign($call);
76         }
77     return undef;
78 }
79 1; 
80