[Dxspider-support] QRZ.PL rewrite

[IZ5FSA]

I'm working on previous QRZ.pl Ricardo's script.
This is the file.
It seems to work fine on IZ5FSA-6 (iz5fsa.homedns.org:8000).
Feel free to use and improve it.
If any sysop improve the script, please, tell us on the list!!!
If I have time, I'll try not to use mechanize lib.
------------------------------
Sto ancora lavorando sul comando QRZ.pl di Ricardo.
Ecco di seguito il file.
Sembra funzionare bene su IZ5FSA-6 (iz5fsa.homedns.org:8000)
Usatelo e miglioratelo.
I sysop che lo modificano, per favore, lo dicano in lista!!!
Se avrò tempo cercherò di usare un metodo che non usi la lib mechanize.


73s de Leo, IZ5FSA



###########
#
# Query the QRZ Database server for a callsign
#
# Copyright (c) 2001 Dirk Koopman G1TLH
#
# modified on 5/13/2009 Ricardo Suarez LU9DA to work with the new
QRZ.COM style
# modified on September, 6th 2009 by IZ5FSA
#
# need for WWW:Mechanize ! download it from CPAN
#
# working under test on IZ5FSA-6 cluster (iz5fsa.homedns.org:8000)

use WWW::Mechanize;

my ($self, $line) = @_;
my @list = split /\s+/, $line; # generate a list of callsigns
my $l;
my $call = $self->call;
my @out;
my $url; 
my $page;
my $count;
my $linea;
my $indx;

return (1, $self->msg('e24')) unless $Internet::allow;
return (1, "SHOW/QRZ <callsign>, e.g. SH/QRZ W1AW") unless @list;

my $url = "http://qrz.com/db/@list";
 
my $mechanize = WWW::Mechanize->new(autocheck => 1);
$mechanize->get($url);
$page = $mechanize->content;

my @tabla = split(/\n/, $page);
foreach $linea (@tabla) {
 if ($linea =~ m/class="csignm"/) {
  $linea =~ s/<[a-z|A-Z|0-9|"|=|(|)|\/|\s]+>//g;
  push @out, $linea;
 }
 if ($linea =~ m/class="i/) {
  $linea =~ s/<[a-z|A-Z|0-9|"|=|(|)|\/|\s]+>//g;
  $linea =~ s/^[a-z|A-Z|0-9]+\s[a-z|A-Z|0-9]+\s[a-z|A-Z|0-9]+$//g;
  push @out, $linea;
 }
 if ($linea =~ m/QSL Info:/) {
  $linea =~ s/<tr><td class=\"dh\">//;
  $linea =~ s/<\/td><td class=\"dw\">//;
  $linea =~ s/<\/td><\/td>//;
  push @out, $linea;
 }
 if ($linea =~ m/Previous:/) {
  $linea =~ s/<tr><td class=\"dh\">//;
  $linea =~ s/<\/td><td class=\"di\">//;
  $linea =~ s/<\/td><\/td>//;
  push @out, $linea;
 }
 if ($linea =~ m/Grid Square:/) {
  $linea =~ s/<tr><td class=\"dh\">//;
  $linea =~ s/<\/td><td class=\"di\">//;
  $linea =~ s/<\/td><\/td>//;
  push @out, "\n$linea";
 }
}
return (1, @out);