source: gsdl/trunk/perllib/downloaders/Z3950Download.pm@ 17220

Last change on this file since 17220 was 17220, checked in by ak19, 16 years ago

One more occasion where the quit command needs to be sent

  • Property svn:keywords set to Author Date Id Revision
File size: 9.6 KB
Line 
1###########################################################################
2#
3# WebDownload.pm -- base class for all the import plugins
4# A component of the Greenstone digital library software
5# from the New Zealand Digital Library Project at the
6# University of Waikato, New Zealand.
7#
8# Copyright (C) 1999 New Zealand Digital Library Project
9#
10# This program is free software; you can redistribute it and/or modify
11# it under the terms of the GNU General Public License as published by
12# the Free Software Foundation; either version 2 of the License, or
13# (at your option) any later version.
14#
15# This program is distributed in the hope that it will be useful,
16# but WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18# GNU General Public License for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
22# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23#
24###########################################################################
25
26package Z3950Download;
27
28eval {require bytes};
29
30# suppress the annoying "subroutine redefined" warning that various
31# plugins cause under perl 5.6
32$SIG{__WARN__} = sub {warn($_[0]) unless ($_[0] =~ /Subroutine\s+\S+\sredefined/)};
33
34use strict;
35
36use BaseDownload;
37use IPC::Open2;
38
39sub BEGIN {
40 @Z3950Download::ISA = ('BaseDownload');
41}
42
43my $arguments =
44 [ { 'name' => "host",
45 'disp' => "{Z3950Download.host_disp}",
46 'desc' => "{Z3950Download.host}",
47 'type' => "string",
48 'reqd' => "yes"},
49 { 'name' => "port",
50 'disp' => "{Z3950Download.port_disp}",
51 'desc' => "{Z3950Download.port}",
52 'type' => "string",
53 'reqd' => "yes"},
54 { 'name' => "database",
55 'disp' => "{Z3950Download.database_disp}",
56 'desc' => "{Z3950Download.database}",
57 'type' => "string",
58 'reqd' => "yes"},
59 { 'name' => "find",
60 'disp' => "{Z3950Download.find_disp}",
61 'desc' => "{Z3950Download.find}",
62 'type' => "string",
63 'deft' => "",
64 'reqd' => "yes"},
65 { 'name' => "max_records",
66 'disp' => "{Z3950Download.max_records_disp}",
67 'desc' => "{Z3950Download.max_records}",
68 'type' => "int",
69 'deft' => "500",
70 'reqd' => "no"}];
71
72my $options = { 'name' => "Z3950Download",
73 'desc' => "{Z3950Download.desc}",
74 'abstract' => "no",
75 'inherits' => "yes",
76 'args' => $arguments };
77
78
79sub new
80{
81 my ($class) = shift (@_);
82 my ($getlist,$inputargs,$hashArgOptLists) = @_;
83 push(@$getlist, $class);
84
85 push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});
86 push(@{$hashArgOptLists->{"OptList"}},$options);
87
88 my $self = new BaseDownload($getlist,$inputargs,$hashArgOptLists);
89
90 if ($self->{'info_only'}) {
91 # don't worry about any options etc
92 return bless $self, $class;
93 }
94
95 # Must set $self->{'url'}, since GLI use $self->{'url'} to calculate the log file name!
96 $self->{'url'} = $self->{'host'}.":".$self->{'port'};
97
98 $self->{'yaz'} = &util::filename_cat($ENV{'GSDLHOME'}, "bin", $ENV{'GSDLOS'}, "yaz-client");
99
100 return bless $self, $class;
101
102}
103
104sub download
105{
106 my ($self) = shift (@_);
107 my ($hashGeneralOptions) = @_;
108 my ($strOpen,$strBase,$strFind,$strResponse,$intAmount,$intMaxRecords,$strRecords);
109
110 my $url = $self->{'url'};
111
112 print STDERR "<<Defined Maximum>>\n";
113
114 print STDERR "Opening connection to $url\n";
115
116 my $yaz = $self->{'yaz'};
117
118 my $childpid = open2(*YAZOUT, *YAZIN, $yaz)
119 or (print STDERR "<<Finished>>\n" and die "can't open pipe to yaz-client: $!");
120 $self->{'YAZOUT'} = *YAZOUT;
121 $self->{'YAZIN'} = *YAZIN;
122
123 $strOpen = $self->open_connection("open $url");
124
125 if (!$strOpen) {
126 print STDERR "Cannot connect to $url\n";
127 print STDERR "<<Finished>>\n";
128 return 0;
129 }
130
131 print STDERR "Access database: \"$self->{'database'}\"\n";
132 $self->run_command_without_output("base $self->{'database'}");
133 print STDERR "Searching for keyword: \"$self->{'find'}\"\n";
134 $intAmount = $self->findAmount($self->{'find'});
135
136 if($intAmount <= 0)
137 {
138 ($intAmount == -1)?
139 print STDERR "Something wrong with the arguments,downloading can not be performed\n":
140 print STDERR "No Record is found\n";
141 print STDERR "<<Finished>>\n";
142 return 0;
143 }
144 $intMaxRecords = ($self->{'max_records'} > $intAmount)? $intAmount : $self->{'max_records'};
145 print STDERR "<<Total number of record(s):$intMaxRecords>>\n";
146 $strRecords = "Records: $intMaxRecords\n".$self->getRecords($intMaxRecords);
147
148 $self->saveRecords($strRecords,$hashGeneralOptions->{'cache_dir'},$intMaxRecords);
149 print STDERR "Closing connection...\n";
150 print STDERR "<<Finished>>\n";
151
152 # need to send the quit command, else yaz-client is still running in the background
153 $self->run_command_without_output("quit");
154 close(YAZOUT);
155 close(YAZIN);
156 return 1;
157}
158
159sub open_connection{
160 my ($self,$strCommand) = (@_);
161
162 $self->run_command($strCommand);
163
164 my $out = $self->{'YAZOUT'};
165
166 $_ = <$out>;
167
168 return (/Connecting...OK/i)? 1: 0;
169
170}
171
172sub findAmount
173{
174 my ($self) = shift (@_);
175 my($strFindTarget) = @_;
176 my $strResponse = $self->run_command_with_output("find $strFindTarget","^Number of hits:");
177 return ($strResponse =~ m/^Number of hits: (\d+)/m)? $1:-1;
178}
179
180sub getRecords
181{
182 my ($self) = shift (@_);
183 my ($intMaxRecords) = @_;
184 my ($strShow,$intStartNumber,$numRecords,$strResponse,$strRecords,$intRecordsLeft);
185
186 $intStartNumber = 1;
187 $intRecordsLeft = $intMaxRecords;
188 $numRecords = 0;
189 $strResponse ="";
190
191 while ($intRecordsLeft > 0)
192 {
193 if($intRecordsLeft > 50)
194 {
195
196 print STDERR "Yaz is Gathering records: $intStartNumber - ".($intStartNumber+49)."\n";
197 $numRecords = 50;
198 $strShow = "show $intStartNumber+50";
199 $intStartNumber = $intStartNumber + 50;
200 $intRecordsLeft = $intRecordsLeft - 50;
201
202 }
203 else
204 {
205 $numRecords = $intRecordsLeft;
206 print STDERR "Yaz is Gathering records: $intStartNumber - ".($intStartNumber+$intRecordsLeft-1)."\n";
207 $strShow = "show $intStartNumber+$intRecordsLeft";
208 $intRecordsLeft = 0;
209
210 }
211
212 $strResponse .= $self->get($strShow,$numRecords);
213
214 if ($strResponse eq ""){
215 print STDERR "<<ERROR: failed to get $numRecords records>>\n";
216 }
217 else{
218 print STDERR "<<Done:$numRecords>>\n";
219 }
220 }
221
222 return "$strResponse\n";
223
224}
225
226sub saveRecords
227{
228 my ($self,$strRecords,$strOutputDir,$intMaxRecords) = @_;
229
230 # setup directories
231 # Currently only gather the MARC format
232 my $strFileName = $self->generateFileName($intMaxRecords);
233
234 $strOutputDir =~ s/"//g; #"
235
236 my $strOutputFile = &util::filename_cat($strOutputDir,$self->{'host'},"$strFileName.marc");
237 # prepare subdirectory for record (if needed)
238 my ($strSubDirPath,$unused) = $self->dirFileSplit($strOutputFile);
239
240 &util::mk_all_dir($strSubDirPath);
241
242 print STDERR "Saving records to \"$strOutputFile\"\n";
243
244 # save record
245 open (ZOUT,">$strOutputFile")
246 || die "Unable to save Z3950 record: $!\n";
247 print ZOUT $strRecords;
248 close(ZOUT);
249}
250
251
252sub run_command_with_output
253{
254 my ($self,$strCMD,$strStopRE) =@_;
255
256 $self->run_command($strCMD);
257
258 return $self->get_output($strStopRE);
259
260}
261
262sub get{
263 my ($self,$strShow,$numRecord) = @_;
264
265 $self->run_command($strShow);
266
267 my $strFullOutput="";
268 my $count=0;
269 my $readRecord = 0;
270
271 while (my $strLine = <YAZOUT>)
272 {
273
274 if ($strLine =~ m/Records: ([\d]*)/i ){
275 $readRecord = 1;
276 next;
277 }
278
279 return $strFullOutput if ($strLine =~ m/nextResultSetPosition|Not connected/i);
280
281 next if(!$readRecord);
282
283 $strFullOutput .= $strLine;
284 }
285
286}
287
288sub run_command_without_output
289{
290 my ($self) = shift (@_);
291 my ($strCMD) = @_;
292
293 $self->run_command($strCMD);
294}
295
296sub run_command
297{
298 my ($self,$strCMD) = @_;
299
300 my $input = $self->{'YAZIN'};
301
302 print $input "$strCMD\n";
303}
304
305sub get_output{
306 my ($self,$strStopRE) = @_;
307
308 if (!defined $strStopRE){return "";}
309 else
310 {
311 my $strFullOutput;
312 my $output = $self->{'YAZOUT'};
313 while (my $strLine = <$output>)
314 {
315 $strFullOutput .= $strLine;
316 if($strLine =~ m/^$strStopRE|Not connected/i){return $strFullOutput;}
317 }
318 }
319}
320
321sub generateFileName
322{
323 my ($self,$intMaxRecords) = @_;
324 my $strFileName = ($self->{'database'})."_".($self->{'find'})."_".($intMaxRecords);
325
326}
327
328sub dirFileSplit
329{
330 my ($self,$strFile) = @_;
331
332 my @aryDirs = split(/[\/\\]/,$strFile);
333
334 my $strLocalFile = pop(@aryDirs);
335 my $strSubDirs = join("/",@aryDirs);
336
337 return ($strSubDirs,$strLocalFile);
338}
339
340sub url_information
341{
342 my ($self,$url) = @_;
343
344 $url = $self->{'url'} unless defined $url;
345
346 my $yaz = $self->{'yaz'};
347
348 my $childpid = open2(*YAZOUT, *YAZIN, $yaz)
349 or die "can't open pipe to yaz-client: $!";
350
351 $self->{'YAZOUT'} = *YAZOUT;
352 $self->{'YAZIN'} = *YAZIN;
353
354 my $strOpen = $self->open_connection("open $url");
355
356 if (!$strOpen) {
357 print STDERR "Cannot connect to $url\n";
358 print STDERR "<<Finished>>\n";
359 return 0;
360 }
361
362
363 $strOpen = $self->run_command_with_output("open $url","^Options");
364
365
366 $strOpen =~ s/Z> //g;
367 $strOpen =~ s/Elapsed:.*//g;
368
369 print STDERR $strOpen;
370
371 print STDERR "<<Finished>>\n";
372
373 # need to send the quit command, else yaz-client is still running in the background
374 $self->run_command_without_output("quit");
375 close(YAZOUT);
376 close(YAZIN);
377
378 return 0;
379
380}
381
382sub error
383{
384 my ($self,$strFunctionName,$strError) = @_;
385 {
386 print STDERR "Error occoured in Z3950Download.pm\n".
387 "In Function:".$strFunctionName."\n".
388 "Error Message:".$strError."\n";
389 exit(-1);
390 }
391}
392
3931;
Note: See TracBrowser for help on using the repository browser.