110 lines
No EOL
3.4 KiB
Perl
110 lines
No EOL
3.4 KiB
Perl
#!/usr/bin/perl
|
|
# script that populates the authorities table with marc
|
|
# Written by TG on 10/04/2006
|
|
use strict;
|
|
|
|
# Koha modules used
|
|
|
|
use C4::Context;
|
|
use MARC::Record;
|
|
use MARC::File::USMARC;
|
|
use MARC::File::XML;
|
|
use Time::HiRes qw(gettimeofday);
|
|
my $timeneeded;
|
|
my $starttime = gettimeofday;
|
|
|
|
|
|
my $dbh = C4::Context->dbh;
|
|
my $sthcols=$dbh->prepare("show columns from auth_header");
|
|
$sthcols->execute();
|
|
my %columns;
|
|
while (( my $cols)=$sthcols->fetchrow){
|
|
$columns{$cols}=1;
|
|
}
|
|
|
|
##Update the database if missing fields;
|
|
$dbh->do("LOCK TABLES auth_header WRITE auth_subfield_table READ");
|
|
unless ($columns{'linkid'}){
|
|
my $sth=$dbh->prepare("ALTER TABLE auth_header ADD COLUMN `linkid` BIGINT(20) UNSIGNED NOT NULL DEFAULT 0 ");
|
|
$sth->execute();
|
|
}
|
|
unless ($columns{'marc'}){
|
|
my $sth=$dbh->prepare("ALTER TABLE auth_header ADD COLUMN `marc` BLOB NOT NULL DEFAULT 0 ");
|
|
$sth->execute();
|
|
}
|
|
|
|
my $sth=$dbh->prepare("select authid,authtypecode from auth_header ");
|
|
$sth->execute();
|
|
|
|
my $i=0;
|
|
my $sth2 = $dbh->prepare("UPDATE auth_header set marc=? where authid=?" );
|
|
|
|
|
|
while (my ($authid,$authtypecode)=$sth->fetchrow ){
|
|
my $record = AUTHgetauthority($dbh,$authid);
|
|
$sth2->execute($record->as_usmarc,$authid);
|
|
$timeneeded = gettimeofday - $starttime unless ($i % 1000);
|
|
print "$i in $timeneeded s\n" unless ($i % 1000);
|
|
print "." unless ($i % 500);
|
|
$i++;
|
|
}
|
|
$dbh->do("UNLOCK TABLES ");
|
|
|
|
sub AUTHgetauthority {
|
|
# Returns MARC::Record of the biblio passed in parameter.
|
|
my ($dbh,$authid)=@_;
|
|
my $record = MARC::Record->new();
|
|
#---- TODO : the leader is missing
|
|
$record->leader(' ');
|
|
my $sth3=$dbh->prepare("select authid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue
|
|
from auth_subfield_table
|
|
where authid=? order by tag,tagorder,subfieldorder
|
|
");
|
|
$sth3->execute($authid);
|
|
my $prevtagorder=1;
|
|
my $prevtag='XXX';
|
|
my $previndicator;
|
|
my $field; # for >=10 tags
|
|
my $prevvalue; # for <10 tags
|
|
while (my $row=$sth3->fetchrow_hashref) {
|
|
if ($row->{tagorder} ne $prevtagorder || $row->{tag} ne $prevtag) {
|
|
$previndicator.=" ";
|
|
if ($prevtag <10) {
|
|
$record->add_fields((sprintf "%03s",$prevtag),$prevvalue) unless $prevtag eq "XXX"; # ignore the 1st loop
|
|
} else {
|
|
$record->add_fields($field) unless $prevtag eq "XXX";
|
|
}
|
|
undef $field;
|
|
$prevtagorder=$row->{tagorder};
|
|
$prevtag = $row->{tag};
|
|
$previndicator=$row->{tag_indicator};
|
|
if ($row->{tag}<10) {
|
|
$prevvalue = $row->{subfieldvalue};
|
|
} else {
|
|
$field = MARC::Field->new((sprintf "%03s",$prevtag), substr($row->{tag_indicator}.' ',0,1), substr($row->{tag_indicator}.' ',1,1), $row->{'subfieldcode'}, $row->{'subfieldvalue'} );
|
|
}
|
|
} else {
|
|
if ($row->{tag} <10) {
|
|
$record->add_fields((sprintf "%03s",$row->{tag}), $row->{'subfieldvalue'});
|
|
} else {
|
|
$field->add_subfields($row->{'subfieldcode'}, $row->{'subfieldvalue'} );
|
|
}
|
|
$prevtag= $row->{tag};
|
|
$previndicator=$row->{tag_indicator};
|
|
}
|
|
}
|
|
# the last has not been included inside the loop... do it now !
|
|
if ($prevtag ne "XXX") { # check that we have found something. Otherwise, prevtag is still XXX and we
|
|
# must return an empty record, not make MARC::Record fail because we try to
|
|
# create a record with XXX as field :-(
|
|
if ($prevtag <10) {
|
|
$record->add_fields($prevtag,$prevvalue);
|
|
} else {
|
|
# my $field = MARC::Field->new( $prevtag, "", "", %subfieldlist);
|
|
$record->add_fields($field);
|
|
}
|
|
}
|
|
return $record;
|
|
}
|
|
|
|
END; |