1 # $Id: Connection.pm,v 1.21 2007-12-20 12:35:01 mike Exp $
3 package ZOOM::IRSpy::Connection;
10 our @ISA = qw(ZOOM::Connection);
12 use ZOOM::IRSpy::Record;
13 use ZOOM::IRSpy::Utils qw(cql_target render_record irspy_identifier2target);
15 use ZOOM::IRSpy::Task::Connect;
16 use ZOOM::IRSpy::Task::Search;
17 use ZOOM::IRSpy::Task::Retrieve;
22 ZOOM::IRSpy::Connection - ZOOM::Connection subclass with IRSpy functionality
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.
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
43 my $this = $class->SUPER::create(@_);
44 my $target = irspy_identifier2target($id);
45 $this->option(host => $target);
46 $this->{irspy} = $irspy;
49 my $query = cql_target($id);
52 $rs = $irspy->{conn}->search(new ZOOM::Query::CQL($query));
54 # This should be a "can't happen", but junk entries such as
55 # //lucasportal.info/blogs/payday-usa">'</a>night:G<a href="http://lucasportal.info/blogs/payday-usa">'</a>night/Illepeliz
56 # (yes, really) yield BIB-1 diagnostic 108 "Malformed query"
57 warn "registry search for record '$id' had error: '$@' -- skipping";
61 $this->log("irspy", "query '$query' found $n record", $n==1 ? "" : "s");
62 ### More than 1 hit is always an error and indicates duplicate
63 # records in the database; no hits is fine for a new target
64 # being probed for the first time, but not if the connection is
65 # being created as part of an "all known targets" scan.
67 $zeerex = render_record($rs, 0, "zeerex") if $n > 0;
68 $this->{record} = new ZOOM::IRSpy::Record($this, $target, $zeerex);
76 $this->SUPER::destroy(@_);
82 return $this->{irspy};
90 my $old = $this->{record};
91 $this->{record} = $new if defined $new;
99 return $this->{tasks};
107 my $old = $this->{current_task};
109 $this->{current_task} = $new;
110 $this->log("irspy_task", "set current task to $new");
121 my $old = $this->{next_task};
123 $this->{next_task} = $new;
124 $this->log("irspy_task", "set next task to $new");
133 my($level, @msg) = @_;
135 $this->irspy()->log($level, $this->option("host"), " ", @msg);
141 my($udata, $options, %cb) = @_;
143 $this->add_task(new ZOOM::IRSpy::Task::Connect
144 ($this, $udata, $options, %cb));
150 my($qtype, $qstr, $udata, $options, %cb) = @_;
152 #warn "calling $this->irspy_search(", join(", ", @_), ")\n";
153 $this->add_task(new ZOOM::IRSpy::Task::Search
154 ($qtype, $qstr, $this, $udata, $options, %cb));
158 # Wrapper for backwards compatibility
159 sub irspy_search_pqf {
161 return $this->irspy_search("pqf", @_);
165 sub irspy_rs_record {
167 my($rs, $index0, $udata, $options, %cb) = @_;
169 $this->add_task(new ZOOM::IRSpy::Task::Retrieve
170 ($rs, $index0, $this, $udata, $options, %cb));
178 my $tasks = $this->{tasks};
179 $tasks->[-1]->{next} = $task if @$tasks > 0;
181 $this->log("irspy_task", "added task $task");
187 return ref($this) . "(" . $this->option("host") . ")";
190 use overload '""' => \&render;
199 Mike Taylor, E<lt>mike@indexdata.comE<gt>
201 =head1 COPYRIGHT AND LICENSE
203 Copyright (C) 2006 by Index Data ApS.
205 This library is free software; you can redistribute it and/or modify
206 it under the same terms as Perl itself, either Perl version 5.8.7 or,
207 at your option, any later version of Perl 5 you may have available.