_fetch_record() now sets the temporary value of the
[irspy-moved-to-github.git] / lib / ZOOM / IRSpy / Connection.pm
1
2 package ZOOM::IRSpy::Connection;
3
4 use 5.008;
5 use strict;
6 use warnings;
7
8 use ZOOM;
9 our @ISA = qw(ZOOM::Connection);
10
11 use ZOOM::IRSpy::Record;
12 use ZOOM::IRSpy::Utils qw(cql_target render_record irspy_identifier2target);
13
14 use ZOOM::IRSpy::Task::Connect;
15 use ZOOM::IRSpy::Task::Search;
16 use ZOOM::IRSpy::Task::Retrieve;
17
18
19 =head1 NAME
20
21 ZOOM::IRSpy::Connection - ZOOM::Connection subclass with IRSpy functionality
22
23 =head1 DESCRIPTION
24
25 This class provides some additional private data and methods that are
26 used by IRSpy but which would be useless in any other application.
27 Keeping the private data in these objects removes the need for ugly
28 mappings in the IRSpy object itself; adding the methods makes the
29 application code cleaner.
30
31 The constructor takes an two additional leading arguments: a reference
32 to the IRSpy object that it is associated with, and the target ID of
33 the connection.
34
35 =cut
36
37 sub create {
38     my $class = shift();
39     my $irspy = shift();
40     my $id = shift();
41
42     my $this = $class->SUPER::create(@_);
43     my $target = irspy_identifier2target($id);
44     $this->option(host => $target);
45     $this->{irspy} = $irspy;
46     $this->{tasks} = [];
47
48     my $query = cql_target($id);
49     my $rs;
50     eval {
51         $rs = $irspy->{conn}->search(new ZOOM::Query::CQL($query));
52     }; if ($@) {
53         # This should be a "can't happen", but junk entries such as
54         #       //lucasportal.info/blogs/payday-usa">'</a>night:G<a href="http://lucasportal.info/blogs/payday-usa">'</a>night/Illepeliz
55         # (yes, really) yield BIB-1 diagnostic 108 "Malformed query"
56         warn "registry search for record '$id' had error: '$@' -- skipping";
57         return undef;
58     }
59     my $n = $rs->size();
60     $this->log("irspy", "query '$query' found $n record", $n==1 ? "" : "s");
61     ### More than 1 hit is always an error and indicates duplicate
62     #   records in the database; no hits is fine for a new target
63     #   being probed for the first time, but not if the connection is
64     #   being created as part of an "all known targets" scan.
65     my $zeerex;
66     $zeerex = render_record($rs, 0, "zeerex") if $n > 0;
67     $this->{record} = new ZOOM::IRSpy::Record($this, $target, $zeerex);
68
69     return $this;
70 }
71
72
73 sub destroy {
74     my $this = shift();
75     $this->SUPER::destroy(@_);
76 }
77
78
79 sub irspy {
80     my $this = shift();
81     return $this->{irspy};
82 }
83
84
85 sub record {
86     my $this = shift();
87     my($new) = @_;
88
89     my $old = $this->{record};
90     $this->{record} = $new if defined $new;
91     return $old;
92 }
93
94
95 sub tasks {
96     my $this = shift();
97
98     return $this->{tasks};
99 }
100
101
102 sub current_task {
103     my $this = shift();
104     my($new) = @_;
105
106     my $old = $this->{current_task};
107     if (defined $new) {
108         $this->{current_task} = $new;
109         $this->log("irspy_task", "set current task to $new");
110     }
111
112     return $old;
113 }
114
115
116 sub next_task {
117     my $this = shift();
118     my($new) = @_;
119
120     my $old = $this->{next_task};
121     if (defined $new) {
122         $this->{next_task} = $new;
123         $this->log("irspy_task", "set next task to $new");
124     }
125
126     return $old;
127 }
128
129
130 sub log {
131     my $this = shift();
132     my($level, @msg) = @_;
133
134     $this->irspy()->log($level, $this->option("host"), " ", @msg);
135 }
136
137
138 sub irspy_connect {
139     my $this = shift();
140     my($udata, $options, %cb) = @_;
141
142     $this->add_task(new ZOOM::IRSpy::Task::Connect
143                     ($this, $udata, $options, %cb));
144 }
145
146
147 sub irspy_search {
148     my $this = shift();
149     my($qtype, $qstr, $udata, $options, %cb) = @_;
150
151     { use Carp; confess "Odd-sized hash!" if @_ % 2; }
152     #warn "calling $this->irspy_search(", join(", ", @_), ")\n";
153     $this->add_task(new ZOOM::IRSpy::Task::Search
154                     ($qtype, $qstr, $this, $udata, $options, %cb));
155 }
156
157
158 # Wrapper for backwards compatibility
159 sub irspy_search_pqf {
160     my $this = shift();
161     return $this->irspy_search("pqf", @_);
162 }
163
164
165 sub irspy_rs_record {
166     my $this = shift();
167     my($rs, $index0, $udata, $options, %cb) = @_;
168
169     $this->add_task(new ZOOM::IRSpy::Task::Retrieve
170                     ($rs, $index0, $this, $udata, $options, %cb));
171 }
172
173
174 sub add_task {
175     my $this = shift();
176     my($task) = @_;
177
178     my $tasks = $this->{tasks};
179     $tasks->[-1]->{next} = $task if @$tasks > 0;
180     push @$tasks, $task;
181     $this->log("irspy_task", "added task $task");
182 }
183
184
185 sub render {
186     my $this = shift();
187     return ref($this) . "(" . $this->option("host") . ")";
188 }
189
190 use overload '""' => \&render;
191
192
193 =head1 SEE ALSO
194
195 ZOOM::IRSpy
196
197 =head1 AUTHOR
198
199 Mike Taylor, E<lt>mike@indexdata.comE<gt>
200
201 =head1 COPYRIGHT AND LICENSE
202
203 Copyright (C) 2006 by Index Data ApS.
204
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.
208
209 =cut
210
211 1;