]> www.dxcluster.org Git - spider.git/blob - perl/DXHash.pm
fix 5.8 ism that does not work on 5.6 (incrementing a subroutine).
[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,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;