lib/ZOOM/IRSpy/Connection.pm

   1 # $Id: Connection.pm,v 1.11 2007-03-15 11:37:30 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);
  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 $target = shift();
  42
  43     my $this = $class->SUPER::create(@_);
  44     $this->option(host => $target);
  45     $this->{irspy} = $irspy;
  46     $this->{tasks} = [];
  47
  48     my $query = cql_target($target);
  49     my $rs = $irspy->{conn}->search(new ZOOM::Query::CQL($query));
  50     my $n = $rs->size();
  51     $this->log("irspy", "query '$query' found $n records");
  52     my $zeerex;
  53     $zeerex = render_record($rs, 0, "zeerex") if $n > 0;
  54     $this->{record} = new ZOOM::IRSpy::Record($this, $target, $zeerex);
  55
  56     return $this;
  57 }
  58
  59
  60 sub destroy {
  61     my $this = shift();
  62     $this->SUPER::destroy(@_);
  63 }
  64
  65
  66 sub irspy {
  67     my $this = shift();
  68     return $this->{irspy};
  69 }
  70
  71
  72 sub record {
  73     my $this = shift();
  74     my($new) = @_;
  75
  76     my $old = $this->{record};
  77     $this->{record} = $new if defined $new;
  78     return $old;
  79 }
  80
  81
  82 sub tasks {
  83     my $this = shift();
  84
  85     return $this->{tasks};
  86 }
  87
  88
  89 sub current_task {
  90     my $this = shift();
  91     my($new) = @_;
  92
  93     my $old = $this->{current_task};
  94     if (defined $new) {
  95         $this->{current_task} = $new;
  96         $this->log("irspy_task", "set current task to $new");
  97     }
  98
  99     return $old;
 100 }
 101
 102
 103 sub next_task {
 104     my $this = shift();
 105     my($new) = @_;
 106
 107     my $old = $this->{next_task};
 108     if (defined $new) {
 109         $this->{next_task} = $new;
 110         $this->log("irspy_task", "set next task to $new");
 111     }
 112
 113     return $old;
 114 }
 115
 116
 117 sub log {
 118     my $this = shift();
 119     my($level, @msg) = @_;
 120
 121     $this->irspy()->log($level, $this->option("host"), " ", @msg);
 122 }
 123
 124
 125 sub irspy_connect {
 126     my $this = shift();
 127     my($udata, $options, %cb) = @_;
 128
 129     $this->add_task(new ZOOM::IRSpy::Task::Connect
 130                     ($this, $udata, $options, %cb));
 131 }
 132
 133
 134 sub irspy_search_pqf {
 135     my $this = shift();
 136     my($query, $udata, $options, %cb) = @_;
 137
 138     $this->add_task(new ZOOM::IRSpy::Task::Search
 139                     ($query, $this, $udata, $options, %cb));
 140 }
 141
 142
 143 sub irspy_rs_record {
 144     my $this = shift();
 145     my($rs, $index0, $udata, $options, %cb) = @_;
 146
 147     $this->add_task(new ZOOM::IRSpy::Task::Retrieve
 148                     ($rs, $index0, $this, $udata, $options, %cb));
 149 }
 150
 151
 152 sub add_task {
 153     my $this = shift();
 154     my($task) = @_;
 155
 156     my $tasks = $this->{tasks};
 157     $tasks->[-1]->{next} = $task if @$tasks > 0;
 158     push @$tasks, $task;
 159     $this->log("irspy_task", "added task $task");
 160 }
 161
 162
 163 sub render {
 164     my $this = shift();
 165     return ref($this) . "(" . $this->option("host") . ")";
 166 }
 167
 168 use overload '""' => \&render;
 169
 170
 171 =head1 SEE ALSO
 172
 173 ZOOM::IRSpy
 174
 175 =head1 AUTHOR
 176
 177 Mike Taylor, E<lt>mike@indexdata.comE<gt>
 178
 179 =head1 COPYRIGHT AND LICENSE
 180
 181 Copyright (C) 2006 by Index Data ApS.
 182
 183 This library is free software; you can redistribute it and/or modify
 184 it under the same terms as Perl itself, either Perl version 5.8.7 or,
 185 at your option, any later version of Perl 5 you may have available.
 186
 187 =cut
 188
 189 1;