session.pm

harvest是一个下载html网页得机器人

# $Id: Session.pm,v 1.19 2003/07/26 16:27:46 pop Exp $
# 
# Zebra perl API header
# =============================================================================
package IDZebra::Session;

use strict;
use warnings;
use Carp;

BEGIN {
    use IDZebra;
    use Scalar::Util;
    use IDZebra::Logger qw(:flags :calls);
    use IDZebra::Resultset;
    use IDZebra::ScanList;
    use IDZebra::RetrievalRecord;
    require Exporter;
    our $VERSION = do { my @r = (q$Revision: 1.19 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; 
    our @ISA = qw(IDZebra::Logger Exporter);
    our @EXPORT = qw (TRANS_RW TRANS_RO);
}

use constant TRANS_RW => 1;
use constant TRANS_RO => 0;

1;
# -----------------------------------------------------------------------------
# Class constructors, destructor
# -----------------------------------------------------------------------------
sub new {
    my ($proto, %args) = @_;
    my $class = ref($proto) || $proto;
    my $self = {};
    $self->{args} = \%args;
    
    bless ($self, $class);
    $self->{cql_ct} = undef;
    $self->{cql_mapfile} = "";
    return ($self);

    $self->{databases} = {};
}

sub start_service {
    my ($self, %args) = @_;

    my $zs;
    unless (defined($self->{zs})) {
	if (defined($args{'configFile'})) {
	    $self->{zs} = IDZebra::start($args{'configFile'});
	} else {
	    $self->{zs} = IDZebra::start("zebra.cfg");
	}
    }
}

sub stop_service {
    my ($self) = @_;
    if (defined($self->{zs})) {
        IDZebra::stop($self->{zs}) if ($self->{zs});    
	$self->{zs} = undef;
    }
}


sub open {
    my ($proto,%args) = @_;
    my $self = {};

    if (ref($proto)) { $self = $proto; } else { 
	$self = $proto->new(%args);
    }

    unless (%args) {
	%args = %{$self->{args}};
    }

    $self->start_service(%args);

    unless (defined($self->{zs})) {
	croak ("Falied to open zebra service");
    }    

    unless (defined($self->{zh})) {
	$self->{zh}=IDZebra::open($self->{zs}); 
    }   

    # Reset result set counter
    $self->{rscount} = 0;

    # This is needed in order to somehow initialize the service
    $self->databases("Default");

    # Load the default configuration
    $self->group(%args);


    # Set shadow usage
    my $shadow = defined($args{shadow}) ? $args{shadow} : 0;
    $self->shadow($shadow);
    
    $self->{odr_input} = IDZebra::odr_createmem($IDZebra::ODR_DECODE);
    $self->{odr_output} = IDZebra::odr_createmem($IDZebra::ODR_ENCODE);

    return ($self);
}

sub checkzh {
    my ($self) = @_;
    unless (defined($self->{zh})) {
	croak ("Zebra session is not opened");
    }
}

sub close {
    my ($self) = @_;

    if ($self->{zh}) {

	my $stats = 0; 
	# Delete all resulsets
	my $r = IDZebra::deleteResultSet($self->{zh},
					 1, #Z_DeleteRequest_all,
					 0,[],
					 $stats);

	while (IDZebra::trans_no($self->{zh}) > 0) {
	    logf (LOG_WARN,"Explicitly closing transaction with session");
	    $self->end_trans;
	}

        IDZebra::close($self->{zh});
	$self->{zh} = undef;
    }
    
    if ($self->{odr_input}) {
        IDZebra::odr_reset($self->{odr_input});
        IDZebra::odr_destroy($self->{odr_input});
	$self->{odr_input} = undef;  
    }

    if ($self->{odr_output}) {
        IDZebra::odr_reset($self->{odr_output});
        IDZebra::odr_destroy($self->{odr_output});
	$self->{odr_output} = undef;  
    }

    $self->stop_service;
}

sub DESTROY {
    my ($self) = @_;
    logf (LOG_LOG,"DESTROY $self");
    $self->close; 

    if (defined ($self->{cql_ct})) {
      IDZebra::cql_transform_close($self->{cql_ct});
    }

}
# -----------------------------------------------------------------------------
# Record group selection  This is a bit nasty... but used at many places 
# -----------------------------------------------------------------------------
sub group {
    my ($self,%args) = @_;
    $self->checkzh;
    if ($#_ > 0) {
	$self->{rg} = $self->_makeRecordGroup(%args);
	$self->_selectRecordGroup($self->{rg});
    }
    return($self->{rg});
}

sub selectRecordGroup {
    my ($self, $groupName) = @_;
    $self->checkzh;
    $self->{rg} = $self->_getRecordGroup($groupName);
    $self->_selectRecordGroup($self->{rg});
}

sub _displayRecordGroup {
    my ($self, $rg) = @_;
    print STDERR "-----\n";
    foreach my $key qw (groupName 
			databaseName 
			path recordId 
			recordType 
			flagStoreData 
			flagStoreKeys 
			flagRw 
			fileVerboseLimit 
			databaseNamePath 
			explainDatabase 
			followLinks) {
	print STDERR "$key:",$rg->{$key},"\n";
    }
}

sub _cloneRecordGroup {
    my ($self, $orig) = @_;
    my $rg = IDZebra::recordGroup->new();
    my $r = IDZebra::init_recordGroup($rg);
    foreach my $key qw (groupName 
			databaseName 
			path 
			recordId 
			recordType 
			flagStoreData 
			flagStoreKeys 
			flagRw 
			fileVerboseLimit 
			databaseNamePath 
			explainDatabase 
			followLinks) {
	$rg->{$key} = $orig->{$key} if ($orig->{$key});
    }
    return ($rg);
}

sub _getRecordGroup {
    my ($self, $groupName, $ext) = @_;
    my $rg = IDZebra::recordGroup->new();
    my $r = IDZebra::init_recordGroup($rg);
    $rg->{groupName} = $groupName if ($groupName ne "");  
    $ext = "" unless ($ext);
    $r = IDZebra::res_get_recordGroup($self->{zh}, $rg, $ext);
    return ($rg);
}

sub _makeRecordGroup {
    my ($self, %args) = @_;
    my $rg;

    my @keys = keys(%args);
    unless ($#keys >= 0) {
	return ($self->{rg});
    }

    if ($args{groupName}) {
	$rg = $self->_getRecordGroup($args{groupName});
    } else {
	$rg = $self->_cloneRecordGroup($self->{rg});
    }
    $self->_setRecordGroupOptions($rg, %args);
    return ($rg);
}

sub _setRecordGroupOptions {
    my ($self, $rg, %args) = @_;

    foreach my $key qw (databaseName 
			path 
			recordId 
			recordType 
			flagStoreData 
			flagStoreKeys 
			flagRw 
			fileVerboseLimit 
			databaseNamePath 
			explainDatabase 
			followLinks) {
	if (defined ($args{$key})) {
	    $rg->{$key} = $args{$key};
	}
    }
}
sub _selectRecordGroup {
    my ($self, $rg) = @_;

    my $r = IDZebra::set_group($self->{zh}, $rg);
    my $dbName;
    unless ($dbName = $rg->{databaseName}) {
	$dbName = 'Default';
    }
    unless ($self->databases($dbName)) {
	croak("Fatal error selecting database $dbName");
    }
}
# -----------------------------------------------------------------------------
# Selecting databases for search (and also for updating - internally)
# -----------------------------------------------------------------------------
sub databases {
    my ($self, @databases) = @_;

    $self->checkzh;

    unless ($#_ >0) {
	return (keys(%{$self->{databases}}));
    }

    my %tmp;
    my $changed = 0;
    foreach my $db (@databases) {
	$tmp{$db}++;
	next if ($self->{databases}{$db});
	$changed++;
    }

    foreach my $db (keys (%{$self->{databases}})) {
	$changed++ unless ($tmp{$db});
    }

    if ($changed) {

	delete ($self->{databases});
	foreach my $db (@databases) {
	    $self->{databases}{$db}++;
	}

	if (IDZebra::select_databases($self->{zh}, 
						($#databases + 1), 
						\@databases)) {
	    logf(LOG_FATAL, 
		 "Could not select database(s) %s errCode=%d",
		 join(",",@databases),
		 $self->errCode());
	    return (0);
	} else {
	    logf(LOG_LOG,"Database(s) selected: %s",join(",",@databases));
	}
    }
    return (keys(%{$self->{databases}}));
}

# -----------------------------------------------------------------------------
# Error handling
# -----------------------------------------------------------------------------
sub errCode {
    my ($self) = @_;
    return(IDZebra::errCode($self->{zh}));
}

sub errString {
    my ($self) = @_;
    return(IDZebra::errString($self->{zh}));
}

sub errAdd {
    my ($self) = @_;
    return(IDZebra::errAdd($self->{zh}));
}

# -----------------------------------------------------------------------------
# Transaction stuff
# -----------------------------------------------------------------------------
sub begin_trans {
    my ($self, $m) = @_;
    $m = TRANS_RW unless (defined ($m));
    if (my $err = IDZebra::begin_trans($self->{zh},$m)) {
	if ($self->errCode == 2) {
	    croak ("TRANS_RW not allowed within TRANS_RO");
	} else {
	    croak("Error starting transaction; code:".
		  $self->errCode . " message: " . $self->errString);
	}
    }
}

sub end_trans {
    my ($self) = @_;
    $self->checkzh;
    my $stat = IDZebra::ZebraTransactionStatus->new();
    IDZebra::end_trans($self->{zh}, $stat);
    return ($stat);
}

sub shadow {
    my ($self, $value) = @_;
    $self->checkzh;
    if ($#_ > 0) { 
	$value = 0 unless (defined($value));
	my $r =IDZebra::set_shadow_enable($self->{zh},$value); 
    }
    return (IDZebra::get_shadow_enable($self->{zh}));
}

sub commit {
    my ($self) = @_;
    $self->checkzh;
    if ($self->shadow) {
	return(IDZebra::commit($self->{zh}));
    }
}

# -----------------------------------------------------------------------------
# We don't really need that...
# -----------------------------------------------------------------------------
sub odr_reset {
    my ($self, $name) = @_;
    if ($name !~/^(input|output)$/) {
	croak("Undefined ODR '$name'");
    }
  IDZebra::odr_reset($self->{"odr_$name"});
}