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