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