3 #use warnings; FIXME - Bug 2505
4 # script to shift marc to biblioitems
5 # scraped from updatedatabase for dev week by chris@katipo.co.nz
7 # find Koha's Perl modules
8 # test carefully before changing this
10 eval { require "$FindBin::Bin/../../kohalib.pl" };
15 use MARC
::File
::XML
( BinaryEncoding
=> 'utf8' );
17 print "moving MARC record to biblioitems table\n";
19 my $dbh = C4
::Context
->dbh();
22 # moving MARC data from marc_subfield_table to biblioitems.marc
25 # changing marc field type
26 $dbh->do('ALTER TABLE `biblioitems` CHANGE `marc` `marc` LONGBLOB NULL DEFAULT NULL ');
27 # adding marc xml, just for convenience
28 $dbh->do('ALTER TABLE `biblioitems` ADD `marcxml` LONGTEXT CHARACTER SET utf8 COLLATE utf8_general_ci NOT NULL ');
29 # moving data from marc_subfield_value to biblio
30 $sth = $dbh->prepare('select bibid,biblionumber from marc_biblio');
32 my $sth_update = $dbh->prepare('update biblioitems set marc=?, marcxml=? where biblionumber=?');
37 while (my ($bibid,$biblionumber) = $sth->fetchrow) {
38 my $record = LocalMARCgetbiblio
($dbh,$bibid);
39 #Force UTF-8 in record leader
40 $record->encoding('UTF-8');
42 if (C4
::Context
->preference("marcflavour")=~/unimarc/i){
43 $marcflavour="UNIMARC";
45 $marcflavour="USMARC";
47 $sth_update->execute($record->as_usmarc(),$record->as_xml_record($marcflavour),$biblionumber);
50 print "\r$totaldone / $totaltodo" unless ($totaldone % 100);
56 # this sub is a copy of Biblio.pm, version 2.2.4
57 # It is useful only once, for moving from 2.2 to 3.0
58 # the MARCgetbiblio in Biblio.pm
59 # is still here, but uses other tables
60 # (the ones that are filled by updatedatabase !)
63 sub LocalMARCgetbiblio
{
65 # Returns MARC::Record of the biblio passed in parameter.
66 my ( $dbh, $bibid ) = @_;
67 my $record = MARC
::Record
->new();
72 "select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
73 from marc_subfield_table
74 where bibid=? order by tag,tagorder,subfieldorder
79 "select subfieldvalue from marc_blob_subfield where blobidlink=?");
80 $sth->execute($bibid);
84 my $field; # for >=10 tags
85 my $prevvalue; # for <10 tags
86 while ( my $row = $sth->fetchrow_hashref ) {
88 if ( $row->{'valuebloblink'} ) { #---- search blob if there is one
89 $sth2->execute( $row->{'valuebloblink'} );
90 my $row2 = $sth2->fetchrow_hashref;
92 $row->{'subfieldvalue'} = $row2->{'subfieldvalue'};
94 if ( $row->{tagorder
} ne $prevtagorder || $row->{tag
} ne $prevtag ) {
95 $previndicator .= " ";
96 if ( $prevtag < 10 ) {
97 if ($prevtag ne '000') {
98 $record->add_fields( ( sprintf "%03s", $prevtag ), $prevvalue ) unless $prevtag eq "XXX"; # ignore the 1st loop
100 $record->leader(sprintf("%24s",$prevvalue));
104 $record->add_fields($field) unless $prevtag eq "XXX";
107 $prevtagorder = $row->{tagorder
};
108 $prevtag = $row->{tag
};
109 $previndicator = $row->{tag_indicator
};
110 if ( $row->{tag
} < 10 ) {
111 $prevvalue = $row->{subfieldvalue
};
114 $field = MARC
::Field
->new(
115 ( sprintf "%03s", $prevtag ),
116 substr( $row->{tag_indicator
} . ' ', 0, 1 ),
117 substr( $row->{tag_indicator
} . ' ', 1, 1 ),
118 $row->{'subfieldcode'},
119 $row->{'subfieldvalue'}
124 if ( $row->{tag
} < 10 ) {
125 $record->add_fields( ( sprintf "%03s", $row->{tag
} ),
126 $row->{'subfieldvalue'} );
129 $field->add_subfields( $row->{'subfieldcode'},
130 $row->{'subfieldvalue'} );
132 $prevtag = $row->{tag
};
133 $previndicator = $row->{tag_indicator
};
137 # the last has not been included inside the loop... do it now !
138 if ( $prevtag ne "XXX" )
139 { # check that we have found something. Otherwise, prevtag is still XXX and we
140 # must return an empty record, not make MARC::Record fail because we try to
141 # create a record with XXX as field :-(
142 if ( $prevtag < 10 ) {
143 $record->add_fields( $prevtag, $prevvalue );
147 # my $field = MARC::Field->new( $prevtag, "", "", %subfieldlist);
148 $record->add_fields($field);
151 if (C4
::Context
->preference('marcflavour')=~/unimarc/i){
152 $record->leader(' nac 22 1u 4500');
155 if ($record->field(100)) {
156 $string = substr($record->subfield(100,"a")." ",0,35);
157 my $f100 = $record->field(100);
158 $record->delete_field($f100);
160 $string = POSIX
::strftime
("%Y%m%d", localtime);
162 $string = sprintf("%-*s",35, $string);
164 substr($string,22,6,"frey50");
165 unless ($record->subfield(100,"a")){
166 $record->insert_fields_ordered(MARC
::Field
->new(100,"","","a"=>"$string"));