X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=cmd%2Fshow%2Fqrz.pl;h=a5d14138c38a0a791e909801c181ac3c683cbcf0;hb=ed2d469812ca5ab82baab7f8b4795660e01ef539;hp=9a3f9c3fc93ed9dd334b64ac259c7e271ac7ae14;hpb=370d3563d7df44b754549330fb640051f7c31889;p=spider.git diff --git a/cmd/show/qrz.pl b/cmd/show/qrz.pl index 9a3f9c3f..a5d14138 100644 --- a/cmd/show/qrz.pl +++ b/cmd/show/qrz.pl @@ -17,50 +17,54 @@ return (1, "SHOW/QRZ , e.g. SH/QRZ g1tlh") unless @list; my $target = $Internet::http_proxy || $Internet::qrz_url || 'xml.qrz.com'; my $port = $Internet::http_proxy_port || 80; my $url = ''; -$url = 'http://' . ($Internet::qrz_url | 'xml.qrz.com') if $Internet::http_proxy; +$url = 'http://' . ($Internet::qrz_url || 'xml.qrz.com') if $Internet::http_proxy; +foreach $l (@list) { -use Net::Telnet; + my $host = $url?$url:$target; + my $s = "$url/xml?callsign=$l;username=$Internet::qrz_uid;password=$Internet::qrz_pw;agent=dxspider"; + if (isdbg('qrz')) { + dbg("qrz: $host"); + dbg("qrz: $s"); + } -my $t = new Net::Telnet; + Log('call', "$call: show/qrz \U$l"); + push @out, $self->msg('http1', "show/qrz \U$l"); -foreach $l (@list) { - eval { - $t->open(Host => $target, - Port => $port, - Timeout => 15); - }; + $self->http_get($host, $s, sub + { + my ($response, $header, $body) = @_; + my @out; - if (!$t || $@) { - push @out, $self->msg('e18', 'QRZ.com'); - } else { - my $s = "GET /xml?callsign=$l;username=$Internet::qrz_uid;password=$Internet::qrz_pw;agent=dxspider HTTP/1.0\n\n"; - dbg($s) if isdbg('qrz'); - $t->print($s); - Log('call', "$call: show/qrz \U$l"); - my $state = "blank"; - while (my $result = eval { $t->getline(Timeout => 30) } || $@) { - dbg($result) if isdbg('qrz') && $result; - if ($@) { - push @out, $self->msg('e18', 'QRZ.com'); - last; - } - if ($state eq 'blank' && $result =~ /^/i) { - $state = 'go'; - } elsif ($state eq 'go') { - next if $result =~ m||; - next if $result =~ m||; - next if $result =~ m||; - next if $result =~ m||; - next if $result =~ m||; - last if $result =~ m||; - my ($tag, $data) = $result =~ m|^\s*<(\w+)>(.*)close; - push @out, $self->msg('e3', 'qrz.com', uc $l) unless @out; - } + if (isdbg('qrz')) { + dbg("qrz response: $response"); + dbg("qrz body: $body"); + } + Log('call', "$call: show/qrz \U$body"); + my $state = "blank"; + foreach my $result (split /\r?\n/, $body) { + dbg("qrz: $result") if isdbg('qrz') && $result; + if ($state eq 'blank' && $result =~ /^/i) { + $state = 'go'; + } elsif ($state eq 'go') { + next if $result =~ m||; + next if $result =~ m||; + next if $result =~ m||; + next if $result =~ m||; + next if $result =~ m||; + last if $result =~ m||; + my ($tag, $data) = $result =~ m|^\s*<(\w+)>(.*)msg('http2', "show/qrz \U$l"); + } else { + push @out, $self->msg('e3', 'show/qrz', uc $l); + } + $self->send_ans(@out); + } + ); } return (1, @out);