lib/ZOOM/IRSpy/Connection.pm

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