lib/ZOOM/IRSpy/Connection.pm

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