]> scm.dxcluster.org Git - spider.git/blob - perl/DXHash.pm
allow PC92(A/D) to be slugged and aggregated
[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 #
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;