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