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 sub new
  29 {
  30         my ($pkg, $name) = @_;
  31         my $s = readfilestr($main::data, $name);
  32         my $self = eval $s if $s;
  33         dbg('err', "error in reading $name in DXHash $@") if $@;
  34         $self = bless {name => $name}, $pkg unless $self;
  35         return $self;
  36 }
  37
  38 sub put
  39 {
  40         my $self = shift;
  41         writefilestr($main::data, $self->{name}, undef, $self);
  42 }
  43
  44 sub add
  45 {
  46         my $self = shift;
  47         my $n = uc shift;
  48         my $t = shift || time;
  49         $self->{$n} = $t;
  50 }
  51
  52 sub del
  53 {
  54         my $self = shift;
  55         my $n = uc shift;
  56         delete $self->{$n};
  57 }
  58
  59 sub in
  60 {
  61         my $self = shift;
  62         my $n = uc shift;
  63         return exists $self->{$n};
  64 }
  65
  66 # this is really just a general shortcut for all commands to
  67 # set and unset values
  68 sub set
  69 {
  70         my ($self, $priv, $noline, $dxchan, $line) = @_;
  71         return (1, $dxchan->msg('e5')) unless $dxchan->priv >= $priv;
  72         my @f = split /\s+/, $line;
  73         return (1, $noline) unless @f;
  74         my $f;
  75         my @out;
  76
  77         foreach $f (@f) {
  78
  79                 if ($self->in($f)) {
  80                         push @out, $dxchan->msg('hasha',uc $f, $self->{name});
  81                         next;
  82                 }
  83                 $self->add($f);
  84                 push @out, $dxchan->msg('hashb', uc $f, $self->{name});
  85         }
  86         $self->put;
  87         return (1, @out);
  88 }
  89
  90 # this is really just a general shortcut for all commands to
  91 # set and unset values
  92 sub unset
  93 {
  94         my ($self, $priv, $noline, $dxchan, $line) = @_;
  95         return (1, $dxchan->msg('e5')) unless $dxchan->priv >= $priv;
  96         my @f = split /\s+/, $line;
  97         return (1, $noline) unless @f;
  98         my $f;
  99         my @out;
 100
 101         foreach $f (@f) {
 102
 103                 unless ($self->in($f)) {
 104                         push @out, $dxchan->msg('hashd', uc $f, $self->{name});
 105                         next;
 106                 }
 107                 $self->del($f);
 108                 push @out, $dxchan->msg('hashc', uc $f, $self->{name});
 109         }
 110         $self->put;
 111         return (1, @out);
 112 }
 113
 114 sub show
 115 {
 116         my ($self, $priv, $dxchan) = @_;
 117         return (1, $dxchan->msg('e5')) unless $dxchan->priv >= $priv;
 118
 119         my @out;
 120         for (sort keys %{$self}) {
 121                 next if $_ eq 'name';
 122                 push @out, $dxchan->msg('hashe', $_, cldatetime($self->{$_}));
 123         }
 124         return (1, @out);
 125 }
 126
 127 1;