]> scm.dxcluster.org Git - spider.git/blob - perl/DXHash.pm
b97d54c79608a7f59faf6f1c152b2dc63a83e178
[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 sub new
29 {
30         my ($pkg, $name) = @_;
31         my $s = readfilestr($main::data, $name);
32         my $self = eval $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;