perl/DXHash.pm

   1 #
   2 # a class for setting 'bad' (or good) things
   3 #
   4 # This is really a general purpose list handling
   5 # thingy for determining good or bad objects like
   6 # callsigns. It is for storing things "For Ever".
   7 #
   8 # Things entered into the list are always upper
   9 # cased.
  10 #
  11 # The files that are created live in /spider/data
  12 #
  13 # Dunno why I didn't do this earlier but heyho..
  14 #
  15 # Copyright (c) 2001 Dirk Koopman G1TLH
  16 #
  17 # $Id$
  18 #
  19
  20 package DXHash;
  21
  22 use DXVars;
  23 use DXUtil;
  24 use DXDebug;
  25
  26 use strict;
  27
  28 use vars qw($VERSION $BRANCH);
  29 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
  30 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0;
  31 $main::build += $VERSION;
  32 $main::branch += $BRANCH;
  33
  34 sub new
  35 {
  36         my ($pkg, $name) = @_;
  37         my $s = readfilestr($main::data, $name);
  38         my $self = eval $s if $s;
  39         dbg("error in reading $name in DXHash $@") if $@;
  40         $self = bless {name => $name}, $pkg unless $self;
  41         return $self;
  42 }
  43
  44 sub put
  45 {
  46         my $self = shift;
  47         writefilestr($main::data, $self->{name}, undef, $self);
  48 }
  49
  50 sub add
  51 {
  52         my $self = shift;
  53         my $n = uc shift;
  54         my $t = shift || time;
  55         $self->{$n} = $t;
  56 }
  57
  58 sub del
  59 {
  60         my $self = shift;
  61         my $n = uc shift;
  62         delete $self->{$n};
  63 }
  64
  65 sub in
  66 {
  67         my $self = shift;
  68         my $n = uc shift;
  69         return exists $self->{$n};
  70 }
  71
  72 # this is really just a general shortcut for all commands to
  73 # set and unset values
  74 sub set
  75 {
  76         my ($self, $priv, $noline, $dxchan, $line) = @_;
  77         return (1, $dxchan->msg('e5')) unless $dxchan->priv >= $priv;
  78         my @f = split /\s+/, $line;
  79         return (1, $noline) unless @f;
  80         my $f;
  81         my @out;
  82
  83         foreach $f (@f) {
  84
  85                 if ($self->in($f)) {
  86                         push @out, $dxchan->msg('hasha',uc $f, $self->{name});
  87                         next;
  88                 }
  89                 $self->add($f);
  90                 push @out, $dxchan->msg('hashb', uc $f, $self->{name});
  91         }
  92         $self->put;
  93         return (1, @out);
  94 }
  95
  96 # this is really just a general shortcut for all commands to
  97 # set and unset values
  98 sub unset
  99 {
 100         my ($self, $priv, $noline, $dxchan, $line) = @_;
 101         return (1, $dxchan->msg('e5')) unless $dxchan->priv >= $priv;
 102         my @f = split /\s+/, $line;
 103         return (1, $noline) unless @f;
 104         my $f;
 105         my @out;
 106
 107         foreach $f (@f) {
 108
 109                 unless ($self->in($f)) {
 110                         push @out, $dxchan->msg('hashd', uc $f, $self->{name});
 111                         next;
 112                 }
 113                 $self->del($f);
 114                 push @out, $dxchan->msg('hashc', uc $f, $self->{name});
 115         }
 116         $self->put;
 117         return (1, @out);
 118 }
 119
 120 sub show
 121 {
 122         my ($self, $priv, $dxchan) = @_;
 123         return (1, $dxchan->msg('e5')) unless $dxchan->priv >= $priv;
 124
 125         my @out;
 126         for (sort keys %{$self}) {
 127                 next if $_ eq 'name';
 128                 push @out, $dxchan->msg('hashe', $_, cldatetime($self->{$_}));
 129         }
 130         return (1, @out);
 131 }
 132
 133 1;