X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=cmd%2Fshow%2Fregistered.pl;h=9310bd7ce8f8a9f8ffadf92414792b2e714e7433;hb=ca828d0e2a21d9a6540361ca4878df71f125e120;hp=593ef0f50ba1d313864019ec4af53f8f90df9dd5;hpb=c3505bcfc922cd712bad2c20b3479cf8d1dc54fe;p=spider.git diff --git a/cmd/show/registered.pl b/cmd/show/registered.pl index 593ef0f5..9310bd7c 100644 --- a/cmd/show/registered.pl +++ b/cmd/show/registered.pl @@ -8,33 +8,83 @@ # # -my ($self, $line) = @_; -return (1, $self->msg('e5')) unless $self->priv >= 9; +sub handle +{ + my ($self, $line) = @_; -my @out; + return (1, $self->msg('e5')) unless $self->priv >= 9; -use DB_File; + my @out; -if ($line) { - $line =~ s/[^\w\-\/]+//g; - $line = "^\U\Q$line"; -} + if ($line) { + $line =~ s/[^\w\-\/]+//g; + $line = "\U\Q$line"; + } -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; - } - } + if ($self->{_nospawn}) { + @out = generate($self, $line); + } else { + @out = $self->spawn_cmd("show/registered $line", sub { return (generate($self, $line)); }); } -} }; -push @out, $@ if $@; + return (1, @out); +} -return (1, @out, $self->msg('rec', $count)); +sub generate +{ + my $self = shift; + my $line = shift; + my @out; + my @val; + + 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 \@val, \$key; +# ++\$count; +# } +# } +# } + #} }; + my $count; + my @val; + if ($line eq 'ALL') { + @val = DXUser::scan(sub { + my $k = shift; + my $l = shift; + # cheat, don't decode because we can easily pull it out from the json test + return $l =~ m{"registered":1} ? $k : (); + }); + } else { + for my $call (split /\s+/, $line) { + my $l = DXUser::get($call, 1); + next unless $l; + next unless $l =~ m{"registered":1}; + push @val, $call; + } + } + + my @l; + $count = @val; + foreach my $call (@val) { + if (@l >= 5) { + push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l; + @l = (); + } + push @l, $call; + } + if (@l) { + push @l, "" while @l < 5; + push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l; + } + + push @out, $@ if $@; + push @out, , $self->msg('rec', $count); + return @out; + +}