cmd/unset/registered.pl

   1 #
   2 # show/registered
   3 #
   4 # show all registered users
   5 #
   6 # Copyright (c) 2001 Dirk Koopman G1TLH
   7 #
   8 #
   9 #
  10
  11 sub handle
  12 {
  13         my ($self, $line) = @_;
  14         return (1, $self->msg('e5')) unless $self->priv >= 9;
  15
  16         my @out;
  17
  18         use DB_File;
  19
  20         if ($line) {
  21                 $line =~ s/[^\w\-\/]+//g;
  22                 $line = "\U\Q$line";
  23         }
  24
  25         if ($self->{_nospawn}) {
  26                 @out = generate($self, $line);
  27         } else {
  28                 @out = $self->spawn_cmd("show/registered $line", sub { return (generate($self, $line)); });
  29         }
  30
  31         return (1, @out);
  32 }
  33
  34 sub generate
  35 {
  36         my $self = shift;
  37         my $line = shift;
  38         my @out;
  39         my @val;
  40
  41 #       dbg("set/register line: $line");
  42
  43         my %call = ();
  44         $call{$_} = 1 for split /\s+/, $line;
  45         delete $call{'ALL'};
  46
  47         my ($action, $count, $key, $data) = (0,0,0,0);
  48         unless (keys %call) {
  49                 for ($action = DXUser::R_FIRST, $count = 0; !$DXUser::dbm->seq($key, $data, $action); $action = DXUser::R_NEXT) {
  50                         if ($data =~ m{registered}) {
  51                                 $call{$key} = 1;       # possible candidate
  52                         }
  53                 }
  54         }
  55
  56         foreach $key (sort keys %call) {
  57                 my $u = DXUser::get_current($key);
  58                 if ($u && defined (my $r = $u->registered)) {
  59                         push @val, "${key}($r)";
  60                         ++$count;
  61                 }
  62         }
  63
  64         my @l;
  65         push @out, "Registration is " . ($main::reqreg ? "Required" :  "NOT Required");
  66         foreach my $call (@val) {
  67                 if (@l >= 5) {
  68                         push @out, sprintf "%-14s %-14s %-14s %-14s %-14s", @l;
  69                         @l = ();
  70                 }
  71                 push @l, $call;
  72         }
  73         if (@l) {
  74                 push @l, "" while @l < 5;
  75                 push @out, sprintf "%-14s %-14s %-14s %-14s %-14s", @l;
  76         }
  77
  78         push @out, $self->msg('rec', $count);
  79         return @out;
  80
  81 }
  82