irspy.pl

   1 #!/usr/bin/perl -w
   2
   3 # $Id: irspy.pl,v 1.1 2006-05-18 11:45:16 mike Exp $
   4 #
   5 # Run like this:
   6 #       YAZ_LOG=irspy perl -I lib irspy.pl -t "bagel.indexdata.dk/gils z3950.loc.gov:7090/Voyager" localhost:1313/IR-Explain---1
   7
   8 use strict;
   9 use warnings;
  10 use Getopt::Std;
  11 use ZOOM::Pod;
  12
  13 my %opts;
  14 if (!getopts('t:au', \%opts) || @ARGV != 1) {
  15     print STDERR qq[Usage: $0 [options] <IRSpy-database>
  16         -t <t1 t2 ...>  Space-separated list of targets to check
  17         -a              Check all targets registered in database
  18         -u              Update information in database
  19 ];
  20     exit 1;
  21 }
  22
  23 my $targetList = $opts{t};
  24 my $allTargets = $opts{a};
  25 if (!$targetList && !$allTargets) {
  26     print STDERR "$0: neither -t nor -a specified\n";
  27     exit 2;
  28 }
  29
  30
  31 ZOOM::Log::mask_str("irspy");
  32 sub zlog { ZOOM::Log::log(@_) }
  33
  34 my $dbname = $ARGV[0];
  35 my $conn = new ZOOM::Connection($dbname)
  36     or die "$0: can't connection to IRSpy database 'dbname'";
  37 zlog("irspy", "starting up with database '$dbname'");
  38
  39 my $query;
  40 if ($allTargets) {
  41     # According to the BIB-1 semantics document at
  42     #   http://www.loc.gov/z3950/agency/bib1.html
  43     # the query
  44     #   @attr 2=103 @attr 1=1035 x
  45     # should find all records.  But it seems that Zebra doesn't
  46     # support this.  Furthermore, when using the "alvis" filter (as we
  47     # do for IRSpy) it doesn't support the use of any BIB-1 access
  48     # point -- not even 1035 "everywhere" -- so instead we hack
  49     # together a search that we know will find all records:
  50     $query = "port=?*";
  51 } else {
  52     my @qlist;
  53     foreach my $target (split /\s+/, $targetList) {
  54         my($host, $port, $db) = ($target =~ /(.*?):(.*?)\/(.*)/);
  55         if (!defined $host) {
  56             $port = 210;
  57             ($host, $db) = ($target =~ /(.*?)\/(.*)/);
  58         }
  59         die "invalid target string '$target'"
  60             if !defined $host;
  61         push @qlist, (qq[(host = "$host" and port = "$port" and path="$db")]);
  62     }
  63     $query = join(" or ", @qlist);
  64 }
  65
  66 my $rs = $conn->search(new ZOOM::Query::CQL($query));
  67 print "query is: $query\n";
  68 print "found ", $rs->size(), " records\n";
  69 exit;
  70
  71 my $pod = new ZOOM::Pod(@ARGV);
  72 $pod->option(elementSetName => "b");
  73 $pod->callback(ZOOM::Event::RECV_SEARCH, \&completed_search);
  74 $pod->callback(ZOOM::Event::RECV_RECORD, \&got_record);
  75 #$pod->callback(exception => \&exception_thrown);
  76 $pod->search_pqf("the");
  77 my $err = $pod->wait();
  78 die "$pod->wait() failed with error $err" if $err;
  79
  80 sub completed_search {
  81     my($conn, $state, $rs, $event) = @_;
  82     print $conn->option("host"), ": found ", $rs->size(), " records\n";
  83     $state->{next_to_fetch} = 0;
  84     $state->{next_to_show} = 0;
  85     request_records($conn, $rs, $state, 2);
  86     return 0;
  87 }
  88
  89 sub got_record {
  90     my($conn, $state, $rs, $event) = @_;
  91
  92     {
  93         # Sanity-checking assertions.  These should be impossible
  94         my $ns = $state->{next_to_show};
  95         my $nf = $state->{next_to_fetch};
  96         if ($ns > $nf) {
  97             die "next_to_show > next_to_fetch ($ns > $nf)";
  98         } elsif ($ns == $nf) {
  99             die "next_to_show == next_to_fetch ($ns)";
 100         }
 101     }
 102
 103     my $i = $state->{next_to_show}++;
 104     my $rec = $rs->record($i);
 105     print $conn->option("host"), ": record $i is ", render_record($rec), "\n";
 106     request_records($conn, $rs, $state, 3)
 107         if $i == $state->{next_to_fetch}-1;
 108
 109     return 0;
 110 }
 111
 112 sub exception_thrown {
 113     my($conn, $state, $rs, $exception) = @_;
 114     print "Uh-oh!  $exception\n";
 115     return 0;
 116 }
 117
 118 sub request_records {
 119     my($conn, $rs, $state, $count) = @_;
 120
 121     my $i = $state->{next_to_fetch};
 122     ZOOM::Log::log("irspy", "requesting $count records from $i");
 123     $rs->records($i, $count, 0);
 124     $state->{next_to_fetch} += $count;
 125 }
 126
 127 sub render_record {
 128     my($rec) = @_;
 129
 130     return "undefined" if !defined $rec;
 131     return "'" . $rec->render() . "'";
 132 }