]> gb7djk.dxcluster.net Git - spider.git/blob - cmd/show/lockout.pl
belt and braces locate users.v4 in DXUser.pm
[spider.git] / cmd / show / lockout.pl
1 #
2 # show/lockout
3 #
4 # show all excluded users 
5 #
6 # Copyright (c) 2000 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         if ($line) {
19                 $line =~ s/[^\w\-\/]+//g;
20                 $line = "\U\Q$line";
21         }
22
23         if ($self->{_nospawn}) {
24                 @out = generate($self, $line);
25         } else {
26                 @out = $self->spawn_cmd("show/lockout $line", sub { return (generate($self, $line)); });
27         }
28         return (1, $self->msg('lockoutuse')) unless $line;
29 }
30
31
32 sub generate
33 {
34         my $self = shift;
35         my $line = shift;
36         my @out;
37         my @val;
38         #       my ($action, $count, $key, $data) = (0,0,0,0);
39         #       eval qq{for (\$action = DXUser::R_FIRST, \$count = 0; !\$DXUser::dbm->seq(\$key, \$data, \$action); \$action = DXUser::R_NEXT) {
40         #       if (\$data =~ m{lockout}) {
41         #               if (\$line eq 'ALL' || \$key =~ /^$line/) {
42         #                       my \$ur = DXUser::get_current(\$key);
43         #                       if (\$ur && \$ur->lockout) {
44         #                               push \@val, \$key;
45         #                               ++\$count;
46         #                       }
47         #               }
48         #       }
49
50 #       $DB::single = 1;
51         
52         my @val;
53         if ($line eq 'ALL') {
54                 @val = DXUser::scan(sub {
55                                                                 my $k = shift;
56                                                                 my $l = shift;
57                                                                 # cheat, don't decode because we can easily pull it out from the json test
58                                                                 return $l =~ m{"lockout":1} ? $k : ();
59                                                         });
60
61         } else {
62                 for my $call (split /\s+/, $line) {
63                         my $l = DXUser::get($call, 1);
64                         next unless $l;
65                         next unless $l =~ m{"lockout":1};
66                         push @val, $call; 
67                 }
68         }
69
70         my $count = @val;
71         my @l;
72         foreach my $call (@val) {
73                 if (@l >= 5) {
74                         push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l;
75                         @l = ();
76                 }
77                 push @l, $call;
78         }
79         if (@l) {
80                 push @l, "" while @l < 5;
81                 push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l;
82         }
83
84         push @out, $@ if $@;
85         push @out, $self->msg('rec', $count);
86         return @out;
87 }
88
89
90