cmd/show/isolate.pl

   1 #
   2 # show/isolate
   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 >= 1;
  15
  16         my @out;
  17
  18         if ($self->{_nospawn}) {
  19                 return (1, generate($self));
  20         } else {
  21                 return (1, $self->spawn_cmd("show/isolate $line", sub { return (generate($self)); }));
  22         }
  23
  24 }
  25
  26 sub generate
  27 {
  28         my $self = shift;
  29         my @out;
  30         my @val;
  31
  32 #       my ($action, $count, $key, $data) = (0,0,0,0);
  33 #
  34 #       for ($action = DXUser::R_FIRST, $count=0; !$DXUser::dbm->seq($key, $data, $action); $action = DXUser::R_NEXT) {
  35 #               if ($data =~ m{isolate}) {
  36 #                       my $u = DXUser::get_current($key);
  37 #                       if ($u && $u->isolate) {
  38 #                               push @val, $key;
  39 #                               ++$count;
  40 #                       }
  41 #               }
  42 #       }
  43         @val = DXUser::scan(sub {
  44                                                         my $k = shift;
  45                                                         my $l = shift;
  46                                                         # cheat, don't decode because we can easily pull it out from the json test
  47                                                         return $l =~ m{"isolate":1} ? $k : ();
  48                                                 });
  49
  50         my $count = @val;
  51         my @l;
  52         foreach my $call (@val) {
  53                 if (@l >= 5) {
  54                         push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l;
  55                         @l = ();
  56                 }
  57                 push @l, $call;
  58         }
  59         if (@l) {
  60                 push @l, "" while @l < 5;
  61                 push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l;
  62         }
  63
  64         push @out, , $self->msg('rec', $count);
  65         return @out;
  66 }
  67
  68