X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=cmd%2Fshow%2Fregistered.pl;h=9310bd7ce8f8a9f8ffadf92414792b2e714e7433;hb=fda536aef281e0f6fc68a02c537d18650bd5505f;hp=7e3ce45def2a5f6d8e14def1ec46dbf7f9333b17;hpb=a76624e4742348ed0f39c7c3f732cdec8462da9e;p=spider.git diff --git a/cmd/show/registered.pl b/cmd/show/registered.pl index 7e3ce45d..9310bd7c 100644 --- a/cmd/show/registered.pl +++ b/cmd/show/registered.pl @@ -8,53 +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"; + } + + if ($self->{_nospawn}) { + @out = generate($self, $line); + } else { + @out = $self->spawn_cmd("show/registered $line", sub { return (generate($self, $line)); }); + } + + return (1, @out); } -@out = $self->spawn_cmd(sub { - my @out; - my @val; +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 ($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; - 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; - }); - -return (1, @out); + + 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; + +}