Koha/misc/migration_tools/22_to_30/move_marc_to_biblioitems.pl
Jonathan Druart 238fabc4ab Bug 28617: Remove kohalib.pl and rely on PERL5LIB
The purpose of this script was to load the relevant Koha lib for the
different scripts (installation, cronjob, CLI, etc.)
However it is not used consistently and we prefer to rely on PERL5LIB.

From bug 28617 comment 6 from Galen:
"""
Time marches on, and one of the motivations for having kohalib.pl - making
it possible to install Koha without setting a single environment variable -
has been obviated by the vast improvements in the ease of installing Koha.

Consequently, I think kohalib.pl can go away.
"""

Test plan:
confirm that the changes make sense and that kohalib.pl can be removed
safely.

Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>
Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>
Signed-off-by: Fridolin Somers <fridolin.somers@biblibre.com>
2021-12-07 12:16:28 -10:00

162 lines
5.5 KiB
Perl
Executable file

#!/usr/bin/perl
use Modern::Perl;
# script to shift marc to biblioitems
# scraped from updatedatabase for dev week by chris@katipo.co.nz
use C4::Context;
use MARC::Record;
use MARC::File::XML ( BinaryEncoding => 'utf8' );
print "moving MARC record to biblioitems table\n";
my $dbh = C4::Context->dbh();
#
# moving MARC data from marc_subfield_table to biblioitems.marc
#
# changing marc field type
$dbh->do('ALTER TABLE `biblioitems` CHANGE `marc` `marc` LONGBLOB NULL DEFAULT NULL ');
# adding marc xml, just for convenience
$dbh->do('ALTER TABLE `biblioitems` ADD `marcxml` LONGTEXT CHARACTER SET utf8 COLLATE utf8_general_ci NOT NULL ');
# moving data from marc_subfield_value to biblio
my $sth = $dbh->prepare('select bibid,biblionumber from marc_biblio');
$sth->execute;
my $sth_update = $dbh->prepare('update biblioitems set marc=?, marcxml=? where biblionumber=?');
my $totaldone=0;
$|=1;
while (my ($bibid,$biblionumber) = $sth->fetchrow) {
my $record = LocalMARCgetbiblio($dbh,$bibid);
#Force UTF-8 in record leader
$record->encoding('UTF-8');
my $marcflavour;
if (C4::Context->preference("marcflavour")=~/unimarc/i){
$marcflavour="UNIMARC";
} else {
$marcflavour="USMARC";
}
$sth_update->execute($record->as_usmarc(),$record->as_xml_record($marcflavour),$biblionumber);
$totaldone++;
print ".";
print "\r$totaldone" unless ($totaldone % 100);
}
print "\rdone\n";
#
# this sub is a copy of Biblio.pm, version 2.2.4
# It is useful only once, for moving from 2.2 to 3.0
# the MARCgetbiblio in Biblio.pm
# is still here, but uses other tables
# (the ones that are filled by updatedatabase !)
#
sub LocalMARCgetbiblio {
# Returns MARC::Record of the biblio passed in parameter.
my ( $dbh, $bibid ) = @_;
my $record = MARC::Record->new();
# warn "". $bidid;
my $sth =
$dbh->prepare(
"select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
from marc_subfield_table
where bibid=? order by tag,tagorder,subfieldorder
"
);
my $sth2 =
$dbh->prepare(
"select subfieldvalue from marc_blob_subfield where blobidlink=?");
$sth->execute($bibid);
my $prevtagorder = 1;
my $prevtag = 'XXX';
my $previndicator;
my $field; # for >=10 tags
my $prevvalue; # for <10 tags
while ( my $row = $sth->fetchrow_hashref ) {
if ( $row->{'valuebloblink'} ) { #---- search blob if there is one
$sth2->execute( $row->{'valuebloblink'} );
my $row2 = $sth2->fetchrow_hashref;
$sth2->finish;
$row->{'subfieldvalue'} = $row2->{'subfieldvalue'};
}
if ( $row->{tagorder} ne $prevtagorder || $row->{tag} ne $prevtag ) {
$previndicator .= " ";
if ( $prevtag < 10 ) {
if ($prevtag ne '000') {
$record->add_fields( ( sprintf "%03s", $prevtag ), $prevvalue ) unless $prevtag eq "XXX"; # ignore the 1st loop
} else {
$record->leader(sprintf("%24s",$prevvalue));
}
}
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);
}
}
if (C4::Context->preference('marcflavour')=~/unimarc/i){
$record->leader(' nac 22 1u 4500');
my $string;
if ($record->field(100)) {
$string = substr($record->subfield(100,"a")." ",0,35);
my $f100 = $record->field(100);
$record->delete_field($f100);
} else {
$string = POSIX::strftime("%Y%m%d", localtime);
$string=~s/\-//g;
$string = sprintf("%-*s",35, $string);
}
substr($string,22,6,"frey50");
unless ($record->subfield(100,"a")){
$record->insert_fields_ordered(MARC::Field->new(100,"","","a"=>"$string"));
}
}
return $record;
}