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

###########################################################################
#
# WebDownload.pm -- base class for all the import plugins
# A component of the Greenstone digital library software
# from the New Zealand Digital Library Project at the 
# University of Waikato, New Zealand.
#
# Copyright (C) 1999 New Zealand Digital Library Project
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
###########################################################################

package Z3950Download;

eval {require bytes};

# suppress the annoying "subroutine redefined" warning that various
# plugins cause under perl 5.6
$SIG{__WARN__} = sub {warn($_[0]) unless ($_[0] =~ /Subroutine\s+\S+\sredefined/)};

use strict;

use BasDownload;
use IPC::Open2;

sub BEGIN {
    @Z3950Download::ISA = ('BasDownload');
}

local (*YAZOUT, *YAZIN); 

my $arguments = 
    [  { 'name' => "host", 
    'disp' => "{Z3950Download.host_disp}",
    'desc' => "{Z3950Download.host}",
    'type' => "string",
    'reqd' => "yes"},
      { 'name' => "port", 
    'disp' => "{Z3950Download.port_disp}",
    'desc' => "{Z3950Download.port}",
    'type' => "string",
    'reqd' => "yes"},
      { 'name' => "database", 
    'disp' => "{Z3950Download.database_disp}",
    'desc' => "{Z3950Download.database}",
        'type' => "string",
    'reqd' => "yes"},
      { 'name' => "find", 
    'disp' => "{Z3950Download.find_disp}",
    'desc' => "{Z3950Download.find}",
    'type' => "string",
    'deft' => "",
    'reqd' => "yes"},
      { 'name' => "max_records", 
    'disp' => "{Z3950Download.max_records_disp}",
    'desc' => "{Z3950Download.max_records}",
    'type' => "int",
    'deft' => "500",
    'reqd' => "no"}];

my $options = { 'name'     => "Z3950Download",
        'desc'     => "{Z3950Download.desc}",
        'abstract' => "no",
        'inherits' => "yes",
        'args'     => $arguments };


sub new 
{
    my ($class) = shift (@_);
    my ($getlist,$inputargs,$hashArgOptLists) = @_;
    push(@$getlist, $class);

    if(defined $arguments){ push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});}
    if(defined $options) { push(@{$hashArgOptLists->{"OptList"}},$options)};

    my $self = (defined $hashArgOptLists)? new BasDownload($getlist,$inputargs,$hashArgOptLists): new BasDownload($getlist,$inputargs);

    if ($self->{'info_only'}) {
    # don't worry about any options etc
    return bless $self, $class;
    }

    # Must set $self->{'url'}, since GLI use $self->{'url'} to calculate the log file name!
    $self->{'url'} = $self->{'host'}.":".$self->{'port'};
    return bless $self, $class;

}

sub download
{
    my ($self) = shift (@_);
    my ($hashGeneralOptions) = @_;
    my ($strOpen,$strBase,$strFind,$strResponse,$intAmount,$intMaxRecords,$strRecords);
    print STDERR "<<Defined Maximum>>\n";
 
    my $url = $self->{'url'};
    print STDERR "Opening connection to $url\n";
     
    my $childpid = open2(*YAZOUT, *YAZIN, "yaz-client")
    or die "can't open pipe to yaz-client: $!";
 
    $strOpen = &run_command_with_output("open $url");  
    print STDERR "Access database: \"$self->{'database'}\"\n";
    &run_command_without_output("base $self->{'database'}");
    print STDERR "Searching for keyword: \"$self->{'find'}\"\n";
    $intAmount = &findAmount($self->{'find'});

    if($intAmount <= 0)
    {
    ($intAmount == -1)? 
        print STDERR "Unexpected format, Parsing operation can not be performed\n" : 
        print STDERR "No Record is found\n";
    return 0;
    }
    $intMaxRecords = ($self->{'max_records'} > $intAmount)? $intAmount : $self->{'max_records'};
    print STDERR "<<Total number of record(s):$intMaxRecords>>\n";
    $strRecords = &getRecords($intMaxRecords);
    print STDERR $strRecords;
    &saveRecords($self,$strRecords,$hashGeneralOptions->{'cache_dir'},$intMaxRecords);
    print STDERR "Closing connection...\n";
    close(YAZOUT);
    close(YAZIN);
    waitpid($childpid, 0);
    return 1;
}

sub findAmount
{
    my($strFindTarget) = @_;
    my $strResponse = &run_command_with_output("find $strFindTarget");
    return ($strResponse =~ m/^Number of hits: (\d+)/m)? $1:-1;    
}

sub getRecords
{
    my ($intMaxRecords) = @_;
    my ($strShow,$intStartNumber,$strResponse,$strRecords,$intRecordsLeft);

    $intStartNumber = 1;
    $intRecordsLeft = $intMaxRecords;
    while ($intRecordsLeft > 0)
    {
    if($intRecordsLeft > 50)
    {
        print STDERR "<<Done:50>>\n";
        print STDERR "Yaz is Gathering records: $intStartNumber - ".($intStartNumber+49)."\n";
        
        $strShow = "show $intStartNumber+50";
        $intStartNumber = $intStartNumber + 50;
        $intRecordsLeft = $intRecordsLeft - 50;
    }
    else
    {
        print STDERR "<<Done:".($intRecordsLeft).">>\n";
        print STDERR "Yaz is Gathering records: $intStartNumber - ".($intStartNumber+$intRecordsLeft-1)."\n";
        $strShow = "show $intStartNumber+$intRecordsLeft";
        $intRecordsLeft = 0;
    }
    
    $strResponse = &run_command_with_output($strShow);
       
    if($strResponse =~ m/Records: (\d*?)\n(.*?)nextResultSetPosition = (\d*?)\n/s)
    {
        $strRecords .= $2;
    }
    }
    return $strRecords;
}

sub saveRecords
{
    my ($self,$strRecords,$strOutputDir,$intMaxRecords) = @_;

    # setup directories
    # Currently only gather the MARC format
    my $strFileName = &generateFileName($self,$intMaxRecords);
    my $strFileURL = "$strOutputDir/$self->{'host'}/$strFileName.marc";
    $strFileURL =~ s/:/\//g;

    # prepare subdirectory for record (if needed)
    my ($strSubDirPath,$unused) = dirFileSplit($strFileURL);
    &util::mk_all_dir($strSubDirPath);

    my $ds = &util::get_dirsep();
    my $strOutputFile = &util::filename_cat($strOutputDir,$self->{'host'},"$strFileName.marc");
    $strOutputFile =~ s/:/$ds/g;

    print STDERR "Saving records to \"$strOutputFile\"\n";

    # save record 
    open (ZOUT,">$strOutputFile")
    || die "Unable to save oai metadata record: $!\n";
    print ZOUT $strRecords;
    close(ZOUT);
}

sub run_command_with_output
{
    my ($strCMD) = @_;
    
    return &run_command($strCMD,"^Elapsed:.*\$");
}

sub run_command_without_output
{
    my ($strCMD) = @_;

    &run_command($strCMD);
}

sub run_command
{
    my ($strCMD,$strStopRE) = @_;
    
  
    print YAZIN "$strCMD\n";
    if (!defined $strStopRE){return "";}
    else
    {
    my $strFullOutput;
    while (my $strLine = <YAZOUT>)
    {
        $strFullOutput .= $strLine;
        if($strLine =~ m/$strStopRE/){return $strFullOutput;}
    }
    }
}

sub generateFileName
{
    my ($self,$intMaxRecords) = @_;
    my $strFileName = ($self->{'database'})."_".($self->{'find'})."_".($intMaxRecords);
}

sub dirFileSplit
{
    my ($strFile) = @_;

    my @aryDirs = split("/",$strFile);
    my $strLocalFile = pop(@aryDirs);
    my $strSubDirs = join("/",@aryDirs);

    return ($strSubDirs,$strLocalFile);
}

sub error
{
    my ($strFunctionName,$strError) = @_;
    {
    print STDERR "Error occoured in Z3950Download.pm\n".
        "In Function:".$strFunctionName."\n".
        "Error Message:".$strError."\n";
    exit(-1);
    }
}

1;