]> scm.dxcluster.org Git - spider.git/blob - cmd/show/ik3qar.pl
added support for subroutines in commands
[spider.git] / cmd / show / ik3qar.pl
1 #
2 # Query the IK3QAR Database server for a callsign
3 #
4 # from an idea by Paolo,IK3QAR and Leo,IZ5FSA
5 #
6 # $Id$
7 #
8 my ($self, $line) = @_;
9 my @list = map {uc} split /\s+/, $line;               # generate a list of callsigns
10 my $op;
11 my $call = $self->call;
12 my @out;
13
14 return (1, $self->msg('e24')) unless $Internet::allow;
15 return (1, "SHOW/IK3QAR <callsign>\n  e.g. SH/IK3QAR II5I, SH/IK3QAR V51AS\n") unless @list;
16
17 my $target = $Internet::ik3qar_url;
18 my $port = 80;
19 my $url = "http://".$target;
20
21 use Net::Telnet;
22 my $t = new Net::Telnet;
23 eval {$t->open( Host     => $target,
24                 Port     => $port,
25                 Timeout  => 30);
26 };
27
28 if (!$t || $@) {
29         push @out, $self->msg('e18', 'Open(IK3QAR.it)');
30 } else {
31         dbg($list[0]."|".$list[1]) if isdbg('IK3QAR');
32         $op="call=".$list[0]."&node=".$main::mycall."&passwd=".$Internet::ik3qar_pw."&user=".$call;
33         my $s = "GET $url/manager/dxc/dxcluster.php?$op HTTP/1.0\n"
34        ."User-Agent:DxSpider;$main::version;$main::build;$^O;$main::mycall;$call\n\n";
35         dbg($s) if isdbg('IK3QAR');
36         $t->print($s);
37         Log('call', "$call: SH/IK3QAR $list[0]");
38         my $state = "blank";
39         my $count = 1;
40         while (my $result = eval { $t->getline(Timeout => 30) } || $@) {
41                 dbg($result) if isdbg('IK3QAR') && $result;
42                 ++$count;
43                 if ($count > 9) {
44                         push @out, $result;
45                 }
46         }
47         $t->close;
48         push @out, $self->msg('e3', 'Search(IK3QAR.it)', uc $list[0]) unless @out;
49 }
50
51 return (1, @out);