]> dxcluster.org Git - spider.git/blob - perl/AnnTalk.pm
*** empty log message ***
[spider.git] / perl / AnnTalk.pm
1 #
2 # Announce and Talk Handling routines
3 #
4 # Copyright (c) 2000 Dirk Koopman
5 #
6 # $Id$
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 = 60;                                   # the length of text to use in the deduping
21 $dupage = 5*24*3600;                    # the length of time to hold spot 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 use vars qw($VERSION $BRANCH);
42 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
43 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
44 $main::build += $VERSION;
45 $main::branch += $BRANCH;
46
47 # enter the spot for dup checking and return true if it is already a dup
48 sub dup
49 {
50         my ($call, $to, $text) = @_; 
51
52         chomp $text;
53         unpad($text);
54         $text =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
55         $text = substr($text, 0, $duplth) if length $text > $duplth; 
56         $text = pack("C*", map {$_ & 127} unpack("C*", $text));
57         $text =~ s/[^a-zA-Z0-9]//g;
58         my $dupkey = "A$to|\L$text";
59         return DXDupe::check($dupkey, $main::systime + $dupage);
60 }
61
62 sub listdups
63 {
64         return DXDupe::listdups('A', $dupage, @_);
65 }
66
67 # is this text field a likely announce to talk substitution?
68 # this may involve all sorts of language dependant heuristics, but 
69 # then again, it might not
70 sub is_talk_candidate
71 {
72         my ($from, $text) = @_;
73         my $call;
74         ($call) = $text =~ /^\s*(?:[Xx]|[Tt][Oo]?:?)\s+([\w-]+)/;
75         ($call) = $text =~ /^\s*>\s*([\w-]+)\b/ unless $call;
76         ($call) = $text =~ /^\s*([\w-]+):?\b/ unless $call;
77         if ($call) {
78                 $call = uc $call;
79                 return is_callsign($call);
80         }
81     return undef;
82 }
83 1; 
84