hamradio/spider
1
0
Fork 0
mirror of git://scm.dxcluster.org/scm/spider synced 2024-09-21 07:47:10 +00:00
Code Issues Packages Projects Releases Wiki Activity

make sh/contest async

Browse Source
This commit is contained in:
Dirk Koopman 2011-12-27 15:19:34 +00:00
parent ed2d469812
commit 209156e38a
6 changed files with 47 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
cmd/show/contest.pl
View File

@ -13,7 +13,7 @@ my ($self, $line) = @_;
my @out;
my $mon;;
my $mon;
# trying to make the syntax abit more user friendly...
# and yes, I have been here and it *is* all my fault (dirk)
@ -40,32 +40,22 @@ my $port = 80;
my $url = $Internet::contest_url || "http://www.sk3bg.se/contest/text";
$url .= "/$filename";
my $t = new Net::Telnet (Telnetmode => 0);
eval {
$t->open(Host => $host, Port => $port, Timeout => 15);
};
push @out, $self->msg('http1', 'sk3bg.se', "$filename");
if (!$t || $@) {
push @out, $self->msg('e18','sk3bg.se');
} else {
my $s = "GET $url";
$t->print($s);
my $notfound = $t->getline(Timeout => 10);
if ($notfound =~ /404 Object Not Found/) {
return (1, "there is no contest info for $mon")
} else {
push @out, $notfound;
}
while (!$t->eof) {
eval {
push @out, $t->getline(Timeout => 10);
};
if ($@) {
push @out, $self->msg('e18', 'sk3bg.se');
last;
}
}
}
$t->close;
$self->http_get($host, $url, sub
{
my ($response, $header, $body) = @_;
my @out;
if ($response =~ /^4/) {
push @out, "There is no contest info $mon";
} elsif ($response =~ /^5/) {
push @out, $self->msg('e18','sk3bg.se');
} else {
push @out, split /\r?\n/, $body;
}
$self->send_ans(@out);
}
);
return (1, @out);

46
cmd/show/qrz.pl
View File

@ -29,7 +29,7 @@ foreach $l (@list) {
}
Log('call', "$call: show/qrz \U$l");
push @out, $self->msg('http1', "show/qrz \U$l");
push @out, $self->msg('http1', 'qrz.com', "\U$l");
$self->http_get($host, $s, sub
{
@ -40,27 +40,31 @@ foreach $l (@list) {
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 =~ /^<Callsign>/i) {
$state = 'go';
} elsif ($state eq 'go') {
next if $result =~ m|<user>|;
next if $result =~ m|<u_views>|;
next if $result =~ m|<locref>|;
next if $result =~ m|<ccode>|;
next if $result =~ m|<dxcc>|;
last if $result =~ m|</Callsign>|;
my ($tag, $data) = $result =~ m|^\s*<(\w+)>(.*)</|;
push @out, sprintf "%10s: $data", $tag;
}
}
if (@out) {
unshift @out, $self->msg('http2', "show/qrz \U$l");
if ($response =~ /^5/) {
push @out, $self->msg('e18',"qrz.com $!");
} else {
push @out, $self->msg('e3', 'show/qrz', uc $l);
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 =~ /^<Callsign>/i) {
$state = 'go';
} elsif ($state eq 'go') {
next if $result =~ m|<user>|;
next if $result =~ m|<u_views>|;
next if $result =~ m|<locref>|;
next if $result =~ m|<ccode>|;
next if $result =~ m|<dxcc>|;
last if $result =~ m|</Callsign>|;
my ($tag, $data) = $result =~ m|^\s*<(\w+)>(.*)</|;
push @out, sprintf "%10s: $data", $tag;
}
}
if (@out) {
unshift @out, $self->msg('http2', "show/qrz \U$l");
} else {
push @out, $self->msg('e3', 'show/qrz', uc $l);
}
}
$self->send_ans(@out);
}

3
cmd/show/wm7d.pl
View File

@ -21,7 +21,8 @@ my $port = 5000;
my $cmdprompt = '/query->.*$/';
my($info, $t);
use Net::Telnet;
$t = new Net::Telnet;
$info = $t->open(Host => $target,
Port => $port,

1
perl/DXCommandmode.pm
View File

@ -36,7 +36,6 @@ use WCY;
use Sun;
use Internet;
use Script;
use Net::Telnet;
use QSL;
use DB_File;
use VE7CC;

2
perl/Messages
View File

@ -150,7 +150,7 @@ package DXM;
hnodee1 => 'Please enter your Home Node, set/homenode <your home DX Cluster>',
hnodee2 => 'Failed to set homenode on $_[0]',
hnode => 'Your Homenode is now \"$_[0]\"',
http1 => '$_[0] working ...',
http1 => 'Searching $_[0] for $_[1] ...',
http2 => '$_[0] returned:',
init1 => 'sent initialisation message to $_[0]',
iso => '$_[0] Isolated',

4
perl/Version.pm
View File

@ -11,7 +11,7 @@ use vars qw($version $subversion $build $gitversion);
$version = '1.56';
$subversion = '0';
$build = '10';
$gitversion = '370d356';
$build = '11';
$gitversion = 'ed2d469';
1;