lib/ZOOM/IRSpy/Connection.pm

   1 # $Id: Connection.pm,v 1.7 2006-11-16 17:18:43 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::Task::Connect;
  13 use ZOOM::IRSpy::Task::Search;
  14 use ZOOM::IRSpy::Task::Retrieve;
  15
  16
  17 =head1 NAME
  18
  19 ZOOM::IRSpy::Connection - ZOOM::Connection subclass with IRSpy functionality
  20
  21 =head1 DESCRIPTION
  22
  23 This class provides some additional private data and methods that are
  24 used by IRSpy but which would be useless in any other application.
  25 Keeping the private data in these objects removes the need for ugly
  26 mappings in the IRSpy object itself; adding the methods makes the
  27 application code cleaner.
  28
  29 The constructor takes an additional first argument, a reference to the
  30 IRSpy object that it is associated with.
  31
  32 =cut
  33
  34 sub create {
  35     my $class = shift();
  36     my $irspy = shift();
  37
  38     my $this = $class->SUPER::create(@_);
  39     $this->{irspy} = $irspy;
  40     $this->{record} = undef;
  41     $this->{tasks} = [];
  42
  43     return $this;
  44 }
  45
  46
  47 sub irspy {
  48     my $this = shift();
  49     return $this->{irspy};
  50 }
  51
  52
  53 sub record {
  54     my $this = shift();
  55     my($new) = @_;
  56
  57     my $old = $this->{record};
  58     $this->{record} = $new if defined $new;
  59     return $old;
  60 }
  61
  62
  63 sub tasks {
  64     my $this = shift();
  65
  66     return $this->{tasks};
  67 }
  68
  69
  70 sub current_task {
  71     my $this = shift();
  72     my($new) = @_;
  73
  74     my $old = $this->{current_task};
  75     if (defined $new) {
  76         $this->{current_task} = $new;
  77         $this->log("irspy_task", "set current task to $new");
  78     }
  79
  80     return $old;
  81 }
  82
  83
  84 sub next_task {
  85     my $this = shift();
  86     my($new) = @_;
  87
  88     my $old = $this->{next_task};
  89     if (defined $new) {
  90         $this->{next_task} = $new;
  91         $this->log("irspy_task", "set next task to $new");
  92     }
  93
  94     return $old;
  95 }
  96
  97
  98 sub log {
  99     my $this = shift();
 100     my($level, @msg) = @_;
 101
 102     $this->irspy()->log($level, $this->option("host"), " ", @msg);
 103 }
 104
 105
 106 sub irspy_connect {
 107     my $this = shift();
 108     my($udata, $options, %cb) = @_;
 109
 110     my $task = new ZOOM::IRSpy::Task::Connect($this, $udata, $options, %cb);
 111     $this->add_task($task);
 112 }
 113
 114
 115 sub irspy_search_pqf {
 116     my $this = shift();
 117     my($query, $udata, $options, %cb) = @_;
 118
 119     my $task = new ZOOM::IRSpy::Task::Search($query,
 120                                              $this, $udata, $options, %cb);
 121     $this->add_task($task);
 122 }
 123
 124
 125 sub irspy_rs_record {
 126     my $this = shift();
 127     my($rs, $index0, $udata, $options, %cb) = @_;
 128
 129     my $task = new ZOOM::IRSpy::Task::Retrieve($rs, $index0,
 130                                                $this, $udata, $options, %cb);
 131     $this->add_task($task);
 132 }
 133
 134
 135 sub add_task {
 136     my $this = shift();
 137     my($task) = @_;
 138
 139     my $tasks = $this->{tasks};
 140     $tasks->[-1]->{next} = $task if @$tasks > 0;
 141     push @$tasks, $task;
 142     $this->log("irspy_task", "added task $task");
 143 }
 144
 145
 146 sub render {
 147     my $this = shift();
 148     return ref($this) . "(" . $this->option("host") . ")";
 149 }
 150
 151 use overload '""' => \&render;
 152
 153
 154 =head1 SEE ALSO
 155
 156 ZOOM::IRSpy
 157
 158 =head1 AUTHOR
 159
 160 Mike Taylor, E<lt>mike@indexdata.comE<gt>
 161
 162 =head1 COPYRIGHT AND LICENSE
 163
 164 Copyright (C) 2006 by Index Data ApS.
 165
 166 This library is free software; you can redistribute it and/or modify
 167 it under the same terms as Perl itself, either Perl version 5.8.7 or,
 168 at your option, any later version of Perl 5 you may have available.
 169
 170 =cut
 171
 172 1;