]> scm.dxcluster.org Git - spider.git/blob - perl/DXHash.pm
added even more colouration in an attempt to make it as clear as possible
[spider.git] / 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;