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
  16 use vars qw(%dup $duplth $dupage);
  17
  18 %dup = ();                                              # the duplicates hash
  19 $duplth = 60;                                   # the length of text to use in the deduping
  20 $dupage = 24*3600;               # the length of time to hold spot dups
  21
  22 # enter the spot for dup checking and return true if it is already a dup
  23 sub dup
  24 {
  25         my ($call, $to, $text) = @_;
  26         my $d = $main::systime;
  27
  28         chomp $text;
  29         unpad($text);
  30         $text = substr($text, 0, $duplth) if length $text > $duplth;
  31         my $dupkey = "$to|$text";
  32         return 1 if exists $dup{$dupkey};
  33         $dup{$dupkey} = $d;         # in seconds (to the nearest minute)
  34         return 0;
  35 }
  36
  37 # called every hour and cleans out the dup cache
  38 sub process
  39 {
  40         my $cutoff = $main::systime - $dupage;
  41         while (my ($key, $val) = each %dup) {
  42                 delete $dup{$key} if $val < $cutoff;
  43         }
  44 }
  45
  46 sub listdups
  47 {
  48         my $regex = shift;
  49         $regex = '.*' unless $regex;
  50         $regex =~ s/[\$\@\%]//g;
  51         my @out;
  52         for (sort { $dup{$a} <=> $dup{$b} } grep { m{$regex}i } keys %dup) {
  53                 my $val = $dup{$_};
  54                 push @out, "$_ = " . cldatetime($val);
  55         }
  56         return @out;
  57 }
  58
  59
  60 1;
  61