]> dxcluster.net Git - spider.git/blob - cmd/unset/registered.pl
add missing K field definition
[spider.git] / cmd / unset / registered.pl
1 #
2 # show/registered
3 #
4 # show all registered users 
5 #
6 # Copyright (c) 2001 Dirk Koopman G1TLH
7 #
8 #
9 #
10
11 sub handle
12 {
13         my ($self, $line) = @_;
14         return (1, $self->msg('e5')) unless $self->priv >= 9;
15
16         my @out;
17
18         use DB_File;
19
20         if ($line) {
21                 $line =~ s/[^\w\-\/]+//g;
22                 $line = "\U\Q$line";
23         }
24
25         if ($self->{_nospawn}) {
26                 @out = generate($self, $line);
27         } else {
28                 @out = $self->spawn_cmd("show/registered $line", sub { return (generate($self, $line)); });
29         }
30
31         return (1, @out);
32 }
33
34 sub generate
35 {
36         my $self = shift;
37         my $line = shift;
38         my @out;
39         my @val;
40
41 #       dbg("set/register line: $line");
42
43         my %call = ();
44         $call{$_} = 1 for split /\s+/, $line;
45         delete $call{'ALL'};
46
47         my ($action, $count, $key, $data) = (0,0,0,0);
48         unless (keys %call) {
49                 for ($action = DXUser::R_FIRST, $count = 0; !$DXUser::dbm->seq($key, $data, $action); $action = DXUser::R_NEXT) {
50                         if ($data =~ m{registered}) {
51                                 $call{$key} = 1;       # possible candidate
52                         }
53                 }
54         }
55
56         foreach $key (sort keys %call) {
57                 my $u = DXUser::get_current($key);
58                 if ($u && defined (my $r = $u->registered)) {
59                         push @val, "${key}($r)";
60                         ++$count;
61                 }
62         }
63
64         my @l;
65         push @out, "Registration is " . ($main::reqreg ? "Required" :  "NOT Required");
66         foreach my $call (@val) {
67                 if (@l >= 5) {
68                         push @out, sprintf "%-14s %-14s %-14s %-14s %-14s", @l;
69                         @l = ();
70                 }
71                 push @l, $call;
72         }
73         if (@l) {
74                 push @l, "" while @l < 5;
75                 push @out, sprintf "%-14s %-14s %-14s %-14s %-14s", @l;
76         }
77
78         push @out, $self->msg('rec', $count);
79         return @out;
80         
81 }
82