[Dxspider-support] XML interface for qrz.com

[Ricardo Suarez]

Hi, all

As requested by Enzo, IK6IHL, I write the xml interface for qrz.com.

The script, cut and paste it, are named qrz.pl, you need to copy it to 
/spider/local_cmd/show/ and to pay the xml access fee to qrz.com's owner.

It need for WWW::mechanize and if you not copy it to the right directory, 
you need to change the two lines in reference to the file KEY.txt.

In  KEY.txt file the script write the xml key, if the directory its ok, the 
file KEY.txt are created automatically, if not, it aborts with a 
"permissions" error.

I not agree to pay for the information, but understand the costs of mantain 
a server. In this case, because my script is  for a not free access to 
database, I not support it.

I write it because I like to program in perl. It is shared as-is, I are 100% 
sure it works today, but not ask me if tomorrow not works  ;-) .

Regards

Rick LU9DA



#begin of the script, place it in /spider/local_cmd/show/qrz.pl

#
# Query the QRZ Database server for a callsign
#
# from an idea by Steve Franke K9AN and information from Angel EA7WA
#
# Copyright (c) 2001 Dirk Koopman G1TLH
#
# modified on 10/6/2009 by Ricardo Suarez LU9DA to work with QRZ.COM xml
#
# interface, by request from Enzo, IK6IHL.
#
# need for WWW:Mechanize ! download it from CPAN
#
# remember to change $password and $username for yours!
#
#############################################################################
#
# NOTE: xml access to QRZ.COM is under payment to QRZ.COM's owner, need for
#
# user and password, I NOT SEND YOU THE PASS/USR, ask QRZ.COM's owner.
#
# I NOT SUPPORT this script, are a gift for Enzo, if not works as you want,
#
# you can modify it for your needs or erase it from your box, but NOT ASK 
ME.
#
#############################################################################


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 $linea;
my $flag;
my $temp;
my $password = "yourpass";
my $username = "yourcall";

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



#...............................


open KEY, "/spider/local_cmd/show/KEY.txt" or &key;

#...............................


my($key) = <KEY>;

close KEY;

chomp($key);

if ($key eq ""){

    $key = &key;

    }

$url = "http://www.qrz.com/xml?s=$key;callsign=@list";

my $mechanize = WWW::Mechanize->new(autocheck => 1);

$mechanize->get($url);

my $page = $mechanize->content;

my @tabla = split('\n', $page);

$flag = 1;

foreach $linea (@tabla) {

 if ($linea =~ m/Error/){

  $linea =~ s/<Error>//g;

  $linea =~ s/<\/Error>//g;


  if ($linea =~ m/found/){

       push @out,"QRZ.COM return: $linea - please retry\n";

   $flag = 0;

   }

  if ($linea =~ m/Timeout/){

       push @out,"QRZ.COM return: $linea - please retry now\n";

   &key;

   }

  if ($linea =~ m/Invalid/){

       push @out,"QRZ.COM return: $linea - please retry now\n";

   &key;

   }

  if ($linea =~ m/refused/){

       push @out,"Service unavailable caused by QRZ.COM\n";

   push @out,"ask AA7BQ why, not the writer of the script! :-)))\n"

   }

  }

 }

if ($flag eq 1){

 foreach $linea (@tabla) {

  if ($linea =~ m/call/){

      if ($linea =~ m/p_call/){

   }else{

   $linea =~ s/<call>//;

   $linea =~ s/<\/call>//;

       push @out,"$linea\n";

   }
  }

  if ($linea =~ m/fname/){

   $linea =~ s/<fname>//;

   $linea =~ s/<\/fname>//;


   $temp = "$linea ";

   }

  if ($linea =~ m/name/){

   $linea =~ s/<name>//;

   $linea =~ s/<\/name>//;

       push @out,"$temp$linea\n";

   }

  if ($linea =~ m/addr1/){

   $linea =~ s/<addr1>//;

   $linea =~ s/<\/addr1>//;

       push @out,"$linea\n";

   }

  if ($linea =~ m/addr2/){

   $linea =~ s/<addr2>//;

   $linea =~ s/<\/addr2>//;

       push @out,"$linea\n";

   }

  if ($linea =~ m/state/){

   $linea =~ s/<state>//;

   $linea =~ s/<\/state>//;

       $temp = "STATE = $linea ";

   }


  if ($linea =~ m/zip/){

   $linea =~ s/<zip>//;

   $linea =~ s/<\/zip>//;

       push @out,"$temp- ZIP CODE = $linea\n";

   }

  if ($linea =~ m/country/){

   $linea =~ s/<country>//;

   $linea =~ s/<\/country>//;

       push @out,"$linea\n";

   }

  if ($linea =~ m/grid/){

   $linea =~ s/<grid>//;

   $linea =~ s/<\/grid>//;

       push @out,"LOCATOR = $linea\n";

   }

  if ($linea =~ m/qslmgr/){

   $linea =~ s/<qslmgr>//;

   $linea =~ s/<\/qslmgr>//;

       push @out,"QSL VIA = $linea\n";

   }

  }

 }


sub key {

$url = 
"http://www.qrz.com/xml?username=$username;password=$password;agent=q5.0";

my $mechanize = WWW::Mechanize->new(autocheck => 1);

$mechanize->get($url);

my $page = $mechanize->content;

my @tabla = split('\n', $page);

foreach $linea (@tabla) {

 if ($linea =~ m/Key/){

  $linea =~ s/<Key>//g;

  $linea =~ s/<\/Key>//g;

#...............................

  open KEY, ">/spider/local_cmd/show/KEY.txt" or die $!;

#...............................

  print KEY $linea;

  close KEY;

  return "$linea";

     }

 }

}


return (1, @out);


# end of the script