[Dxspider-support] Fwd: SH/QRZ not working

[IZ5FSA Leonardo]

I hope this can help someone.



*73 de Leo, IZ5FSA*

---------- Forwarded message ----------
From: IZ5FSA <iz5fsa at gmail.com>
Date: 2015-08-12 19:58 GMT+02:00
Subject: SH/QRZ not working
To: djk at tobit.co.uk


So I have discovered this command:
SH/XQRZ < call>
using libwww-mechanize-perl on IR5AG-6 over raspberry

#uname-a
Linux leonardinux 3.18.11-v7+ #781 SMP PREEMPT Tue Apr 21 18:07:59 BST 2015
armv7l GNU/Linux

I've attached the source. If it can interest, feel free to integrate into
DxSpider and distribute to the DxSpider community. it works!

-- 


73 de Leo IZ5FSA



#############################################################################
#
# 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 = "password";
my $username = "USER";

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"
<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";
     }
   }
}

#
# QRZ.com Key Account
#
sub key {
  $url = "http://www.qrz.com/xml?username=$username;password=$password;agent=q5.0"
<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);
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mailman.tobit.co.uk/pipermail/dxspider-support/attachments/20150902/1fc82859/attachment-0001.html>