lib/ZOOM/IRSpy/Connection.pm

   1 # $Id: Connection.pm,v 1.18 2007-12-12 10:47:21 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 = $irspy->{conn}->search(new ZOOM::Query::CQL($query));
  51     my $n = $rs->size();
  52     $this->log("irspy", "query '$query' found $n record", $n==1 ? "" : "s");
  53     ### More than 1 hit is always an error and indicates duplicate
  54     #   records in the database; no hits is fine for a new target
  55     #   being probed for the first time, but not if the connection is
  56     #   being created as part of an "all known targets" scan.
  57     my $zeerex;
  58     $zeerex = render_record($rs, 0, "zeerex") if $n > 0;
  59     $this->{record} = new ZOOM::IRSpy::Record($this, $target, $zeerex);
  60
  61     return $this;
  62 }
  63
  64
  65 sub destroy {
  66     my $this = shift();
  67     $this->SUPER::destroy(@_);
  68 }
  69
  70
  71 sub irspy {
  72     my $this = shift();
  73     return $this->{irspy};
  74 }
  75
  76
  77 sub record {
  78     my $this = shift();
  79     my($new) = @_;
  80
  81     my $old = $this->{record};
  82     $this->{record} = $new if defined $new;
  83     return $old;
  84 }
  85
  86
  87 sub tasks {
  88     my $this = shift();
  89
  90     return $this->{tasks};
  91 }
  92
  93
  94 sub current_task {
  95     my $this = shift();
  96     my($new) = @_;
  97
  98     my $old = $this->{current_task};
  99     if (defined $new) {
 100         $this->{current_task} = $new;
 101         $this->log("irspy_task", "set current task to $new");
 102     }
 103
 104     return $old;
 105 }
 106
 107
 108 sub next_task {
 109     my $this = shift();
 110     my($new) = @_;
 111
 112     my $old = $this->{next_task};
 113     if (defined $new) {
 114         $this->{next_task} = $new;
 115         $this->log("irspy_task", "set next task to $new");
 116     }
 117
 118     return $old;
 119 }
 120
 121
 122 sub log {
 123     my $this = shift();
 124     my($level, @msg) = @_;
 125
 126     $this->irspy()->log($level, $this->option("host"), " ", @msg);
 127 }
 128
 129
 130 sub irspy_connect {
 131     my $this = shift();
 132     my($udata, $options, %cb) = @_;
 133
 134     $this->add_task(new ZOOM::IRSpy::Task::Connect
 135                     ($this, $udata, $options, %cb));
 136 }
 137
 138
 139 sub irspy_search {
 140     my $this = shift();
 141     my($qtype, $qstr, $udata, $options, %cb) = @_;
 142
 143     #warn "calling $this->irspy_search(", join(", ", @_), ")\n";
 144     $this->add_task(new ZOOM::IRSpy::Task::Search
 145                     ($qtype, $qstr, $this, $udata, $options, %cb));
 146 }
 147
 148
 149 # Wrapper for backwards compatibility
 150 sub irspy_search_pqf {
 151     my $this = shift();
 152     return $this->irspy_search("pqf", @_);
 153 }
 154
 155
 156 sub irspy_rs_record {
 157     my $this = shift();
 158     my($rs, $index0, $udata, $options, %cb) = @_;
 159
 160     $this->add_task(new ZOOM::IRSpy::Task::Retrieve
 161                     ($rs, $index0, $this, $udata, $options, %cb));
 162 }
 163
 164
 165 sub add_task {
 166     my $this = shift();
 167     my($task) = @_;
 168
 169     my $tasks = $this->{tasks};
 170     $tasks->[-1]->{next} = $task if @$tasks > 0;
 171     push @$tasks, $task;
 172     $this->log("irspy_task", "added task $task");
 173 }
 174
 175
 176 sub render {
 177     my $this = shift();
 178     return ref($this) . "(" . $this->option("host") . ")";
 179 }
 180
 181 use overload '""' => \&render;
 182
 183
 184 =head1 SEE ALSO
 185
 186 ZOOM::IRSpy
 187
 188 =head1 AUTHOR
 189
 190 Mike Taylor, E<lt>mike@indexdata.comE<gt>
 191
 192 =head1 COPYRIGHT AND LICENSE
 193
 194 Copyright (C) 2006 by Index Data ApS.
 195
 196 This library is free software; you can redistribute it and/or modify
 197 it under the same terms as Perl itself, either Perl version 5.8.7 or,
 198 at your option, any later version of Perl 5 you may have available.
 199
 200 =cut
 201
 202 1;