marc.pm

开源MARC数据处理

###############################################################################
#
#	Copyright (C) 2003 Oy Realnode Ab
#
#	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., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#
################################################################################
#
#   $Id: MARC.pm,v 1.32.2.5 2004/01/22 17:47:25 eb Exp $
#
#   Description:		Main library of MARC manipulation and writing of Emilda.
#						This is, to be implemented in PHP when libraries are
#						to be available if not Emilda is ported to mod_perl.
#
#   Functions:
#
#	conf_parser			reads, parses and returns the conf in the form
#						of a hash-table.
#
#	dbInit				Initialize the database, and create the data-
#						base connection class.
#
#	dbEnd				Terminate the database-connection.
#
#	verify_session		Compare id & auth from the http-request to
#						the appropriate values in the Emilda sessions
#						database and as such validate request.
#
#	verify_request		Compare the perl_id & perl_auth passed via
#						http-request with the values in the Emilda-
#						conf and also validate accordingly.
#
#	control_number		Get the last control number from the control
#						table in the Emilda database, increment and add
#						the appropriate number of zeros in front.
#
#	marc_timestamp		Create a "last transaction"-timestamp to the
#						MARC-records in the format YYYYMMDDHHMMSS.F
#####
#
#	new					Create new MARC-manipulation-class
#
#	replace				Perform the updating/replacing of modified fields
#						and add native control-number, timestamp and
#						control-number-indentifier.
#
#	is_unique			Search if there is another book in the native
#						database with the identical ISBN. If there is
#						return false, otherwise true.
#
#	write				Write the modified MARC-record to the database,
#						update the "control" table and clean up.
######
#
#   Libraries:			DBI, Digest::MD5, MARC::Record, MARC::Field, Net::Z3950,
#
#   Global Consts:  	$dbh, $sth, $user_id, $VERSION, $record
#
###############################################################################


# Package declaration
package lib::MARC;

# Library inclusion
use DBI;
use Digest::MD5 qw(md5 md5_hex md5_base64);
use MARC::Record;
use MARC::Field;
use MARC::Lint;
use Net::Z3950;
use IDZebra::Session;
# uncomment if appropriate
#use 5.008;
use strict;
use warnings FATAL => 'all';


# Due to stict subs, all global variables and subroutines
# have to be predelceared
use vars qw(
			$dbh
			$sth
			$user_id
			$VERSION
			$record
			);
use subs qw(

            );

# Version declaration			
$VERSION = "0.1.0";

# Simple function to parse the conf.
sub conf_parser
{
    my $class = shift;
    my $T_conf = shift;
    my (@T_conf, %conf);

    open T_CONF, "<".$T_conf or die "Cannot open conf: $T_conf\n";
    push @T_conf, grep /^[a-zA-Z0-9]/, <T_CONF>;
    chomp(@T_conf);
    close T_CONF;

    foreach (@T_conf)
    {
        #$_ =~ s/\s//g;
        my @T_split = split('=', $_);
		$T_split[0] =~ s/\s//g;
		$T_split[1] =~ s/^\s*//g;
		$T_split[1] =~ s/\s*$//g;
		$conf{$T_split[0]} = $T_split[1];
    }

    return %conf;
}


# Initialize the database, and create the $dbh-object.
sub dbInit
{
	my $class = shift;
	my %conf = @_;
	my $driver = 'mysql';

	$dbh = DBI->connect("DBI:$driver:database=$conf{'mysql_db'};host=$conf{'mysql_host'};user=$conf{'mysql_user'};password=$conf{'mysql_passwd'};{RaiseError=>1}")
		or do {print "Content-type: text/html\n\n".$DBI::errstr."<br /><br /><a href='javascript:history.go(-1);'>Go Back</a>"; exit;}
}

# Terminate database connection
sub dbEnd
{
	my $class = shift;

	$dbh->disconnect or return 0;
	return 1;
}


# Verify the existance of an identical session, specified by the
# id & auth in the http-request in the sessions-database.
sub verify_session
{
	my $class = shift;
	my $cgi = shift;
	my %conf = @_;
	my ($sql);

	my $valid = 0;

	$sth = $dbh->prepare("SELECT * FROM sessions WHERE session_id=".$cgi->param('id'));
	$sth->execute;
	while ($sql = $sth->fetchrow_hashref)
	{
		if($sql->{session_auth} eq $cgi->param('auth'))
		{
			$valid = 1;
			$user_id = $sql->{session_user_id};
		}
	}
	$sth->finish();

	if($valid)
	{
		return 1;
	}
	else
	{
		return 0;
	}
}


# In the Emilda-conf there is a perl_id and a perl_auth field; if these are not
# not equvalent with the ones in the http-request the request is invalid.
sub verify_request
{
	my $class = shift;
	my $cgi = shift;
	my %conf = @_;

	if($cgi->param('perl_id') && $conf{'perl_auth'} && $cgi->param('perl_id') == $conf{'perl_id'} && $cgi->param('perl_auth') eq md5_hex($conf{'perl_auth'}))
	{
		return 1;
	}
	else
	{
		return 0;
	}
}

# Select the last control-number from the control table in the database,
# increment and add the appropriate number on zeros in front, specified by
# "control_number_length" in MARCsyn_config.
sub control_number
{
	my $self = shift;
	my $key = shift;
	my $length = shift;
	my $control_number;
	my $plain_cn;
	
	if($key eq 'generate')
	{
		$sth = $dbh->prepare("SELECT last_control_number FROM control");
		$sth->execute;
		my $rows = $sth->rows;
		if($rows) {
			while(my $sql = $sth->fetchrow_hashref) {
				$control_number = $sql->{last_control_number} + 1;
			}
		}
		else {
			$control_number = 1;
		}
		$sth->finish();

		$plain_cn = $control_number;

		my $i = 0;
		my $zeros;
		until ($i == ($length - length($control_number))) {
			$zeros .= "0";
			$i++;
		}
		
		$self->{'control_number'} = $zeros.$control_number;
		$self->{'plain_control_number'} = $plain_cn;
		$self->{'record_type'} = "new";
	}
	elsif($key eq 'existent')
	{
		$self->{'control_number'} = $length;
		$self->{'plain_control_number'} = "false";
		$self->{'record_type'} = "existent";
	}
}

# Fetch the Location name of the owner of the session id.
sub fetch_location_name
{
	my $self = shift;
	my $cgi = shift;
	
	$sth = $dbh->prepare("SELECT location_name FROM locations WHERE location_id IN (SELECT user_location FROM users WHERE user_id IN (SELECT session_user_id FROM sessions WHERE session_id=".$cgi->param('id')."))");
	$sth->execute;
	my $rows = $sth->rows;
	if($rows) {
		while(my $sql = $sth->fetchrow_hashref) {
			$self->{'location_name'} = $sql->{location_name};
		}
	} else {
		die("Cannot fetch location information");
	}
}

# Create a timestamp of the format YYYYMMDDHHMMSS.F for field
# 005 in the modified record.
sub marc_timestamp
{
	my $self = shift;

	my ($sec,$min,$hour,$mday,$mon,$year) = localtime();
	$year += 1900;
	$mon += 1;
	my $timestamp = sprintf("%4d%02d%02d%02d%02d%02d.0",
		$year,$mon,$mday,$hour,$min,$sec);

	$self->{'marc_timestamp'} = $timestamp;
}

# Create new MARC-object for manipulation and saving of MARC-records.
sub new
{
    my $class = shift;
	my $MARC_blob = shift;
	my $self = {};
    bless $self, $class;
	
	if($MARC_blob ne "") {
		$self->{'MARC_blob'} = $MARC_blob;
		$self->{'MARC_type'} = 'raw';
	} else {
		$self->{'MARC_blob'} = '';
		$self->{'MARC_type'} = 'empty';
	}

    return $self;
}

# Iterate through the http-request for modified fields, and replace
# the fields in the MARC-record with the modified ones.
sub replace
{
	my $self = shift;
	my $cgi = shift;
	my $identifier = shift;
	my %MARC_config = @_;
	my $control_number = $self->{'control_number'};
	my $timestamp = $self->{'marc_timestamp'};
	
	#if($self->{'MARC_type'} eq 'raw') {
	$record = MARC::Record::new_from_usmarc($self->{'MARC_blob'}) or die $!;
	#} else {
	#	$record = MARC::Record::new() or die $!;
	#}
	
	delete($self->{'MARC_blob'});
	delete($self->{'MARC_type'});

	# Update leader to be correct. Can be removed bu next update of
	# MARC::Record.
	my $ldr = ' ' x 24;
	substr( $ldr, 10, 1 ) = 2;
	substr( $ldr, 11, 1 ) = 2;
	substr( $ldr, 20, 1 ) = 4;
	substr( $ldr, 21, 1 ) = 5;
	substr( $ldr, 22, 1 ) = 0;
	$record->leader( $ldr );
	
	my($field_001, $field_003, $field_005, $field_852);
	$field_001 = $record->field( '001' );
	if($field_001) {
		$field_001->update($control_number);
	}
	else {
		$field_001 = MARC::Field->new('001', $control_number);
		$record->append_fields($field_001);
	}

	$field_003 = $record->field( '003' );
	if($field_003) {
		$field_003->update($identifier);
	}
	else {
		$field_003 = MARC::Field->new('003', $identifier);
		my $after_field = $record->field('001');
		#$record->insert_fields_after($after_field, $field_003);
		$record->append_fields($field_003);
	}

	$field_005 = $record->field( '005' );
	if ($field_005) {
		$field_005->update($timestamp);
	}
	else {
		$field_005 = MARC::Field->new('005', $timestamp);
		my $after_field = $record->field('003');
		#$record->insert_fields_after($after_field, $field_005);
		$record->append_fields($field_005);
	}
	
	#$field_852 = $record->field( '852' );
	#if($field_852) {
	#	if($self->{'record_type'} eq 'new') {
	#		$field_852->update('a' => $self->{'location_name'});
	#	} elsif ($self->{'record_type'} eq 'existent') {
	#		my $old = $field_852->as_string('a');
	#		if(!($old =~ /$self->{'location_name'}/)) {
	#			$field_852->update('a' => $old . " " . $self->{'location_name'});
	#		}
	#	}
	#}
	#else {
	#	$field_852 = MARC::Field->new(852, '', '', 'a' => $self->{'location_name'});
	#	$record->append_fields($field_852);
	#}

	#print "BEFORE: $self->{'MARC_blob'} <br><br><br>";
	#print $record->as_usmarc();

	foreach ($cgi->param())
	{
		if($cgi->param($_) eq "") {
			next;
		}
		if($MARC_config{$_}) {

			my $field_no = substr($_, 0, 3);
			my $code = substr($_, -1);
			my ($field, $ind1, $ind2);
			
			if(defined $cgi->param($field_no."_ind1") && defined $cgi->param($field_no."_ind2")) {
				if($cgi->param($field_no."_ind1") eq 'b') {
					$ind1 = "";
				} else {
					$ind1 = $cgi->param($field_no."_ind1");
				}
				if($cgi->param($field_no."_ind2") eq 'b') {
					$ind2 = "";
				} else {
					$ind2 = $cgi->param($field_no."_ind2");
				}
			} else {
				my $t_field = $record->field($field_no);
				if($t_field) {
					$ind1 = $record->field($field_no)->indicator('1');
					$ind2 = $record->field($field_no)->indicator('2');
				} else {
					$ind1 = '';
					$ind2 = '';
				}
			}

			if(length($_) == 4) {
				#print $cgi->header('text/plain');
				#print "FIELD: ".$field_no;
				$field = $record->field($field_no);
				if($field) {
					my $changes = $field->update( $code => $cgi->param($_) );
				}
				else {
					$field = MARC::Field->new($field_no, $ind1, $ind2, $code, $cgi->param($_)) or die ($! . $record->warnings());
					$record->append_fields($field);
				}

                #Only present on the MARC::Field-version modified by Christoffer Landtman, Oy Realnode Ab.
				#$field->sort_subfields();
			}
			elsif(length($_) == 3) {
				my $field = $record->field($field_no);
				$record->delete_field($field) if $field;
				$record->append_fields($field_no, $cgi->param($_));
  			}
		}
	}

	my $lint = new MARC::Lint;
	
	$self->{'MARC_final'} = $record->as_usmarc;
	#print "Content-type: text/plain\n\n";
	#print "\nAFTER: ";
	#print $record->as_formatted();
	#print "\n";
	#$lint->check_record($record);
	#print join( "\n", $lint->warnings ), "\n";
	#exit;
}

# Verify that there is not a record in the native database with identical
# ISBN before writing.
sub is_unique
{
	my $self = shift;
	my %config = @_;

	my $record = MARC::Record::new_from_usmarc($self->{'MARC_final'}) or die $!;
	my $field = $record->field('020');
	my $isbn = $field->subfield('a') if $field;

	if($isbn) {
		my $zc = new Net::Z3950::Connection($config{'zebra_host'}, $config{'zebra_port'}, databaseName => $config{'zebra_db'}) or
	    	die "Cannot set up connection to $config{'zebra_host'}:$config{'zebra_port'}: $!\n";
		my $result = $zc->search('@attr 1=7 ' . $isbn) or
	    	die "Search failed: " . $zc->errmsg() . "\n";

		$zc->close();
		if($result->size()) {
			return 0;
		}
		else {
			return 1;
		}
	}
	else {
		return 1;
	}
}

# Write the modified MARC-record into the database-folder of zebra, update the
# control table in the database with the newest control number and clean up.
sub write
{
	my $self = shift;
	my %config = @_;

	my $record = MARC::Record::new_from_usmarc($self->{'MARC_final'}) or die $!;
	my $field = $record->field('001');
	my $control_number = $field->as_string();

	open OUT, "> $config{'zebra_path'}$config{'zebra_db_folder'}$control_number"
		or die "Cannot open MARC-file ($config{'zebra_path'}$config{'zebra_db_folder'}$control_number): $!";
	print OUT $record->as_usmarc;
	close OUT;

	return 1;
}

sub database_update
{
	my $self = shift;
	my $copies = shift;

	my $record = MARC::Record::new_from_usmarc($self->{'MARC_final'}) or die $!;
	my $field = $record->field('001');
	my $control_number = $field->as_string();

	$sth=$dbh->prepare("SELECT user_location FROM users WHERE user_id=$user_id");
	$sth->execute;
	my $sql = $sth->fetchrow_hashref;
	my $location_id = $sql->{user_location};
	$sth->finish;

	if($self->{'plain_control_number'} ne "false") {
		$sth = $dbh->prepare("UPDATE control SET last_control_number=".$self->{'plain_control_number'});
		$sth->execute;
		$sth->finish;
	}

	my $i=0;
	my @ids=();
	if($copies ne 'zero') {
		until($i == $copies) {
			$sth=$dbh->prepare("INSERT INTO books SET book_control_number=$control_number, book_date_added=NOW(), book_location=$location_id");
			$sth->execute;
			$sth->finish;

			$sth=$dbh->prepare("SELECT LAST_INSERT_ID() AS last_id");
			$sth->execute;
			my $sql = $sth->fetchrow_hashref;
			push(@ids, $sql->{last_id});
			$sth->finish;

			$i++;
		}
	}

	return @ids;
}


sub zebraidx
{
	my $self = shift;
	my %config = @_;

	chdir($config{'zebra_path'});
	my $zebra = IDZebra::Session->open(configFile => $config{'zebra_path'}.$config{'zebra_config'})
		or die "Cannot create Zebra-session: $!";
	$zebra->group(recordId => 'file');
	$zebra->init();
	$zebra->update(path => $config{'zebra_db_folder'})
		or die "Cannot update Zebra: $zebra->errString ($zebra->errAdd)";
	$zebra->close;

	return 1;
}

1;