fix usdb, console.pl, sh/dx /p and sh/register

[spider.git] / cmd / show / registered.pl

diff --git a/cmd/show/registered.pl b/cmd/show/registered.pl
index b3f345d96317186b9d58e4ae56d08fc61a375a37..71ed0e38a4609c7b15cbd68827dd54a809b3e9de 100644 (file)
--- a/cmd/show/registered.pl
+++ b/cmd/show/registered.pl
@@ -19,7 +19,7 @@ sub handle
 
        if ($line) {
                $line =~ s/[^\w\-\/]+//g;
-               $line = "^\U\Q$line";
+               $line = "\U\Q$line";
        }
 
        if ($self->{_nospawn}) {
@@ -37,35 +37,44 @@ sub generate
        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);
-       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;
+       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
                        }
                }
        }
-} };
+
+       foreach $key (sort keys %call) {
+               my $u = DXUser::get_current($key);
+               if ($u && defined (my $r = $u->registered)) {
+                       push @val, "${key}($r)";
+                       ++$count;
+               }
+       }
+
        my @l;
        foreach my $call (@val) {
                if (@l >= 5) {
-                       push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l;
+                       push @out, sprintf "%-14s %-14s %-14s %-14s %-14s", @l;
                        @l = ();
                }
                push @l, $call;
        }
        if (@l) {
                push @l, "" while @l < 5;
-               push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l;
+               push @out, sprintf "%-14s %-14s %-14s %-14s %-14s", @l;
        }
 
-       push @out, $@ if $@;
-       push @out, , $self->msg('rec', $count);
+       push @out, $self->msg('rec', $count);
        return @out;
        
 }