lib/ZOOM/IRSpy/Connection.pm

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