X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=cmd%2Fshow%2Fregistered.pl;h=4876aea2a7d6f9740f413eda68422f7f389b0afe;hb=1a9286080b21d5b65f97cab08d8a493abafad8f1;hp=e4b6bce958c54f1ed8fffdd77f33fc5ba365f2b6;hpb=4888cab7f56fbed40bf28477fe3f9c0ee9977a7c;p=spider.git diff --git a/cmd/show/registered.pl b/cmd/show/registered.pl index e4b6bce9..4876aea2 100644 --- a/cmd/show/registered.pl +++ b/cmd/show/registered.pl @@ -5,36 +5,78 @@ # # Copyright (c) 2001 Dirk Koopman G1TLH # -# $Id$ # +# + +sub handle +{ + my ($self, $line) = @_; + return (1, $self->msg('e5')) unless $self->priv >= 9; -my ($self, $line) = @_; -return (1, $self->msg('e5')) unless $self->priv >= 9; + my @out; -my @out; + use DB_File; -use DB_File; + if ($line) { + $line =~ s/[^\w\-\/]+//g; + $line = "\U\Q$line"; + } -if ($line) { - $line =~ s/[^\w\-\/]+//g; - $line = "^\U\Q$line"; + if ($self->{_nospawn}) { + @out = generate($self, $line); + } else { + @out = $self->spawn_cmd("show/registered $line", sub { return (generate($self, $line)); }); + } + + return (1, @out); } -my ($action, $count, $key, $data) = (0,0,0,0); -eval qq{for (\$action = DXUser::R_FIRST, \$count = 0; !\$DXUser::dbm->seq(\$key, \$data, \$action); \$action = DXUser::R_NEXT) { - if (\$data =~ m{registered}) { - if (!\$line || (\$line && \$key =~ /^$line/)) { - my \$u = DXUser->get_current(\$key); - if (\$u && \$u->registered) { - push \@out, \$key; - ++\$count; +sub generate +{ + my $self = shift; + my $line = shift; + my @out; + my @val; + +# dbg("set/register line: $line"); + + my %call = (); + $call{$_} = 1 for split /\s+/, $line; + delete $call{'ALL'}; + + my ($action, $count, $key, $data) = (0,0,0,0); + unless (keys %call) { + for ($action = DXUser::R_FIRST, $count = 0; !$DXUser::dbm->seq($key, $data, $action); $action = DXUser::R_NEXT) { + if ($data =~ m{registered}) { + $call{$key} = 1; # possible candidate } } } -} }; -push @out, $@ if $@; + foreach $key (sort keys %call) { + my $u = DXUser::get_current($key); + if ($u && defined (my $r = $u->registered)) { + push @val, "${key}($r)"; + ++$count; + } + } -return (1, @out, $self->msg('rec', $count)); + my @l; + push @out, "Registration is " . ($main::reqreg ? "Required" : "NOT Required"); + foreach my $call (@val) { + if (@l >= 5) { + push @out, sprintf "%-14s %-14s %-14s %-14s %-14s", @l; + @l = (); + } + push @l, $call; + } + if (@l) { + push @l, "" while @l < 5; + push @out, sprintf "%-14s %-14s %-14s %-14s %-14s", @l; + } + push @out, $self->msg('rec', $count); + return @out; + +}