added show/node for G4PDQ
[spider.git] / cmd / show / node.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 # $Id$
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
23 # search thru the user for nodes
24 unless (@call) {
25         @call = sort map { my $ref; (($ref = DXUser->get_current($_)) && $ref->sort ne 'U') ? $_ : () } DXUser::get_all_calls;
26 }
27
28 my $call;
29 foreach $call (@call) {
30         my $clref = DXCluster->get_exact($call);
31         my $uref = DXUser->get_current($call);
32         my ($sort, $ver);
33         
34         my $pcall = sprintf "%-11s", $call;
35         push @out, $self->msg('snode1') unless @out > 0;
36         if ($uref) {
37                 $sort = "Spider" if $uref->sort eq 'S';
38                 $sort = "AK1A  " if $uref->sort eq 'A';
39                 $sort = "clx   " if $uref->sort eq 'C';
40                 $sort = "Fred  " if $uref->sort eq 'U';
41                 $sort = "BBS   " if $uref->sort eq 'B';
42         } else {
43                 push @out, $self->msg('snode3', $call);
44                 next;
45         }
46         if ($call eq $main::mycall) {
47                 $sort = "Spider";
48                 $ver = $main::version;
49         } else {
50                 $ver = $clref->pcversion if $clref && $clref->pcversion;
51         }
52         
53         my ($major, $minor, $subs) = unpack("AAA*", $ver) if $ver;
54         if ($sort eq 'Spider') {
55                 push @out, $self->msg('snode2', $pcall, $sort, "$ver  ");
56         } else {
57                 push @out, $self->msg('snode2', $pcall, $sort, $ver ? "$major\-$minor.$subs" : "      ");
58         }
59 }
60
61 return (1, @out);