lib/ZOOM/IRSpy/Connection.pm

   1 # $Id: Connection.pm,v 1.20 2007-12-20 12:31:09 mike Exp $
   2
   3 package ZOOM::IRSpy::Connection;
   4
   5 use 5.008;
   6 use strict;
   7 use warnings;
   8
   9 use ZOOM;
  10 our @ISA = qw(ZOOM::Connection);
  11
  12 use ZOOM::IRSpy::Record;
  13 use ZOOM::IRSpy::Utils qw(cql_target render_record irspy_identifier2target);
  14
  15 use ZOOM::IRSpy::Task::Connect;
  16 use ZOOM::IRSpy::Task::Search;
  17 use ZOOM::IRSpy::Task::Retrieve;
  18
  19
  20 =head1 NAME
  21
  22 ZOOM::IRSpy::Connection - ZOOM::Connection subclass with IRSpy functionality
  23
  24 =head1 DESCRIPTION
  25
  26 This class provides some additional private data and methods that are
  27 used by IRSpy but which would be useless in any other application.
  28 Keeping the private data in these objects removes the need for ugly
  29 mappings in the IRSpy object itself; adding the methods makes the
  30 application code cleaner.
  31
  32 The constructor takes an two additional leading arguments: a reference
  33 to the IRSpy object that it is associated with, and the target ID of
  34 the connection.
  35
  36 =cut
  37
  38 sub create {
  39     my $class = shift();
  40     my $irspy = shift();
  41     my $id = shift();
  42
  43     my $this = $class->SUPER::create(@_);
  44     my $target = irspy_identifier2target($id);
  45     $this->option(host => $target);
  46     $this->{irspy} = $irspy;
  47     $this->{tasks} = [];
  48
  49     my $query = cql_target($id);
  50     my $rs;
  51     eval {
  52         $rs = $irspy->{conn}->search(new ZOOM::Query::CQL($query));
  53     }; if ($@) {
  54         # This should be a "can't happen", but junk entries such as
  55         #       //lucasportal.info/blogs/payday-usa">'</a>night:G<a href="http://lucasportal.info/blogs/payday-usa">'</a>night/Illepeliz
  56         # (yes, really) yield BIB-1 diagnostic 108 "Malformed query"
  57         warn "registry search for record '$id' had error: '$@'";
  58         return undef;
  59     }
  60     my $n = $rs->size();
  61     $this->log("irspy", "query '$query' found $n record", $n==1 ? "" : "s");
  62     ### More than 1 hit is always an error and indicates duplicate
  63     #   records in the database; no hits is fine for a new target
  64     #   being probed for the first time, but not if the connection is
  65     #   being created as part of an "all known targets" scan.
  66     my $zeerex;
  67     $zeerex = render_record($rs, 0, "zeerex") if $n > 0;
  68     $this->{record} = new ZOOM::IRSpy::Record($this, $target, $zeerex);
  69
  70     return $this;
  71 }
  72
  73
  74 sub destroy {
  75     my $this = shift();
  76     $this->SUPER::destroy(@_);
  77 }
  78
  79
  80 sub irspy {
  81     my $this = shift();
  82     return $this->{irspy};
  83 }
  84
  85
  86 sub record {
  87     my $this = shift();
  88     my($new) = @_;
  89
  90     my $old = $this->{record};
  91     $this->{record} = $new if defined $new;
  92     return $old;
  93 }
  94
  95
  96 sub tasks {
  97     my $this = shift();
  98
  99     return $this->{tasks};
 100 }
 101
 102
 103 sub current_task {
 104     my $this = shift();
 105     my($new) = @_;
 106
 107     my $old = $this->{current_task};
 108     if (defined $new) {
 109         $this->{current_task} = $new;
 110         $this->log("irspy_task", "set current task to $new");
 111     }
 112
 113     return $old;
 114 }
 115
 116
 117 sub next_task {
 118     my $this = shift();
 119     my($new) = @_;
 120
 121     my $old = $this->{next_task};
 122     if (defined $new) {
 123         $this->{next_task} = $new;
 124         $this->log("irspy_task", "set next task to $new");
 125     }
 126
 127     return $old;
 128 }
 129
 130
 131 sub log {
 132     my $this = shift();
 133     my($level, @msg) = @_;
 134
 135     $this->irspy()->log($level, $this->option("host"), " ", @msg);
 136 }
 137
 138
 139 sub irspy_connect {
 140     my $this = shift();
 141     my($udata, $options, %cb) = @_;
 142
 143     $this->add_task(new ZOOM::IRSpy::Task::Connect
 144                     ($this, $udata, $options, %cb));
 145 }
 146
 147
 148 sub irspy_search {
 149     my $this = shift();
 150     my($qtype, $qstr, $udata, $options, %cb) = @_;
 151
 152     #warn "calling $this->irspy_search(", join(", ", @_), ")\n";
 153     $this->add_task(new ZOOM::IRSpy::Task::Search
 154                     ($qtype, $qstr, $this, $udata, $options, %cb));
 155 }
 156
 157
 158 # Wrapper for backwards compatibility
 159 sub irspy_search_pqf {
 160     my $this = shift();
 161     return $this->irspy_search("pqf", @_);
 162 }
 163
 164
 165 sub irspy_rs_record {
 166     my $this = shift();
 167     my($rs, $index0, $udata, $options, %cb) = @_;
 168
 169     $this->add_task(new ZOOM::IRSpy::Task::Retrieve
 170                     ($rs, $index0, $this, $udata, $options, %cb));
 171 }
 172
 173
 174 sub add_task {
 175     my $this = shift();
 176     my($task) = @_;
 177
 178     my $tasks = $this->{tasks};
 179     $tasks->[-1]->{next} = $task if @$tasks > 0;
 180     push @$tasks, $task;
 181     $this->log("irspy_task", "added task $task");
 182 }
 183
 184
 185 sub render {
 186     my $this = shift();
 187     return ref($this) . "(" . $this->option("host") . ")";
 188 }
 189
 190 use overload '""' => \&render;
 191
 192
 193 =head1 SEE ALSO
 194
 195 ZOOM::IRSpy
 196
 197 =head1 AUTHOR
 198
 199 Mike Taylor, E<lt>mike@indexdata.comE<gt>
 200
 201 =head1 COPYRIGHT AND LICENSE
 202
 203 Copyright (C) 2006 by Index Data ApS.
 204
 205 This library is free software; you can redistribute it and/or modify
 206 it under the same terms as Perl itself, either Perl version 5.8.7 or,
 207 at your option, any later version of Perl 5 you may have available.
 208
 209 =cut
 210
 211 1;