cmd/show/rbn.pl

   1 #
   2 # show/node [<node> | <node> ]
   3 #
   4 # This command either lists all nodes known about
   5 # or the ones specified on the command line together
   6 # with some information that is relavent to them
   7 #
   8 # This command isn't and never will be compatible with AK1A
   9 #
  10 # A special millenium treat just for G4PDQ
  11 #
  12 # Copyright (c) 2000 Dirk Koopman G1TLH
  13 #
  14 #
  15 #
  16
  17 my ($self, $line) = @_;
  18 return (1, $self->msg('e5')) unless $self->priv >= 1;
  19
  20 my @call = map {uc $_} split /\s+/, $line;
  21 my @out;
  22 my $count;
  23
  24 # search thru the user
  25 if (@call == 0) {
  26         @call = map{$_->call} grep {$_->user->call && $_->user->wantrbn} DXChannel::get_all_users();
  27 } elsif ($call[0] eq 'ALL') {
  28         shift @call;
  29         my ($action, $key, $data) = (0,0,0);
  30         for ($action = DXUser::R_FIRST, $count = 0; !$DXUser::dbm->seq($key, $data, $action); $action = DXUser::R_NEXT) {
  31                 if (is_callsign($key)) {
  32                         if ($data =~ /"sort":"[UW]"/  && $data =~ /"wantrbn":1/) {
  33                                 push @call, $key;
  34                         }
  35                 }
  36         }
  37 }
  38
  39 push @out, join(' ', $self->msg('rbnusers'), $main::mycall);
  40 my @l;
  41
  42 foreach my $call (@call) {
  43         push @l, $call;
  44         if (@l >= 5) {
  45                 push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l;
  46                 @l = ();
  47         }
  48         ++$count;
  49 }
  50 push @l, "" while @l < 5;
  51 push @out, sprintf "%-12s %-12s %-12s %-12s %-12s", @l;
  52
  53
  54 return (1, @out, $self->msg('rec', $count));
  55
  56
  57
  58