From: rangi Date: Sat, 26 Jun 2004 23:19:59 +0000 (+0000) Subject: Fixing modaddauthor, and adding getitemtypes. X-Git-Tag: R_2-1~144 X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=commitdiff_plain;h=09c2a88e028e5c1248ee760fdaba532956234b51;hp=9883661e879e20dd32c4c1cb08f2b20fbe9fbc8b;p=koha_fer Fixing modaddauthor, and adding getitemtypes. Also tidying up formatting of code --- diff --git a/C4/Biblio.pm b/C4/Biblio.pm index efb49e3715..911812253a 100644 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -1,4 +1,5 @@ package C4::Biblio; + # Copyright 2000-2002 Katipo Communications # # This file is part of Koha. @@ -28,44 +29,45 @@ use vars qw($VERSION @ISA @EXPORT); $VERSION = 0.01; @ISA = qw(Exporter); + # # don't forget MARCxxx subs are exported only for testing purposes. Should not be used # as the old-style API and the NEW one are the only public functions. # @EXPORT = qw( - &updateBiblio &updateBiblioItem &updateItem - &itemcount &newbiblio &newbiblioitem - &modnote &newsubject &newsubtitle - &modbiblio &checkitems - &newitems &modbibitem - &modsubtitle &modsubject &modaddauthor &moditem &countitems - &delitem &deletebiblioitem &delbiblio - &getbiblio - &getbiblioitembybiblionumber - &getbiblioitem &getitemsbybiblioitem - &skip - &newcompletebiblioitem - - &MARCfind_oldbiblionumber_from_MARCbibid - &MARCfind_MARCbibid_from_oldbiblionumber - &MARCfind_marc_from_kohafield - &MARCfindsubfield - &MARCfind_frameworkcode - &MARCgettagslib - - &NEWnewbiblio &NEWnewitem - &NEWmodbiblio &NEWmoditem - &NEWdelbiblio &NEWdelitem - - &MARCaddbiblio &MARCadditem - &MARCmodsubfield &MARCaddsubfield - &MARCmodbiblio &MARCmoditem - &MARCkoha2marcBiblio &MARCmarc2koha - &MARCkoha2marcItem &MARChtml2marc - &MARCgetbiblio &MARCgetitem - &MARCaddword &MARCdelword - &char_decode - ); + &updateBiblio &updateBiblioItem &updateItem + &itemcount &newbiblio &newbiblioitem + &modnote &newsubject &newsubtitle + &modbiblio &checkitems + &newitems &modbibitem + &modsubtitle &modsubject &modaddauthor &moditem &countitems + &delitem &deletebiblioitem &delbiblio + &getbiblio + &getbiblioitembybiblionumber + &getbiblioitem &getitemsbybiblioitem + &skip &getitemtypes + &newcompletebiblioitem + + &MARCfind_oldbiblionumber_from_MARCbibid + &MARCfind_MARCbibid_from_oldbiblionumber + &MARCfind_marc_from_kohafield + &MARCfindsubfield + &MARCfind_frameworkcode + &MARCgettagslib + + &NEWnewbiblio &NEWnewitem + &NEWmodbiblio &NEWmoditem + &NEWdelbiblio &NEWdelitem + + &MARCaddbiblio &MARCadditem + &MARCmodsubfield &MARCaddsubfield + &MARCmodbiblio &MARCmoditem + &MARCkoha2marcBiblio &MARCmarc2koha + &MARCkoha2marcItem &MARChtml2marc + &MARCgetbiblio &MARCgetitem + &MARCaddword &MARCdelword + &char_decode +); # # @@ -221,750 +223,1036 @@ used to manage MARC_word table and should not be useful elsewhere =cut sub MARCgettagslib { - my ($dbh,$forlibrarian,$frameworkcode)= @_; - $frameworkcode="" unless $frameworkcode; - my $sth; - my $libfield = ($forlibrarian eq 1)? 'liblibrarian' : 'libopac'; - # check that framework exists - $sth=$dbh->prepare("select count(*) from marc_tag_structure where frameworkcode=?"); - $sth->execute($frameworkcode); - my ($total) = $sth->fetchrow; - $frameworkcode="" unless ($total >0); - $sth=$dbh->prepare("select tagfield,$libfield as lib,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield"); - $sth->execute($frameworkcode); - my ($lib,$tag,$res,$tab,$mandatory,$repeatable); - while ( ($tag,$lib,$mandatory,$repeatable) = $sth->fetchrow) { - $res->{$tag}->{lib}=$lib; - $res->{$tab}->{tab}=""; # XXX - $res->{$tag}->{mandatory}=$mandatory; - $res->{$tag}->{repeatable}=$repeatable; - } - - $sth=$dbh->prepare("select tagfield,tagsubfield,$libfield as lib,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl from marc_subfield_structure where frameworkcode=? order by tagfield,tagsubfield"); - $sth->execute($frameworkcode); - - my $subfield; - my $authorised_value; - my $authtypecode; - my $value_builder; - my $kohafield; - my $seealso; - my $hidden; - my $isurl; - while ( ($tag, $subfield, $lib, $tab, $mandatory, $repeatable,$authorised_value,$authtypecode,$value_builder,$kohafield,$seealso,$hidden,$isurl) = $sth->fetchrow) { - $res->{$tag}->{$subfield}->{lib}=$lib; - $res->{$tag}->{$subfield}->{tab}=$tab; - $res->{$tag}->{$subfield}->{mandatory}=$mandatory; - $res->{$tag}->{$subfield}->{repeatable}=$repeatable; - $res->{$tag}->{$subfield}->{authorised_value}=$authorised_value; - $res->{$tag}->{$subfield}->{authtypecode}=$authtypecode; - $res->{$tag}->{$subfield}->{value_builder}=$value_builder; - $res->{$tag}->{$subfield}->{kohafield}=$kohafield; - $res->{$tag}->{$subfield}->{seealso}=$seealso; - $res->{$tag}->{$subfield}->{hidden}=$hidden; - $res->{$tag}->{$subfield}->{isurl}=$isurl; - } - return $res; + my ( $dbh, $forlibrarian, $frameworkcode ) = @_; + $frameworkcode = "" unless $frameworkcode; + my $sth; + my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac'; + + # check that framework exists + $sth = + $dbh->prepare( + "select count(*) from marc_tag_structure where frameworkcode=?"); + $sth->execute($frameworkcode); + my ($total) = $sth->fetchrow; + $frameworkcode = "" unless ( $total > 0 ); + $sth = + $dbh->prepare( +"select tagfield,$libfield as lib,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield" + ); + $sth->execute($frameworkcode); + my ( $lib, $tag, $res, $tab, $mandatory, $repeatable ); + + while ( ( $tag, $lib, $mandatory, $repeatable ) = $sth->fetchrow ) { + $res->{$tag}->{lib} = $lib; + $res->{$tab}->{tab} = ""; # XXX + $res->{$tag}->{mandatory} = $mandatory; + $res->{$tag}->{repeatable} = $repeatable; + } + + $sth = + $dbh->prepare( +"select tagfield,tagsubfield,$libfield as lib,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl from marc_subfield_structure where frameworkcode=? order by tagfield,tagsubfield" + ); + $sth->execute($frameworkcode); + + my $subfield; + my $authorised_value; + my $authtypecode; + my $value_builder; + my $kohafield; + my $seealso; + my $hidden; + my $isurl; + + while ( + ( $tag, $subfield, $lib, $tab, + $mandatory, $repeatable, $authorised_value, $authtypecode, + $value_builder, $kohafield, $seealso, $hidden, + $isurl ) + = $sth->fetchrow + ) + { + $res->{$tag}->{$subfield}->{lib} = $lib; + $res->{$tag}->{$subfield}->{tab} = $tab; + $res->{$tag}->{$subfield}->{mandatory} = $mandatory; + $res->{$tag}->{$subfield}->{repeatable} = $repeatable; + $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value; + $res->{$tag}->{$subfield}->{authtypecode} = $authtypecode; + $res->{$tag}->{$subfield}->{value_builder} = $value_builder; + $res->{$tag}->{$subfield}->{kohafield} = $kohafield; + $res->{$tag}->{$subfield}->{seealso} = $seealso; + $res->{$tag}->{$subfield}->{hidden} = $hidden; + $res->{$tag}->{$subfield}->{isurl} = $isurl; + } + return $res; } sub MARCfind_marc_from_kohafield { - my ($dbh,$kohafield) = @_; - return 0,0 unless $kohafield; - my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?"); + my ( $dbh, $kohafield ) = @_; + return 0, 0 unless $kohafield; + my $sth = + $dbh->prepare( +"select tagfield,tagsubfield from marc_subfield_structure where kohafield=?" + ); $sth->execute($kohafield); - my ($tagfield,$tagsubfield) = $sth->fetchrow; - return ($tagfield,$tagsubfield); + my ( $tagfield, $tagsubfield ) = $sth->fetchrow; + return ( $tagfield, $tagsubfield ); } sub MARCfind_oldbiblionumber_from_MARCbibid { - my ($dbh,$MARCbibid) = @_; - my $sth=$dbh->prepare("select biblionumber from marc_biblio where bibid=?"); + my ( $dbh, $MARCbibid ) = @_; + my $sth = + $dbh->prepare("select biblionumber from marc_biblio where bibid=?"); $sth->execute($MARCbibid); my ($biblionumber) = $sth->fetchrow; return $biblionumber; } sub MARCfind_MARCbibid_from_oldbiblionumber { - my ($dbh,$oldbiblionumber) = @_; - my $sth=$dbh->prepare("select bibid from marc_biblio where biblionumber=?"); + my ( $dbh, $oldbiblionumber ) = @_; + my $sth = + $dbh->prepare("select bibid from marc_biblio where biblionumber=?"); $sth->execute($oldbiblionumber); my ($bibid) = $sth->fetchrow; return $bibid; } sub MARCaddbiblio { + # pass the MARC::Record to this function, and it will create the records in the marc tables - my ($dbh,$record,$biblionumber,$frameworkcode,$bibid) = @_; - my @fields=$record->fields(); -# warn "IN MARCaddbiblio $bibid => ".$record->as_formatted; -# my $bibid; -# adding main table, and retrieving bibid + my ( $dbh, $record, $biblionumber, $frameworkcode, $bibid ) = @_; + my @fields = $record->fields(); + + # warn "IN MARCaddbiblio $bibid => ".$record->as_formatted; + # my $bibid; + # adding main table, and retrieving bibid # if bibid is sent, then it's not a true add, it's only a re-add, after a delete (ie, a mod) -# if bibid empty => true add, find a new bibid number - unless ($bibid) { - $dbh->do("lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ"); - my $sth=$dbh->prepare("insert into marc_biblio (datecreated,biblionumber,frameworkcode) values (now(),?,?)"); - $sth->execute($biblionumber,$frameworkcode); - $sth=$dbh->prepare("select max(bibid) from marc_biblio"); - $sth->execute; - ($bibid)=$sth->fetchrow; - $sth->finish; - } - my $fieldcount=0; - # now, add subfields... - foreach my $field (@fields) { - $fieldcount++; - if ($field->tag() <10) { - &MARCaddsubfield($dbh,$bibid, - $field->tag(), - '', - $fieldcount, - '', - 1, - $field->data() - ); - } else { - my @subfields=$field->subfields(); - foreach my $subfieldcount (0..$#subfields) { - &MARCaddsubfield($dbh,$bibid, - $field->tag(), - $field->indicator(1).$field->indicator(2), - $fieldcount, - $subfields[$subfieldcount][0], - $subfieldcount+1, - $subfields[$subfieldcount][1] - ); - } - } - } - $dbh->do("unlock tables"); - return $bibid; + # if bibid empty => true add, find a new bibid number + unless ($bibid) { + $dbh->do( +"lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ" + ); + my $sth = + $dbh->prepare( +"insert into marc_biblio (datecreated,biblionumber,frameworkcode) values (now(),?,?)" + ); + $sth->execute( $biblionumber, $frameworkcode ); + $sth = $dbh->prepare("select max(bibid) from marc_biblio"); + $sth->execute; + ($bibid) = $sth->fetchrow; + $sth->finish; + } + my $fieldcount = 0; + + # now, add subfields... + foreach my $field (@fields) { + $fieldcount++; + if ( $field->tag() < 10 ) { + &MARCaddsubfield( $dbh, $bibid, $field->tag(), '', $fieldcount, '', + 1, $field->data() ); + } + else { + my @subfields = $field->subfields(); + foreach my $subfieldcount ( 0 .. $#subfields ) { + &MARCaddsubfield( + $dbh, + $bibid, + $field->tag(), + $field->indicator(1) . $field->indicator(2), + $fieldcount, + $subfields[$subfieldcount][0], + $subfieldcount + 1, + $subfields[$subfieldcount][1] + ); + } + } + } + $dbh->do("unlock tables"); + return $bibid; } sub MARCadditem { + # pass the MARC::Record to this function, and it will create the records in the marc tables - my ($dbh,$record,$biblionumber) = @_; -# warn "adding : ".$record->as_formatted(); -# search for MARC biblionumber - $dbh->do("lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ"); - my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber); - my @fields=$record->fields(); - my $sth = $dbh->prepare("select max(tagorder) from marc_subfield_table where bibid=?"); + my ( $dbh, $record, $biblionumber ) = @_; + + # warn "adding : ".$record->as_formatted(); + # search for MARC biblionumber + $dbh->do( +"lock tables marc_biblio WRITE,marc_subfield_table WRITE, marc_word WRITE, marc_blob_subfield WRITE, stopwords READ" + ); + my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblionumber ); + my @fields = $record->fields(); + my $sth = + $dbh->prepare( + "select max(tagorder) from marc_subfield_table where bibid=?"); $sth->execute($bibid); my ($fieldcount) = $sth->fetchrow; + # now, add subfields... foreach my $field (@fields) { - my @subfields=$field->subfields(); - $fieldcount++; - foreach my $subfieldcount (0..$#subfields) { - &MARCaddsubfield($dbh,$bibid, - $field->tag(), - $field->indicator(1).$field->indicator(2), - $fieldcount, - $subfields[$subfieldcount][0], - $subfieldcount+1, - $subfields[$subfieldcount][1] - ); - } + my @subfields = $field->subfields(); + $fieldcount++; + foreach my $subfieldcount ( 0 .. $#subfields ) { + &MARCaddsubfield( + $dbh, + $bibid, + $field->tag(), + $field->indicator(1) . $field->indicator(2), + $fieldcount, + $subfields[$subfieldcount][0], + $subfieldcount + 1, + $subfields[$subfieldcount][1] + ); + } } $dbh->do("unlock tables"); return $bibid; } sub MARCaddsubfield { -# Add a new subfield to a tag into the DB. - my ($dbh,$bibid,$tagid,$tag_indicator,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalues) = @_; - # if not value, end of job, we do nothing - if (length($subfieldvalues) ==0) { - return; - } - if (not($subfieldcode)) { - $subfieldcode=' '; - } - my @subfieldvalues = split /\|/,$subfieldvalues; - foreach my $subfieldvalue (@subfieldvalues) { - if (length($subfieldvalue)>255) { - $dbh->do("lock tables marc_blob_subfield WRITE, marc_subfield_table WRITE"); - my $sth=$dbh->prepare("insert into marc_blob_subfield (subfieldvalue) values (?)"); - $sth->execute($subfieldvalue); - $sth=$dbh->prepare("select max(blobidlink)from marc_blob_subfield"); - $sth->execute; - my ($res)=$sth->fetchrow; - $sth=$dbh->prepare("insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,valuebloblink) values (?,?,?,?,?,?,?)"); - $sth->execute($bibid,(sprintf "%03s",$tagid),$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$res); - if ($sth->errstr) { - warn "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue)\n"; - } - $dbh->do("unlock tables"); - } else { - my $sth=$dbh->prepare("insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values (?,?,?,?,?,?,?)"); - $sth->execute($bibid,(sprintf "%03s",$tagid),$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue); - if ($sth->errstr) { - warn "ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue)\n"; - } - } - &MARCaddword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue); - } + + # Add a new subfield to a tag into the DB. + my ( + $dbh, $bibid, $tagid, $tag_indicator, + $tagorder, $subfieldcode, $subfieldorder, $subfieldvalues + ) + = @_; + + # if not value, end of job, we do nothing + if ( length($subfieldvalues) == 0 ) { + return; + } + if ( not($subfieldcode) ) { + $subfieldcode = ' '; + } + my @subfieldvalues = split /\|/, $subfieldvalues; + foreach my $subfieldvalue (@subfieldvalues) { + if ( length($subfieldvalue) > 255 ) { + $dbh->do( +"lock tables marc_blob_subfield WRITE, marc_subfield_table WRITE" + ); + my $sth = + $dbh->prepare( + "insert into marc_blob_subfield (subfieldvalue) values (?)"); + $sth->execute($subfieldvalue); + $sth = + $dbh->prepare("select max(blobidlink)from marc_blob_subfield"); + $sth->execute; + my ($res) = $sth->fetchrow; + $sth = + $dbh->prepare( +"insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,valuebloblink) values (?,?,?,?,?,?,?)" + ); + $sth->execute( $bibid, ( sprintf "%03s", $tagid ), $tagorder, + $tag_indicator, $subfieldcode, $subfieldorder, $res ); + + if ( $sth->errstr ) { + warn +"ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue)\n"; + } + $dbh->do("unlock tables"); + } + else { + my $sth = + $dbh->prepare( +"insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values (?,?,?,?,?,?,?)" + ); + $sth->execute( + $bibid, ( sprintf "%03s", $tagid ), + $tagorder, $tag_indicator, + $subfieldcode, $subfieldorder, + $subfieldvalue + ); + if ( $sth->errstr ) { + warn +"ERROR ==> insert into marc_subfield_table (bibid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue) values ($bibid,$tagid,$tagorder,$tag_indicator,$subfieldcode,$subfieldorder,$subfieldvalue)\n"; + } + } + &MARCaddword( + $dbh, $bibid, $tagid, $tagorder, + $subfieldcode, $subfieldorder, $subfieldvalue + ); + } } sub MARCgetbiblio { -# Returns MARC::Record of the biblio passed in parameter. - my ($dbh,$bibid)=@_; + + # Returns MARC::Record of the biblio passed in parameter. + my ( $dbh, $bibid ) = @_; my $record = MARC::Record->new(); -#---- TODO : the leader is missing - $record->leader(' '); - my $sth=$dbh->prepare("select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink + + #---- TODO : the leader is missing + $record->leader(' '); + 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,subfieldcode - "); - 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) { - $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; + " + ); + 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 ) { + $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; } + sub MARCgetitem { -# Returns MARC::Record of the biblio passed in parameter. - my ($dbh,$bibid,$itemnumber)=@_; + + # Returns MARC::Record of the biblio passed in parameter. + my ( $dbh, $bibid, $itemnumber ) = @_; my $record = MARC::Record->new(); -# search MARC tagorder - my $sth2 = $dbh->prepare("select tagorder from marc_subfield_table,marc_subfield_structure where marc_subfield_table.tag=marc_subfield_structure.tagfield and marc_subfield_table.subfieldcode=marc_subfield_structure.tagsubfield and bibid=? and kohafield='items.itemnumber' and subfieldvalue=?"); - $sth2->execute($bibid,$itemnumber); + + # search MARC tagorder + my $sth2 = + $dbh->prepare( +"select tagorder from marc_subfield_table,marc_subfield_structure where marc_subfield_table.tag=marc_subfield_structure.tagfield and marc_subfield_table.subfieldcode=marc_subfield_structure.tagsubfield and bibid=? and kohafield='items.itemnumber' and subfieldvalue=?" + ); + $sth2->execute( $bibid, $itemnumber ); my ($tagorder) = $sth2->fetchrow_array(); -#---- TODO : the leader is missing - my $sth=$dbh->prepare("select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink + + #---- TODO : the leader is missing + my $sth = + $dbh->prepare( +"select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink from marc_subfield_table where bibid=? and tagorder=? order by subfieldcode,subfieldorder - "); - $sth2=$dbh->prepare("select subfieldvalue from marc_blob_subfield where blobidlink=?"); - $sth->execute($bibid,$tagorder); - 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 ($record->field($row->{'tag'})) { - my $field; + " + ); + $sth2 = + $dbh->prepare( + "select subfieldvalue from marc_blob_subfield where blobidlink=?"); + $sth->execute( $bibid, $tagorder ); + 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 ( $record->field( $row->{'tag'} ) ) { + my $field; + #--- this test must stay as this, because of strange behaviour of mySQL/Perl DBI with char var containing a number... -#--- sometimes, eliminates 0 at beginning, sometimes no ;-\\\ - if (length($row->{'tag'}) <3) { - $row->{'tag'} = "0".$row->{'tag'}; - } - $field =$record->field($row->{'tag'}); - if ($field) { - my $x = $field->add_subfields($row->{'subfieldcode'},$row->{'subfieldvalue'}); - $record->delete_field($field); - $record->add_fields($field); - } - } else { - if (length($row->{'tag'}) < 3) { - $row->{'tag'} = "0".$row->{'tag'}; - } - my $temp = MARC::Field->new($row->{'tag'}," "," ", $row->{'subfieldcode'} => $row->{'subfieldvalue'}); - $record->add_fields($temp); - } + #--- sometimes, eliminates 0 at beginning, sometimes no ;-\\\ + if ( length( $row->{'tag'} ) < 3 ) { + $row->{'tag'} = "0" . $row->{'tag'}; + } + $field = $record->field( $row->{'tag'} ); + if ($field) { + my $x = + $field->add_subfields( $row->{'subfieldcode'}, + $row->{'subfieldvalue'} ); + $record->delete_field($field); + $record->add_fields($field); + } + } + else { + if ( length( $row->{'tag'} ) < 3 ) { + $row->{'tag'} = "0" . $row->{'tag'}; + } + my $temp = + MARC::Field->new( $row->{'tag'}, " ", " ", + $row->{'subfieldcode'} => $row->{'subfieldvalue'} ); + $record->add_fields($temp); + } } return $record; } sub MARCmodbiblio { - my ($dbh,$bibid,$record,$delete)=@_; - my $oldrecord=&MARCgetbiblio($dbh,$bibid); - if ($oldrecord eq $record) { - return; - } -# 1st delete the biblio, -# 2nd recreate it - my $biblionumber = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid); - &MARCdelbiblio($dbh,$bibid,1); - &MARCaddbiblio($dbh,$record,$biblionumber,$bibid); + my ( $dbh, $bibid, $record, $delete ) = @_; + my $oldrecord = &MARCgetbiblio( $dbh, $bibid ); + if ( $oldrecord eq $record ) { + return; + } + + # 1st delete the biblio, + # 2nd recreate it + my $biblionumber = MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid ); + &MARCdelbiblio( $dbh, $bibid, 1 ); + &MARCaddbiblio( $dbh, $record, $biblionumber, $bibid ); } sub MARCdelbiblio { - my ($dbh,$bibid,$keep_items) = @_; -# if the keep_item is set to 1, then all items are preserved. -# This flag is set when the delbiblio is called by modbiblio -# due to a too complex structure of MARC (repeatable fields and subfields), -# the best solution for a modif is to delete / recreate the record. + my ( $dbh, $bibid, $keep_items ) = @_; + + # if the keep_item is set to 1, then all items are preserved. + # This flag is set when the delbiblio is called by modbiblio + # due to a too complex structure of MARC (repeatable fields and subfields), + # the best solution for a modif is to delete / recreate the record. # 1st of all, copy the MARC::Record to deletedbiblio table => if a true deletion, MARC data will be kept. # if deletion called before MARCmodbiblio => won't do anything, as the oldbiblionumber doesn't -# exist in deletedbiblio table - my $record = MARCgetbiblio($dbh,$bibid); - my $oldbiblionumber = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid); - my $copy2deleted=$dbh->prepare("update deletedbiblio set marc=? where biblionumber=?"); - $copy2deleted->execute($record->as_usmarc(),$oldbiblionumber); -# now, delete in MARC tables. - if ($keep_items eq 1) { - #search item field code - my $sth = $dbh->prepare("select tagfield from marc_subfield_structure where kohafield like 'items.%'"); - $sth->execute; - my $itemtag = $sth->fetchrow_hashref->{tagfield}; - $dbh->do("delete from marc_subfield_table where bibid=$bibid and tag<>$itemtag"); - $dbh->do("delete from marc_word where bibid=$bibid and not (tagsubfield like \"$itemtag%\")"); - } else { - $dbh->do("delete from marc_biblio where bibid=$bibid"); - $dbh->do("delete from marc_subfield_table where bibid=$bibid"); - $dbh->do("delete from marc_word where bibid=$bibid"); - } + # exist in deletedbiblio table + my $record = MARCgetbiblio( $dbh, $bibid ); + my $oldbiblionumber = + MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid ); + my $copy2deleted = + $dbh->prepare("update deletedbiblio set marc=? where biblionumber=?"); + $copy2deleted->execute( $record->as_usmarc(), $oldbiblionumber ); + + # now, delete in MARC tables. + if ( $keep_items eq 1 ) { + + #search item field code + my $sth = + $dbh->prepare( +"select tagfield from marc_subfield_structure where kohafield like 'items.%'" + ); + $sth->execute; + my $itemtag = $sth->fetchrow_hashref->{tagfield}; + $dbh->do( +"delete from marc_subfield_table where bibid=$bibid and tag<>$itemtag" + ); + $dbh->do( +"delete from marc_word where bibid=$bibid and not (tagsubfield like \"$itemtag%\")" + ); + } + else { + $dbh->do("delete from marc_biblio where bibid=$bibid"); + $dbh->do("delete from marc_subfield_table where bibid=$bibid"); + $dbh->do("delete from marc_word where bibid=$bibid"); + } } sub MARCdelitem { -# delete the item passed in parameter in MARC tables. - my ($dbh,$bibid,$itemnumber)=@_; - # my $record = MARC::Record->new(); - # search MARC tagorder - my $record = MARCgetitem($dbh,$bibid,$itemnumber); - my $copy2deleted=$dbh->prepare("update deleteditems set marc=? where itemnumber=?"); - $copy2deleted->execute($record->as_usmarc(),$itemnumber); - - my $sth2 = $dbh->prepare("select tagorder from marc_subfield_table,marc_subfield_structure where marc_subfield_table.tag=marc_subfield_structure.tagfield and marc_subfield_table.subfieldcode=marc_subfield_structure.tagsubfield and bibid=? and kohafield='items.itemnumber' and subfieldvalue=?"); - $sth2->execute($bibid,$itemnumber); - my ($tagorder) = $sth2->fetchrow_array(); - my $sth=$dbh->prepare("delete from marc_subfield_table where bibid=? and tagorder=?"); - $sth->execute($bibid,$tagorder); + + # delete the item passed in parameter in MARC tables. + my ( $dbh, $bibid, $itemnumber ) = @_; + + # my $record = MARC::Record->new(); + # search MARC tagorder + my $record = MARCgetitem( $dbh, $bibid, $itemnumber ); + my $copy2deleted = + $dbh->prepare("update deleteditems set marc=? where itemnumber=?"); + $copy2deleted->execute( $record->as_usmarc(), $itemnumber ); + + my $sth2 = + $dbh->prepare( +"select tagorder from marc_subfield_table,marc_subfield_structure where marc_subfield_table.tag=marc_subfield_structure.tagfield and marc_subfield_table.subfieldcode=marc_subfield_structure.tagsubfield and bibid=? and kohafield='items.itemnumber' and subfieldvalue=?" + ); + $sth2->execute( $bibid, $itemnumber ); + my ($tagorder) = $sth2->fetchrow_array(); + my $sth = + $dbh->prepare( + "delete from marc_subfield_table where bibid=? and tagorder=?"); + $sth->execute( $bibid, $tagorder ); } sub MARCmoditem { - my ($dbh,$record,$bibid,$itemnumber,$delete)=@_; - my $oldrecord=&MARCgetitem($dbh,$bibid,$itemnumber); - # if nothing to change, don't waste time... - if ($oldrecord eq $record) { - return; - } - # otherwise, skip through each subfield... - my @fields = $record->fields(); - # search old MARC item - my $sth2 = $dbh->prepare("select tagorder from marc_subfield_table,marc_subfield_structure where marc_subfield_table.tag=marc_subfield_structure.tagfield and marc_subfield_table.subfieldcode=marc_subfield_structure.tagsubfield and bibid=? and kohafield='items.itemnumber' and subfieldvalue=?"); - $sth2->execute($bibid,$itemnumber); - my ($tagorder) = $sth2->fetchrow_array(); - foreach my $field (@fields) { - my $oldfield = $oldrecord->field($field->tag()); - my @subfields=$field->subfields(); - my $subfieldorder=0; - foreach my $subfield (@subfields) { - $subfieldorder++; -# warn "compare : $oldfield".$oldfield->subfield(@$subfield[0]); - if ($oldfield eq 0 or (length($oldfield->subfield(@$subfield[0])) ==0) ) { - # just adding datas... + my ( $dbh, $record, $bibid, $itemnumber, $delete ) = @_; + my $oldrecord = &MARCgetitem( $dbh, $bibid, $itemnumber ); + + # if nothing to change, don't waste time... + if ( $oldrecord eq $record ) { + return; + } + + # otherwise, skip through each subfield... + my @fields = $record->fields(); + + # search old MARC item + my $sth2 = + $dbh->prepare( +"select tagorder from marc_subfield_table,marc_subfield_structure where marc_subfield_table.tag=marc_subfield_structure.tagfield and marc_subfield_table.subfieldcode=marc_subfield_structure.tagsubfield and bibid=? and kohafield='items.itemnumber' and subfieldvalue=?" + ); + $sth2->execute( $bibid, $itemnumber ); + my ($tagorder) = $sth2->fetchrow_array(); + foreach my $field (@fields) { + my $oldfield = $oldrecord->field( $field->tag() ); + my @subfields = $field->subfields(); + my $subfieldorder = 0; + foreach my $subfield (@subfields) { + $subfieldorder++; + + # warn "compare : $oldfield".$oldfield->subfield(@$subfield[0]); + if ( $oldfield eq 0 + or ( length( $oldfield->subfield( @$subfield[0] ) ) == 0 ) ) + { + + # just adding datas... # warn "addfield : / $subfieldorder / @$subfield[0] - @$subfield[1]"; # warn "NEW subfield : $bibid,".$field->tag().",".$tagorder.",".@$subfield[0].",".$subfieldorder.",".@$subfield[1].")"; - &MARCaddsubfield($dbh,$bibid,$field->tag(),$field->indicator(1).$field->indicator(2), - $tagorder,@$subfield[0],$subfieldorder,@$subfield[1]); - } else { + &MARCaddsubfield( + $dbh, + $bibid, + $field->tag(), + $field->indicator(1) . $field->indicator(2), + $tagorder, + @$subfield[0], + $subfieldorder, + @$subfield[1] + ); + } + else { + # warn "modfield : / $subfieldorder / @$subfield[0] - @$subfield[1]"; - # modify he subfield if it's a different string - if ($oldfield->subfield(@$subfield[0]) ne @$subfield[1] ) { - my $subfieldid=&MARCfindsubfieldid($dbh,$bibid,$field->tag(),$tagorder,@$subfield[0],$subfieldorder); + # modify he subfield if it's a different string + if ( $oldfield->subfield( @$subfield[0] ) ne @$subfield[1] ) { + my $subfieldid = &MARCfindsubfieldid( + $dbh, $bibid, + $field->tag(), $tagorder, + @$subfield[0], $subfieldorder + ); + # warn "changing : $subfieldid, $bibid,".$field->tag(),",$tagorder,@$subfield[0],@$subfield[1],$subfieldorder"; - &MARCmodsubfield($dbh,$subfieldid,@$subfield[1]); - } - } - } - } + &MARCmodsubfield( $dbh, $subfieldid, @$subfield[1] ); + } + } + } + } } - sub MARCmodsubfield { -# Subroutine changes a subfield value given a subfieldid. - my ($dbh, $subfieldid, $subfieldvalue )=@_; + + # Subroutine changes a subfield value given a subfieldid. + my ( $dbh, $subfieldid, $subfieldvalue ) = @_; $dbh->do("lock tables marc_blob_subfield WRITE,marc_subfield_table WRITE"); - my $sth1=$dbh->prepare("select valuebloblink from marc_subfield_table where subfieldid=?"); + my $sth1 = + $dbh->prepare( + "select valuebloblink from marc_subfield_table where subfieldid=?"); $sth1->execute($subfieldid); - my ($oldvaluebloblink)=$sth1->fetchrow; + my ($oldvaluebloblink) = $sth1->fetchrow; $sth1->finish; my $sth; + # if too long, use a bloblink - if (length($subfieldvalue)>255 ) { - # if already a bloblink, update it, otherwise, insert a new one. - if ($oldvaluebloblink) { - $sth=$dbh->prepare("update marc_blob_subfield set subfieldvalue=? where blobidlink=?"); - $sth->execute($subfieldvalue,$oldvaluebloblink); - } else { - $sth=$dbh->prepare("insert into marc_blob_subfield (subfieldvalue) values (?)"); - $sth->execute($subfieldvalue); - $sth=$dbh->prepare("select max(blobidlink) from marc_blob_subfield"); - $sth->execute; - my ($res)=$sth->fetchrow; - $sth=$dbh->prepare("update marc_subfield_table set subfieldvalue=null, valuebloblink=? where subfieldid=?"); - $sth->execute($res,$subfieldid); - } - } else { - # note this can leave orphan bloblink. Not a big problem, but we should build somewhere a orphan deleting script... - $sth=$dbh->prepare("update marc_subfield_table set subfieldvalue=?,valuebloblink=null where subfieldid=?"); - $sth->execute($subfieldvalue, $subfieldid); + if ( length($subfieldvalue) > 255 ) { + + # if already a bloblink, update it, otherwise, insert a new one. + if ($oldvaluebloblink) { + $sth = + $dbh->prepare( +"update marc_blob_subfield set subfieldvalue=? where blobidlink=?" + ); + $sth->execute( $subfieldvalue, $oldvaluebloblink ); + } + else { + $sth = + $dbh->prepare( + "insert into marc_blob_subfield (subfieldvalue) values (?)"); + $sth->execute($subfieldvalue); + $sth = + $dbh->prepare("select max(blobidlink) from marc_blob_subfield"); + $sth->execute; + my ($res) = $sth->fetchrow; + $sth = + $dbh->prepare( +"update marc_subfield_table set subfieldvalue=null, valuebloblink=? where subfieldid=?" + ); + $sth->execute( $res, $subfieldid ); + } + } + else { + +# note this can leave orphan bloblink. Not a big problem, but we should build somewhere a orphan deleting script... + $sth = + $dbh->prepare( +"update marc_subfield_table set subfieldvalue=?,valuebloblink=null where subfieldid=?" + ); + $sth->execute( $subfieldvalue, $subfieldid ); } $dbh->do("unlock tables"); $sth->finish; - $sth=$dbh->prepare("select bibid,tag,tagorder,subfieldcode,subfieldid,subfieldorder from marc_subfield_table where subfieldid=?"); + $sth = + $dbh->prepare( +"select bibid,tag,tagorder,subfieldcode,subfieldid,subfieldorder from marc_subfield_table where subfieldid=?" + ); $sth->execute($subfieldid); - my ($bibid,$tagid,$tagorder,$subfieldcode,$x,$subfieldorder) = $sth->fetchrow; - $subfieldid=$x; - &MARCdelword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder); - &MARCaddword($dbh,$bibid,$tagid,$tagorder,$subfieldcode,$subfieldorder,$subfieldvalue); - return($subfieldid, $subfieldvalue); + my ( $bibid, $tagid, $tagorder, $subfieldcode, $x, $subfieldorder ) = + $sth->fetchrow; + $subfieldid = $x; + &MARCdelword( $dbh, $bibid, $tagid, $tagorder, $subfieldcode, + $subfieldorder ); + &MARCaddword( + $dbh, $bibid, $tagid, $tagorder, + $subfieldcode, $subfieldorder, $subfieldvalue + ); + return ( $subfieldid, $subfieldvalue ); } sub MARCfindsubfield { - my ($dbh,$bibid,$tag,$subfieldcode,$subfieldorder,$subfieldvalue) = @_; - my $resultcounter=0; + my ( $dbh, $bibid, $tag, $subfieldcode, $subfieldorder, $subfieldvalue ) = + @_; + my $resultcounter = 0; my $subfieldid; my $lastsubfieldid; - my $query="select subfieldid from marc_subfield_table where bibid=? and tag=? and subfieldcode=?"; - my @bind_values = ($bibid,$tag, $subfieldcode); + my $query = +"select subfieldid from marc_subfield_table where bibid=? and tag=? and subfieldcode=?"; + my @bind_values = ( $bibid, $tag, $subfieldcode ); if ($subfieldvalue) { - $query .= " and subfieldvalue=?"; - push(@bind_values,$subfieldvalue); - } else { - if ($subfieldorder<1) { - $subfieldorder=1; - } - $query .= " and subfieldorder=?"; - push(@bind_values,$subfieldorder); - } - my $sti=$dbh->prepare($query); + $query .= " and subfieldvalue=?"; + push ( @bind_values, $subfieldvalue ); + } + else { + if ( $subfieldorder < 1 ) { + $subfieldorder = 1; + } + $query .= " and subfieldorder=?"; + push ( @bind_values, $subfieldorder ); + } + my $sti = $dbh->prepare($query); $sti->execute(@bind_values); - while (($subfieldid) = $sti->fetchrow) { - $resultcounter++; - $lastsubfieldid=$subfieldid; + while ( ($subfieldid) = $sti->fetchrow ) { + $resultcounter++; + $lastsubfieldid = $subfieldid; + } + if ( $resultcounter > 1 ) { + +# Error condition. Values given did not resolve into a unique record. Don't know what to edit +# should rarely occur (only if we use subfieldvalue with a value that exists twice, which is strange) + return -1; } - if ($resultcounter>1) { - # Error condition. Values given did not resolve into a unique record. Don't know what to edit - # should rarely occur (only if we use subfieldvalue with a value that exists twice, which is strange) - return -1; - } else { - return $lastsubfieldid; + else { + return $lastsubfieldid; } } sub MARCfindsubfieldid { - my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_; - my $sth=$dbh->prepare("select subfieldid from marc_subfield_table + my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_; + my $sth = $dbh->prepare( "select subfieldid from marc_subfield_table where bibid=? and tag=? and tagorder=? - and subfieldcode=? and subfieldorder=?"); - $sth->execute($bibid,$tag,$tagorder,$subfield,$subfieldorder); - my ($res) = $sth->fetchrow; - unless ($res) { - $sth=$dbh->prepare("select subfieldid from marc_subfield_table + and subfieldcode=? and subfieldorder=?" + ); + $sth->execute( $bibid, $tag, $tagorder, $subfield, $subfieldorder ); + my ($res) = $sth->fetchrow; + unless ($res) { + $sth = $dbh->prepare( "select subfieldid from marc_subfield_table where bibid=? and tag=? and tagorder=? - and subfieldcode=?"); - $sth->execute($bibid,$tag,$tagorder,$subfield); - ($res) = $sth->fetchrow; - } + and subfieldcode=?" + ); + $sth->execute( $bibid, $tag, $tagorder, $subfield ); + ($res) = $sth->fetchrow; + } return $res; } sub MARCfind_frameworkcode { - my ($dbh,$bibid) = @_; - my $sth = $dbh->prepare("select frameworkcode from marc_biblio where bibid=?"); - $sth->execute($bibid); - my ($frameworkcode) = $sth->fetchrow; - return $frameworkcode; + my ( $dbh, $bibid ) = @_; + my $sth = + $dbh->prepare("select frameworkcode from marc_biblio where bibid=?"); + $sth->execute($bibid); + my ($frameworkcode) = $sth->fetchrow; + return $frameworkcode; } + sub MARCdelsubfield { -# delete a subfield for $bibid / tag / tagorder / subfield / subfieldorder - my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_; - $dbh->do("delete from marc_subfield_table where bibid='$bibid' and + + # delete a subfield for $bibid / tag / tagorder / subfield / subfieldorder + my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_; + $dbh->do( "delete from marc_subfield_table where bibid='$bibid' and tag='$tag' and tagorder='$tagorder' and subfieldcode='$subfield' and subfieldorder='$subfieldorder' - "); + " + ); } sub MARCkoha2marcBiblio { -# this function builds partial MARC::Record from the old koha-DB fields - my ($dbh,$biblionumber,$biblioitemnumber) = @_; - my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?"); + + # this function builds partial MARC::Record from the old koha-DB fields + my ( $dbh, $biblionumber, $biblioitemnumber ) = @_; + my $sth = + $dbh->prepare( +"select tagfield,tagsubfield from marc_subfield_structure where kohafield=?" + ); my $record = MARC::Record->new(); -#--- if bibid, then retrieve old-style koha data - if ($biblionumber>0) { - my $sth2=$dbh->prepare("select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp - from biblio where biblionumber=?"); - $sth2->execute($biblionumber); - my $row=$sth2->fetchrow_hashref; - my $code; - foreach $code (keys %$row) { - if ($row->{$code}) { - &MARCkoha2marcOnefield($sth,$record,"biblio.".$code,$row->{$code}); - } - } - } -#--- if biblioitem, then retrieve old-style koha data - if ($biblioitemnumber>0) { - my $sth2=$dbh->prepare(" SELECT biblioitemnumber,biblionumber,volume,number,classification, + + #--- if bibid, then retrieve old-style koha data + if ( $biblionumber > 0 ) { + my $sth2 = + $dbh->prepare( +"select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp + from biblio where biblionumber=?" + ); + $sth2->execute($biblionumber); + my $row = $sth2->fetchrow_hashref; + my $code; + foreach $code ( keys %$row ) { + if ( $row->{$code} ) { + &MARCkoha2marcOnefield( $sth, $record, "biblio." . $code, + $row->{$code} ); + } + } + } + + #--- if biblioitem, then retrieve old-style koha data + if ( $biblioitemnumber > 0 ) { + my $sth2 = + $dbh->prepare( + " SELECT biblioitemnumber,biblionumber,volume,number,classification, itemtype,url,isbn,issn,dewey,subclass,publicationyear,publishercode, volumedate,volumeddesc,timestamp,illus,pages,notes AS bnotes,size,place FROM biblioitems WHERE biblioitemnumber=? - "); - $sth2->execute($biblioitemnumber); - my $row=$sth2->fetchrow_hashref; - my $code; - foreach $code (keys %$row) { - if ($row->{$code}) { - &MARCkoha2marcOnefield($sth,$record,"biblioitems.".$code,$row->{$code}); - } - } - } - # other fields => additional authors, subjects, subtitles - my $sth2=$dbh->prepare(" SELECT author FROM additionalauthors WHERE biblionumber=?"); - $sth2->execute($biblionumber); - while (my $row=$sth2->fetchrow_hashref) { - &MARCkoha2marcOnefield($sth,$record,"additionalauthors.author",$row->{'author'}); - } - my $sth2=$dbh->prepare(" SELECT subject FROM bibliosubject WHERE biblionumber=?"); - $sth2->execute($biblionumber); - while (my $row=$sth2->fetchrow_hashref) { - &MARCkoha2marcOnefield($sth,$record,"bibliosubject.subject",$row->{'subject'}); - } - my $sth2=$dbh->prepare(" SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?"); - $sth2->execute($biblionumber); - while (my $row=$sth2->fetchrow_hashref) { - &MARCkoha2marcOnefield($sth,$record,"bibliosubtitle.title",$row->{'subtitle'}); - } + " + ); + $sth2->execute($biblioitemnumber); + my $row = $sth2->fetchrow_hashref; + my $code; + foreach $code ( keys %$row ) { + if ( $row->{$code} ) { + &MARCkoha2marcOnefield( $sth, $record, "biblioitems." . $code, + $row->{$code} ); + } + } + } + + # other fields => additional authors, subjects, subtitles + my $sth2 = + $dbh->prepare( + " SELECT author FROM additionalauthors WHERE biblionumber=?"); + $sth2->execute($biblionumber); + while ( my $row = $sth2->fetchrow_hashref ) { + &MARCkoha2marcOnefield( $sth, $record, "additionalauthors.author", + $row->{'author'} ); + } + my $sth2 = + $dbh->prepare(" SELECT subject FROM bibliosubject WHERE biblionumber=?"); + $sth2->execute($biblionumber); + while ( my $row = $sth2->fetchrow_hashref ) { + &MARCkoha2marcOnefield( $sth, $record, "bibliosubject.subject", + $row->{'subject'} ); + } + my $sth2 = + $dbh->prepare( + " SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?"); + $sth2->execute($biblionumber); + while ( my $row = $sth2->fetchrow_hashref ) { + &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.title", + $row->{'subtitle'} ); + } return $record; } sub MARCkoha2marcItem { -# this function builds partial MARC::Record from the old koha-DB fields - my ($dbh,$biblionumber,$itemnumber) = @_; -# my $dbh=&C4Connect; - my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?"); + + # this function builds partial MARC::Record from the old koha-DB fields + my ( $dbh, $biblionumber, $itemnumber ) = @_; + + # my $dbh=&C4Connect; + my $sth = + $dbh->prepare( +"select tagfield,tagsubfield from marc_subfield_structure where kohafield=?" + ); my $record = MARC::Record->new(); -#--- if item, then retrieve old-style koha data - if ($itemnumber>0) { -# print STDERR "prepare $biblionumber,$itemnumber\n"; - my $sth2=$dbh->prepare("SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned, + + #--- if item, then retrieve old-style koha data + if ( $itemnumber > 0 ) { + + # print STDERR "prepare $biblionumber,$itemnumber\n"; + my $sth2 = + $dbh->prepare( +"SELECT itemnumber,biblionumber,multivolumepart,biblioitemnumber,barcode,dateaccessioned, booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed, datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,itemcallnumber,issues,renewals, reserves,restricted,binding,itemnotes,holdingbranch,timestamp FROM items - WHERE itemnumber=?"); - $sth2->execute($itemnumber); - my $row=$sth2->fetchrow_hashref; - my $code; - foreach $code (keys %$row) { - if ($row->{$code}) { - &MARCkoha2marcOnefield($sth,$record,"items.".$code,$row->{$code}); - } - } + WHERE itemnumber=?" + ); + $sth2->execute($itemnumber); + my $row = $sth2->fetchrow_hashref; + my $code; + foreach $code ( keys %$row ) { + if ( $row->{$code} ) { + &MARCkoha2marcOnefield( $sth, $record, "items." . $code, + $row->{$code} ); + } + } } return $record; } sub MARCkoha2marcSubtitle { -# this function builds partial MARC::Record from the old koha-DB fields - my ($dbh,$bibnum,$subtitle) = @_; - my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?"); + + # this function builds partial MARC::Record from the old koha-DB fields + my ( $dbh, $bibnum, $subtitle ) = @_; + my $sth = + $dbh->prepare( +"select tagfield,tagsubfield from marc_subfield_structure where kohafield=?" + ); my $record = MARC::Record->new(); - &MARCkoha2marcOnefield($sth,$record,"bibliosubtitle.subtitle",$subtitle); + &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle", + $subtitle ); return $record; } sub MARCkoha2marcOnefield { - my ($sth,$record,$kohafieldname,$value)=@_; + my ( $sth, $record, $kohafieldname, $value ) = @_; my $tagfield; my $tagsubfield; $sth->execute($kohafieldname); - if (($tagfield,$tagsubfield)=$sth->fetchrow) { - if ($record->field($tagfield)) { - my $tag =$record->field($tagfield); - if ($tag) { - $tag->add_subfields($tagsubfield,$value); - $record->delete_field($tag); - $record->add_fields($tag); - } - } else { - $record->add_fields($tagfield," "," ",$tagsubfield => $value); - } + if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) { + if ( $record->field($tagfield) ) { + my $tag = $record->field($tagfield); + if ($tag) { + $tag->add_subfields( $tagsubfield, $value ); + $record->delete_field($tag); + $record->add_fields($tag); + } + } + else { + $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value ); + } } return $record; } sub MARChtml2marc { - my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_; - my $prevtag = -1; - my $record = MARC::Record->new(); -# my %subfieldlist=(); - my $prevvalue; # if tag <10 - my $field; # if tag >=10 - for (my $i=0; $i< @$rtags; $i++) { - # rebuild MARC::Record - if (@$rtags[$i] ne $prevtag) { - if ($prevtag < 10) { - if ($prevvalue) { - $record->add_fields((sprintf "%03s",$prevtag),$prevvalue); - } - } else { - if ($field) { - $record->add_fields($field); - } - } - $indicators{@$rtags[$i]}.=' '; - if (@$rtags[$i] <10) { - $prevvalue= @$rvalues[$i]; - } else { - $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]); - } - $prevtag = @$rtags[$i]; - } else { - if (@$rtags[$i] <10) { - $prevvalue=@$rvalues[$i]; - } else { - if (@$rvalues[$i]) { - $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]); - } - } - $prevtag= @$rtags[$i]; - } - } - # the last has not been included inside the loop... do it now ! - $record->add_fields($field); -# warn $record->as_formatted; - return $record; + my ( $dbh, $rtags, $rsubfields, $rvalues, %indicators ) = @_; + my $prevtag = -1; + my $record = MARC::Record->new(); + + # my %subfieldlist=(); + my $prevvalue; # if tag <10 + my $field; # if tag >=10 + for ( my $i = 0 ; $i < @$rtags ; $i++ ) { + + # rebuild MARC::Record + if ( @$rtags[$i] ne $prevtag ) { + if ( $prevtag < 10 ) { + if ($prevvalue) { + $record->add_fields( ( sprintf "%03s", $prevtag ), + $prevvalue ); + } + } + else { + if ($field) { + $record->add_fields($field); + } + } + $indicators{ @$rtags[$i] } .= ' '; + if ( @$rtags[$i] < 10 ) { + $prevvalue = @$rvalues[$i]; + } + else { + $field = MARC::Field->new( + ( sprintf "%03s", @$rtags[$i] ), + substr( $indicators{ @$rtags[$i] }, 0, 1 ), + substr( $indicators{ @$rtags[$i] }, 1, 1 ), + @$rsubfields[$i] => @$rvalues[$i] + ); + } + $prevtag = @$rtags[$i]; + } + else { + if ( @$rtags[$i] < 10 ) { + $prevvalue = @$rvalues[$i]; + } + else { + if ( @$rvalues[$i] ) { + $field->add_subfields( @$rsubfields[$i] => @$rvalues[$i] ); + } + } + $prevtag = @$rtags[$i]; + } + } + + # the last has not been included inside the loop... do it now ! + $record->add_fields($field); + + # warn $record->as_formatted; + return $record; } sub MARCmarc2koha { - my ($dbh,$record) = @_; - my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?"); - my $result; - my $sth2=$dbh->prepare("SHOW COLUMNS from biblio"); - $sth2->execute; - my $field; - # print STDERR $record->as_formatted; - while (($field)=$sth2->fetchrow) { - $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result); - } - $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems"); - $sth2->execute; - while (($field)=$sth2->fetchrow) { - if ($field eq 'notes') { $field = 'bnotes'; } - $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result); - } - $sth2=$dbh->prepare("SHOW COLUMNS from items"); - $sth2->execute; - while (($field)=$sth2->fetchrow) { - $result = &MARCmarc2kohaOneField($sth,"items",$field,$record,$result); - } - # additional authors : specific - $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result); - $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result); -# modify copyrightdate to keep only the 1st year found - my $temp = $result->{'copyrightdate'}; - $temp =~ m/c(\d\d\d\d)/; # search cYYYY first - if ($1>0) { - $result->{'copyrightdate'} = $1; - } else { # if no cYYYY, get the 1st date. - $temp =~ m/(\d\d\d\d)/; - $result->{'copyrightdate'} = $1; - } -# modify publicationyear to keep only the 1st year found - my $temp = $result->{'publicationyear'}; - $temp =~ m/c(\d\d\d\d)/; # search cYYYY first - if ($1>0) { - $result->{'publicationyear'} = $1; - } else { # if no cYYYY, get the 1st date. - $temp =~ m/(\d\d\d\d)/; - $result->{'publicationyear'} = $1; - } - return $result; + my ( $dbh, $record ) = @_; + my $sth = + $dbh->prepare( +"select tagfield,tagsubfield from marc_subfield_structure where kohafield=?" + ); + my $result; + my $sth2 = $dbh->prepare("SHOW COLUMNS from biblio"); + $sth2->execute; + my $field; + + # print STDERR $record->as_formatted; + while ( ($field) = $sth2->fetchrow ) { + $result = + &MARCmarc2kohaOneField( $sth, "biblio", $field, $record, $result ); + } + $sth2 = $dbh->prepare("SHOW COLUMNS from biblioitems"); + $sth2->execute; + while ( ($field) = $sth2->fetchrow ) { + if ( $field eq 'notes' ) { $field = 'bnotes'; } + $result = + &MARCmarc2kohaOneField( $sth, "biblioitems", $field, $record, + $result ); + } + $sth2 = $dbh->prepare("SHOW COLUMNS from items"); + $sth2->execute; + while ( ($field) = $sth2->fetchrow ) { + $result = + &MARCmarc2kohaOneField( $sth, "items", $field, $record, $result ); + } + + # additional authors : specific + $result = + &MARCmarc2kohaOneField( $sth, "bibliosubtitle", "subtitle", $record, + $result ); + $result = + &MARCmarc2kohaOneField( $sth, "additionalauthors", "additionalauthors", + $record, $result ); + + # modify copyrightdate to keep only the 1st year found + my $temp = $result->{'copyrightdate'}; + $temp =~ m/c(\d\d\d\d)/; # search cYYYY first + if ( $1 > 0 ) { + $result->{'copyrightdate'} = $1; + } + else { # if no cYYYY, get the 1st date. + $temp =~ m/(\d\d\d\d)/; + $result->{'copyrightdate'} = $1; + } + + # modify publicationyear to keep only the 1st year found + my $temp = $result->{'publicationyear'}; + $temp =~ m/c(\d\d\d\d)/; # search cYYYY first + if ( $1 > 0 ) { + $result->{'publicationyear'} = $1; + } + else { # if no cYYYY, get the 1st date. + $temp =~ m/(\d\d\d\d)/; + $result->{'publicationyear'} = $1; + } + return $result; } sub MARCmarc2kohaOneField { + # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved... - my ($sth,$kohatable,$kohafield,$record,$result)= @_; -# warn "kohatable / $kohafield / $result / "; - my $res=""; - my $tagfield; - my $subfield; - $sth->execute($kohatable.".".$kohafield); - ($tagfield,$subfield) = $sth->fetchrow; - foreach my $field ($record->field($tagfield)) { - if ($field->subfield($subfield)) { - if ($result->{$kohafield}) { - $result->{$kohafield} .= " | ".$field->subfield($subfield); - } else { - $result->{$kohafield}=$field->subfield($subfield); - } - } - } - return $result; + my ( $sth, $kohatable, $kohafield, $record, $result ) = @_; + + # warn "kohatable / $kohafield / $result / "; + my $res = ""; + my $tagfield; + my $subfield; + $sth->execute( $kohatable . "." . $kohafield ); + ( $tagfield, $subfield ) = $sth->fetchrow; + foreach my $field ( $record->field($tagfield) ) { + if ( $field->subfield($subfield) ) { + if ( $result->{$kohafield} ) { + $result->{$kohafield} .= " | " . $field->subfield($subfield); + } + else { + $result->{$kohafield} = $field->subfield($subfield); + } + } + } + return $result; } sub MARCaddword { -# split a subfield string and adds it into the word table. -# removes stopwords - my ($dbh,$bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$sentence) =@_; + + # split a subfield string and adds it into the word table. + # removes stopwords + my ( + $dbh, $bibid, $tag, $tagorder, + $subfieldid, $subfieldorder, $sentence + ) + = @_; $sentence =~ s/(\.|\?|\:|\!|\'|,|\-|\"|\(|\)|\[|\]|\{|\})/ /g; - my @words = split / /,$sentence; - my $stopwords= C4::Context->stopwords; - my $sth=$dbh->prepare("insert into marc_word (bibid, tagsubfield, tagorder, subfieldorder, word, sndx_word) - values (?,concat(?,?),?,?,?,soundex(?))"); + my @words = split / /, $sentence; + my $stopwords = C4::Context->stopwords; + my $sth = + $dbh->prepare( +"insert into marc_word (bibid, tagsubfield, tagorder, subfieldorder, word, sndx_word) + values (?,concat(?,?),?,?,?,soundex(?))" + ); foreach my $word (@words) { -# we record only words one char long and not in stopwords hash - if (length($word)>=1 and !($stopwords->{uc($word)})) { - $sth->execute($bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,$word); - if ($sth->err()) { - warn "ERROR ==> insert into marc_word (bibid, tagsubfield, tagorder, subfieldorder, word, sndx_word) values ($bibid,concat($tag,$subfieldid),$tagorder,$subfieldorder,$word,soundex($word))\n"; - } - } + + # we record only words one char long and not in stopwords hash + if ( length($word) >= 1 and !( $stopwords->{ uc($word) } ) ) { + $sth->execute( + $bibid, $tag, $tagorder, $subfieldid, + $subfieldorder, $word, $word + ); + if ( $sth->err() ) { + warn +"ERROR ==> insert into marc_word (bibid, tagsubfield, tagorder, subfieldorder, word, sndx_word) values ($bibid,concat($tag,$subfieldid),$tagorder,$subfieldorder,$word,soundex($word))\n"; + } + } } } sub MARCdelword { + # delete words. this sub deletes all the words from a sentence. a subfield modif is done by a delete then a add - my ($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder) = @_; - my $sth=$dbh->prepare("delete from marc_word where bibid=? and tagsubfield=concat(?,?) and tagorder=? and subfieldorder=?"); - $sth->execute($bibid,$tag,$subfield,$tagorder,$subfieldorder); + my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_; + my $sth = + $dbh->prepare( +"delete from marc_word where bibid=? and tagsubfield=concat(?,?) and tagorder=? and subfieldorder=?" + ); + $sth->execute( $bibid, $tag, $subfield, $tagorder, $subfieldorder ); } # @@ -976,7 +1264,6 @@ sub MARCdelword { # it's used with marcimport, and marc management tools # - =item ($bibid,$oldbibnum,$oldbibitemnum) = NEWnewbibilio($dbh,$MARCRecord,$oldbiblio,$oldbiblioitem); creates a new biblio from a MARC::Record. The 3rd and 4th parameter are hashes and may be ignored. If only 2 params are passed to the sub, the old-db hashes @@ -989,146 +1276,177 @@ adds an item in the db. =cut sub NEWnewbiblio { - my ($dbh, $record, $frameworkcode) = @_; - my $oldbibnum; - my $oldbibitemnum; - my $olddata = MARCmarc2koha($dbh,$record); - $oldbibnum = OLDnewbiblio($dbh,$olddata); - $olddata->{'biblionumber'} = $oldbibnum; - $oldbibitemnum = OLDnewbiblioitem($dbh,$olddata); - # search subtiles, addiauthors and subjects - my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author"); - my @addiauthfields = $record->field($tagfield); - foreach my $addiauthfield (@addiauthfields) { - my @addiauthsubfields = $addiauthfield->subfield($tagsubfield); - foreach my $subfieldcount (0..$#addiauthsubfields) { - OLDmodaddauthor($dbh,$oldbibnum,$addiauthsubfields[$subfieldcount]); - } - } - ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.title"); - my @subtitlefields = $record->field($tagfield); - foreach my $subtitlefield (@subtitlefields) { - my @subtitlesubfields = $subtitlefield->subfield($tagsubfield); - foreach my $subfieldcount (0..$#subtitlesubfields) { - OLDnewsubtitle($dbh,$oldbibnum,$subtitlesubfields[$subfieldcount]); - } - } - ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject"); - my @subj = $record->field($tagfield); - my @subjects; - foreach my $subject (@subj) { - my @subjsubfield = $subject->subfield($tagsubfield); - foreach my $subfieldcount (0..$#subjsubfield) { - push @subjects,$subjsubfield[$subfieldcount]; - } - } - OLDmodsubject($dbh,$oldbibnum,1,@subjects); - # we must add bibnum and bibitemnum in MARC::Record... - # we build the new field with biblionumber and biblioitemnumber - # we drop the original field - # we add the new builded field. - # NOTE : Works only if the field is ONLY for biblionumber and biblioitemnumber - # (steve and paul : thinks 090 is a good choice) - my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?"); - $sth->execute("biblio.biblionumber"); - (my $tagfield1, my $tagsubfield1) = $sth->fetchrow; - $sth->execute("biblioitems.biblioitemnumber"); - (my $tagfield2, my $tagsubfield2) = $sth->fetchrow; - if ($tagfield1 != $tagfield2) { - warn "Error in NEWnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number"; - print "Content-Type: text/html\n\nError in NEWnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number"; - die; - } - my $newfield = MARC::Field->new( $tagfield1,'','', - "$tagsubfield1" => $oldbibnum, - "$tagsubfield2" => $oldbibitemnum); - # drop old field and create new one... - my $old_field = $record->field($tagfield1); - $record->delete_field($old_field); - $record->add_fields($newfield); - my $bibid = MARCaddbiblio($dbh,$record,$oldbibnum,$frameworkcode); - return ($bibid,$oldbibnum,$oldbibitemnum ); + my ( $dbh, $record, $frameworkcode ) = @_; + my $oldbibnum; + my $oldbibitemnum; + my $olddata = MARCmarc2koha( $dbh, $record ); + $oldbibnum = OLDnewbiblio( $dbh, $olddata ); + $olddata->{'biblionumber'} = $oldbibnum; + $oldbibitemnum = OLDnewbiblioitem( $dbh, $olddata ); + + # search subtiles, addiauthors and subjects + my ( $tagfield, $tagsubfield ) = + MARCfind_marc_from_kohafield( $dbh, "additionalauthors.author" ); + my @addiauthfields = $record->field($tagfield); + foreach my $addiauthfield (@addiauthfields) { + my @addiauthsubfields = $addiauthfield->subfield($tagsubfield); + foreach my $subfieldcount ( 0 .. $#addiauthsubfields ) { + OLDmodaddauthor( $dbh, $oldbibnum, + $addiauthsubfields[$subfieldcount] ); + } + } + ( $tagfield, $tagsubfield ) = + MARCfind_marc_from_kohafield( $dbh, "bibliosubtitle.title" ); + my @subtitlefields = $record->field($tagfield); + foreach my $subtitlefield (@subtitlefields) { + my @subtitlesubfields = $subtitlefield->subfield($tagsubfield); + foreach my $subfieldcount ( 0 .. $#subtitlesubfields ) { + OLDnewsubtitle( $dbh, $oldbibnum, + $subtitlesubfields[$subfieldcount] ); + } + } + ( $tagfield, $tagsubfield ) = + MARCfind_marc_from_kohafield( $dbh, "bibliosubject.subject" ); + my @subj = $record->field($tagfield); + my @subjects; + foreach my $subject (@subj) { + my @subjsubfield = $subject->subfield($tagsubfield); + foreach my $subfieldcount ( 0 .. $#subjsubfield ) { + push @subjects, $subjsubfield[$subfieldcount]; + } + } + OLDmodsubject( $dbh, $oldbibnum, 1, @subjects ); + + # we must add bibnum and bibitemnum in MARC::Record... + # we build the new field with biblionumber and biblioitemnumber + # we drop the original field + # we add the new builded field. +# NOTE : Works only if the field is ONLY for biblionumber and biblioitemnumber + # (steve and paul : thinks 090 is a good choice) + my $sth = + $dbh->prepare( +"select tagfield,tagsubfield from marc_subfield_structure where kohafield=?" + ); + $sth->execute("biblio.biblionumber"); + ( my $tagfield1, my $tagsubfield1 ) = $sth->fetchrow; + $sth->execute("biblioitems.biblioitemnumber"); + ( my $tagfield2, my $tagsubfield2 ) = $sth->fetchrow; + if ( $tagfield1 != $tagfield2 ) { + warn +"Error in NEWnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number"; + print +"Content-Type: text/html\n\nError in NEWnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number"; + die; + } + my $newfield = MARC::Field->new( + $tagfield1, '', '', "$tagsubfield1" => $oldbibnum, + "$tagsubfield2" => $oldbibitemnum + ); + + # drop old field and create new one... + my $old_field = $record->field($tagfield1); + $record->delete_field($old_field); + $record->add_fields($newfield); + my $bibid = MARCaddbiblio( $dbh, $record, $oldbibnum, $frameworkcode ); + return ( $bibid, $oldbibnum, $oldbibitemnum ); } sub NEWmodbiblio { - my ($dbh,$record,$bibid,$frameworkcode) =@_; - $frameworkcode="" unless $frameworkcode; - &MARCmodbiblio($dbh,$bibid,$record,0); - my $oldbiblio = MARCmarc2koha($dbh,$record); - my $oldbiblionumber = OLDmodbiblio($dbh,$oldbiblio); - OLDmodbibitem($dbh,$oldbiblio); - # now, modify addi authors, subject, addititles. - my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author"); - my @addiauthfields = $record->field($tagfield); - foreach my $addiauthfield (@addiauthfields) { - my @addiauthsubfields = $addiauthfield->subfield($tagsubfield); - foreach my $subfieldcount (0..$#addiauthsubfields) { - OLDmodaddauthor($dbh,$oldbiblionumber,$addiauthsubfields[$subfieldcount]); - } - } - ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle"); - my @subtitlefields = $record->field($tagfield); - foreach my $subtitlefield (@subtitlefields) { - my @subtitlesubfields = $subtitlefield->subfield($tagsubfield); - foreach my $subfieldcount (0..$#subtitlesubfields) { - OLDmodsubtitle($dbh,$oldbiblionumber,$subtitlesubfields[$subfieldcount]); - } - } - ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject"); - my @subj = $record->field($tagfield); - my @subjects; - foreach my $subject (@subj) { - my @subjsubfield = $subject->subfield($tagsubfield); - foreach my $subfieldcount (0..$#subjsubfield) { - push @subjects,$subjsubfield[$subfieldcount]; - } - } - OLDmodsubject($dbh,$oldbiblionumber,1,@subjects); - return 1; + my ( $dbh, $record, $bibid, $frameworkcode ) = @_; + $frameworkcode = "" unless $frameworkcode; + &MARCmodbiblio( $dbh, $bibid, $record, 0 ); + my $oldbiblio = MARCmarc2koha( $dbh, $record ); + my $oldbiblionumber = OLDmodbiblio( $dbh, $oldbiblio ); + OLDmodbibitem( $dbh, $oldbiblio ); + + # now, modify addi authors, subject, addititles. + my ( $tagfield, $tagsubfield ) = + MARCfind_marc_from_kohafield( $dbh, "additionalauthors.author" ); + my @addiauthfields = $record->field($tagfield); + foreach my $addiauthfield (@addiauthfields) { + my @addiauthsubfields = $addiauthfield->subfield($tagsubfield); + foreach my $subfieldcount ( 0 .. $#addiauthsubfields ) { + OLDmodaddauthor( $dbh, $oldbiblionumber, + $addiauthsubfields[$subfieldcount] ); + } + } + ( $tagfield, $tagsubfield ) = + MARCfind_marc_from_kohafield( $dbh, "bibliosubtitle.subtitle" ); + my @subtitlefields = $record->field($tagfield); + foreach my $subtitlefield (@subtitlefields) { + my @subtitlesubfields = $subtitlefield->subfield($tagsubfield); + foreach my $subfieldcount ( 0 .. $#subtitlesubfields ) { + OLDmodsubtitle( $dbh, $oldbiblionumber, + $subtitlesubfields[$subfieldcount] ); + } + } + ( $tagfield, $tagsubfield ) = + MARCfind_marc_from_kohafield( $dbh, "bibliosubject.subject" ); + my @subj = $record->field($tagfield); + my @subjects; + foreach my $subject (@subj) { + my @subjsubfield = $subject->subfield($tagsubfield); + foreach my $subfieldcount ( 0 .. $#subjsubfield ) { + push @subjects, $subjsubfield[$subfieldcount]; + } + } + OLDmodsubject( $dbh, $oldbiblionumber, 1, @subjects ); + return 1; } sub NEWdelbiblio { - my ($dbh,$bibid)=@_; - my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid); - &OLDdelbiblio($dbh,$biblio); - my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?"); - $sth->execute($biblio); - while(my ($biblioitemnumber) = $sth->fetchrow) { - OLDdeletebiblioitem($dbh,$biblioitemnumber); - } - &MARCdelbiblio($dbh,$bibid,0); + my ( $dbh, $bibid ) = @_; + my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid ); + &OLDdelbiblio( $dbh, $biblio ); + my $sth = + $dbh->prepare( + "select biblioitemnumber from biblioitems where biblionumber=?"); + $sth->execute($biblio); + while ( my ($biblioitemnumber) = $sth->fetchrow ) { + OLDdeletebiblioitem( $dbh, $biblioitemnumber ); + } + &MARCdelbiblio( $dbh, $bibid, 0 ); } - sub NEWnewitem { - my ($dbh, $record,$bibid) = @_; - # add item in old-DB - my $item = &MARCmarc2koha($dbh,$record); - # needs old biblionumber and biblioitemnumber - $item->{'biblionumber'} = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid); - my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?"); - $sth->execute($item->{'biblionumber'}); - ($item->{'biblioitemnumber'}) = $sth->fetchrow; - my ($itemnumber,$error) = &OLDnewitems($dbh,$item,$item->{barcode}); - # add itemnumber to MARC::Record before adding the item. - my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?"); - &MARCkoha2marcOnefield($sth,$record,"items.itemnumber",$itemnumber); - # add the item - my $bib = &MARCadditem($dbh,$record,$item->{'biblionumber'}); + my ( $dbh, $record, $bibid ) = @_; + + # add item in old-DB + my $item = &MARCmarc2koha( $dbh, $record ); + + # needs old biblionumber and biblioitemnumber + $item->{'biblionumber'} = + MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid ); + my $sth = + $dbh->prepare( + "select biblioitemnumber from biblioitems where biblionumber=?"); + $sth->execute( $item->{'biblionumber'} ); + ( $item->{'biblioitemnumber'} ) = $sth->fetchrow; + my ( $itemnumber, $error ) = &OLDnewitems( $dbh, $item, $item->{barcode} ); + + # add itemnumber to MARC::Record before adding the item. + my $sth = + $dbh->prepare( +"select tagfield,tagsubfield from marc_subfield_structure where kohafield=?" + ); + &MARCkoha2marcOnefield( $sth, $record, "items.itemnumber", $itemnumber ); + + # add the item + my $bib = &MARCadditem( $dbh, $record, $item->{'biblionumber'} ); } sub NEWmoditem { - my ($dbh,$record,$bibid,$itemnumber,$delete) = @_; - &MARCmoditem($dbh,$record,$bibid,$itemnumber,$delete); - my $olditem = MARCmarc2koha($dbh,$record); - OLDmoditem($dbh,$olditem); + my ( $dbh, $record, $bibid, $itemnumber, $delete ) = @_; + &MARCmoditem( $dbh, $record, $bibid, $itemnumber, $delete ); + my $olditem = MARCmarc2koha( $dbh, $record ); + OLDmoditem( $dbh, $olditem ); } sub NEWdelitem { - my ($dbh,$bibid,$itemnumber)=@_; - my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid); - &OLDdelitem($dbh,$itemnumber); - &MARCdelitem($dbh,$bibid,$itemnumber); + my ( $dbh, $bibid, $itemnumber ) = @_; + my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid ); + &OLDdelitem( $dbh, $itemnumber ); + &MARCdelitem( $dbh, $bibid, $itemnumber ); } # @@ -1202,131 +1520,179 @@ delete a biblio =cut sub OLDnewbiblio { - my ($dbh,$biblio) = @_; -# my $dbh = &C4Connect; - my $sth = $dbh->prepare("Select max(biblionumber) from biblio"); - $sth->execute; - my $data = $sth->fetchrow_arrayref; - my $bibnum = $$data[0] + 1; - my $series = 0; - - if ($biblio->{'seriestitle'}) { $series = 1 }; - $sth->finish; - $sth = $dbh->prepare("insert into biblio set biblionumber = ?, title = ?, author = ?, copyrightdate = ?, serial = ?, seriestitle = ?, notes = ?, abstract = ?"); - $sth->execute($bibnum,$biblio->{'title'},$biblio->{'author'},$biblio->{'copyrightdate'},$series,$biblio->{'seriestitle'},$biblio->{'notes'},$biblio->{'abstract'}); - - $sth->finish; -# $dbh->disconnect; - return($bibnum); + my ( $dbh, $biblio ) = @_; + + # my $dbh = &C4Connect; + my $sth = $dbh->prepare("Select max(biblionumber) from biblio"); + $sth->execute; + my $data = $sth->fetchrow_arrayref; + my $bibnum = $$data[0] + 1; + my $series = 0; + + if ( $biblio->{'seriestitle'} ) { $series = 1 } + $sth->finish; + $sth = + $dbh->prepare( +"insert into biblio set biblionumber = ?, title = ?, author = ?, copyrightdate = ?, serial = ?, seriestitle = ?, notes = ?, abstract = ?" + ); + $sth->execute( + $bibnum, $biblio->{'title'}, + $biblio->{'author'}, $biblio->{'copyrightdate'}, + $series, $biblio->{'seriestitle'}, + $biblio->{'notes'}, $biblio->{'abstract'} + ); + + $sth->finish; + + # $dbh->disconnect; + return ($bibnum); } sub OLDmodbiblio { - my ($dbh,$biblio) = @_; - # my $dbh = C4Connect; - my $query; - my $sth; + my ( $dbh, $biblio ) = @_; + + # my $dbh = C4Connect; + my $query; + my $sth; - $query = ""; - $sth = $dbh->prepare("Update biblio set title = ?, author = ?, abstract = ?, copyrightdate = ?, seriestitle = ?, serial = ?, unititle = ?, notes = ? where biblionumber = ?"); - $sth->execute($biblio->{'title'},$biblio->{'author'},$biblio->{'abstract'},$biblio->{'copyrightdate'}, $biblio->{'seriestitle'},$biblio->{'serial'},$biblio->{'unititle'},$biblio->{'notes'},$biblio->{'biblionumber'}); + $query = ""; + $sth = + $dbh->prepare( +"Update biblio set title = ?, author = ?, abstract = ?, copyrightdate = ?, seriestitle = ?, serial = ?, unititle = ?, notes = ? where biblionumber = ?" + ); + $sth->execute( + $biblio->{'title'}, $biblio->{'author'}, + $biblio->{'abstract'}, $biblio->{'copyrightdate'}, + $biblio->{'seriestitle'}, $biblio->{'serial'}, + $biblio->{'unititle'}, $biblio->{'notes'}, + $biblio->{'biblionumber'} + ); - $sth->finish; - return($biblio->{'biblionumber'}); -} # sub modbiblio + $sth->finish; + return ( $biblio->{'biblionumber'} ); +} # sub modbiblio sub OLDmodsubtitle { - my ($dbh,$bibnum, $subtitle) = @_; - my $sth = $dbh->prepare("update bibliosubtitle set subtitle = ? where biblionumber = ?"); - $sth->execute($subtitle,$bibnum); - $sth->finish; -} # sub modsubtitle - + my ( $dbh, $bibnum, $subtitle ) = @_; + my $sth = + $dbh->prepare( + "update bibliosubtitle set subtitle = ? where biblionumber = ?"); + $sth->execute( $subtitle, $bibnum ); + $sth->finish; +} # sub modsubtitle sub OLDmodaddauthor { - my ($dbh,$bibnum, $author) = @_; -# my $dbh = C4Connect; - my $sth = $dbh->prepare("Delete from additionalauthors where biblionumber = ?"); + my ( $dbh, $bibnum, @authors ) = @_; + + # my $dbh = C4Connect; + my $sth = + $dbh->prepare("Delete from additionalauthors where biblionumber = ?"); $sth->execute($bibnum); $sth->finish; + foreach my $author (@authors) { + if ( $author ne '' ) { + $sth = + $dbh->prepare( + "Insert into additionalauthors set author = ?, biblionumber = ?" + ); - if ($author ne '') { - $sth = $dbh->prepare("Insert into additionalauthors set author = ?, biblionumber = ?"); + $sth->execute( $author, $bibnum ); - $sth->execute($author,$bibnum); + $sth->finish; + } # if + } +} # sub modaddauthor +sub OLDmodsubject { + my ( $dbh, $bibnum, $force, @subject ) = @_; + + # my $dbh = C4Connect; + my $count = @subject; + my $error; + for ( my $i = 0 ; $i < $count ; $i++ ) { + $subject[$i] =~ s/^ //g; + $subject[$i] =~ s/ $//g; + my $sth = + $dbh->prepare( +"select * from catalogueentry where entrytype = 's' and catalogueentry = ?" + ); + $sth->execute( $subject[$i] ); + + if ( my $data = $sth->fetchrow_hashref ) { + } + else { + if ( $force eq $subject[$i] || $force == 1 ) { + + # subject not in aut, chosen to force anway + # so insert into cataloguentry so its in auth file + my $sth2 = + $dbh->prepare( +"Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)" + ); + + $sth2->execute( $subject[$i] ) if ( $subject[$i] ); + $sth2->finish; + } + else { + $error = + "$subject[$i]\n does not exist in the subject authority file"; + my $sth2 = + $dbh->prepare( +"Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)" + ); + $sth2->execute( "$subject[$i] %", "% $subject[$i] %", + "% $subject[$i]" ); + while ( my $data = $sth2->fetchrow_hashref ) { + $error .= "
$data->{'catalogueentry'}"; + } # while + $sth2->finish; + } # else + } # else $sth->finish; - } # if -} # sub modaddauthor - + } # else + if ( $error eq '' ) { + my $sth = + $dbh->prepare("Delete from bibliosubject where biblionumber = ?"); + $sth->execute($bibnum); + $sth->finish; + $sth = + $dbh->prepare( + "Insert into bibliosubject (subject,biblionumber) values (?,?)"); + my $query; + foreach $query (@subject) { + $sth->execute( $query, $bibnum ) if ( $query && $bibnum ); + } # foreach + $sth->finish; + } # if -sub OLDmodsubject { - my ($dbh,$bibnum, $force, @subject) = @_; - # my $dbh = C4Connect; - my $count = @subject; - my $error; - for (my $i = 0; $i < $count; $i++) { - $subject[$i] =~ s/^ //g; - $subject[$i] =~ s/ $//g; - my $sth = $dbh->prepare("select * from catalogueentry where entrytype = 's' and catalogueentry = ?"); - $sth->execute($subject[$i]); - - if (my $data = $sth->fetchrow_hashref) { - } else { - if ($force eq $subject[$i] || $force == 1) { - # subject not in aut, chosen to force anway - # so insert into cataloguentry so its in auth file - my $sth2 = $dbh->prepare("Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)"); - - $sth2->execute($subject[$i]) if ($subject[$i]); - $sth2->finish; - } else { - $error = "$subject[$i]\n does not exist in the subject authority file"; - my $sth2 = $dbh->prepare("Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)"); - $sth2->execute("$subject[$i] %","% $subject[$i] %","% $subject[$i]"); - while (my $data = $sth2->fetchrow_hashref) { - $error .= "
$data->{'catalogueentry'}"; - } # while - $sth2->finish; - } # else - } # else - $sth->finish; - } # else - if ($error eq '') { - my $sth = $dbh->prepare("Delete from bibliosubject where biblionumber = ?"); - $sth->execute($bibnum); - $sth->finish; - $sth = $dbh->prepare("Insert into bibliosubject (subject,biblionumber) values (?,?)"); - my $query; - foreach $query (@subject) { - $sth->execute($query,$bibnum) if ($query && $bibnum); - } # foreach - $sth->finish; - } # if - - # $dbh->disconnect; - return($error); -} # sub modsubject + # $dbh->disconnect; + return ($error); +} # sub modsubject sub OLDmodbibitem { - my ($dbh,$biblioitem) = @_; -# my $dbh = C4Connect; + my ( $dbh, $biblioitem ) = @_; + + # my $dbh = C4Connect; my $query; - $biblioitem->{'itemtype'} = $dbh->quote($biblioitem->{'itemtype'}); - $biblioitem->{'url'} = $dbh->quote($biblioitem->{'url'}); - $biblioitem->{'isbn'} = $dbh->quote($biblioitem->{'isbn'}); - $biblioitem->{'publishercode'} = $dbh->quote($biblioitem->{'publishercode'}); - $biblioitem->{'publicationyear'} = $dbh->quote($biblioitem->{'publicationyear'}); - $biblioitem->{'classification'} = $dbh->quote($biblioitem->{'classification'}); - $biblioitem->{'dewey'} = $dbh->quote($biblioitem->{'dewey'}); - $biblioitem->{'subclass'} = $dbh->quote($biblioitem->{'subclass'}); - $biblioitem->{'illus'} = $dbh->quote($biblioitem->{'illus'}); - $biblioitem->{'pages'} = $dbh->quote($biblioitem->{'pages'}); - $biblioitem->{'volumeddesc'} = $dbh->quote($biblioitem->{'volumeddesc'}); - $biblioitem->{'bnotes'} = $dbh->quote($biblioitem->{'bnotes'}); - $biblioitem->{'size'} = $dbh->quote($biblioitem->{'size'}); - $biblioitem->{'place'} = $dbh->quote($biblioitem->{'place'}); + $biblioitem->{'itemtype'} = $dbh->quote( $biblioitem->{'itemtype'} ); + $biblioitem->{'url'} = $dbh->quote( $biblioitem->{'url'} ); + $biblioitem->{'isbn'} = $dbh->quote( $biblioitem->{'isbn'} ); + $biblioitem->{'publishercode'} = + $dbh->quote( $biblioitem->{'publishercode'} ); + $biblioitem->{'publicationyear'} = + $dbh->quote( $biblioitem->{'publicationyear'} ); + $biblioitem->{'classification'} = + $dbh->quote( $biblioitem->{'classification'} ); + $biblioitem->{'dewey'} = $dbh->quote( $biblioitem->{'dewey'} ); + $biblioitem->{'subclass'} = $dbh->quote( $biblioitem->{'subclass'} ); + $biblioitem->{'illus'} = $dbh->quote( $biblioitem->{'illus'} ); + $biblioitem->{'pages'} = $dbh->quote( $biblioitem->{'pages'} ); + $biblioitem->{'volumeddesc'} = $dbh->quote( $biblioitem->{'volumeddesc'} ); + $biblioitem->{'bnotes'} = $dbh->quote( $biblioitem->{'bnotes'} ); + $biblioitem->{'size'} = $dbh->quote( $biblioitem->{'size'} ); + $biblioitem->{'place'} = $dbh->quote( $biblioitem->{'place'} ); $query = "Update biblioitems set itemtype = $biblioitem->{'itemtype'}, @@ -1345,38 +1711,42 @@ size = $biblioitem->{'size'}, place = $biblioitem->{'place'} where biblioitemnumber = $biblioitem->{'biblioitemnumber'}"; -$dbh->do($query); -if ($dbh->errstr) { - warn "$query"; -} -# $dbh->disconnect; -} # sub modbibitem + $dbh->do($query); + if ( $dbh->errstr ) { + warn "$query"; + } + + # $dbh->disconnect; +} # sub modbibitem sub OLDmodnote { - my ($dbh,$bibitemnum,$note)=@_; -# my $dbh=C4Connect; - my $query="update biblioitems set notes='$note' where + my ( $dbh, $bibitemnum, $note ) = @_; + + # my $dbh=C4Connect; + my $query = "update biblioitems set notes='$note' where biblioitemnumber='$bibitemnum'"; - my $sth=$dbh->prepare($query); - $sth->execute; - $sth->finish; -# $dbh->disconnect; + my $sth = $dbh->prepare($query); + $sth->execute; + $sth->finish; + + # $dbh->disconnect; } sub OLDnewbiblioitem { - my ($dbh,$biblioitem) = @_; - # my $dbh = C4Connect; - my $sth = $dbh->prepare("Select max(biblioitemnumber) from biblioitems"); - my $data; - my $bibitemnum; + my ( $dbh, $biblioitem ) = @_; + + # my $dbh = C4Connect; + my $sth = $dbh->prepare("Select max(biblioitemnumber) from biblioitems"); + my $data; + my $bibitemnum; - $sth->execute; - $data = $sth->fetchrow_arrayref; - $bibitemnum = $$data[0] + 1; + $sth->execute; + $data = $sth->fetchrow_arrayref; + $bibitemnum = $$data[0] + 1; - $sth->finish; + $sth->finish; - $sth = $dbh->prepare("insert into biblioitems set + $sth = $dbh->prepare( "insert into biblioitems set biblioitemnumber = ?, biblionumber = ?, volume = ?, number = ?, classification = ?, itemtype = ?, @@ -1387,57 +1757,66 @@ sub OLDnewbiblioitem { volumeddesc = ?, illus = ?, pages = ?, notes = ?, size = ?, lccn = ?, - marc = ?, place = ?"); - $sth->execute($bibitemnum, $biblioitem->{'biblionumber'}, - $biblioitem->{'volume'}, $biblioitem->{'number'}, - $biblioitem->{'classification'}, $biblioitem->{'itemtype'}, - $biblioitem->{'url'}, $biblioitem->{'isbn'}, - $biblioitem->{'issn'}, $biblioitem->{'dewey'}, - $biblioitem->{'subclass'}, $biblioitem->{'publicationyear'}, - $biblioitem->{'publishercode'}, $biblioitem->{'volumedate'}, - $biblioitem->{'volumeddesc'}, $biblioitem->{'illus'}, - $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, - $biblioitem->{'size'}, $biblioitem->{'lccn'}, - $biblioitem->{'marc'}, $biblioitem->{'place'}); - $sth->finish; - # $dbh->disconnect; - return($bibitemnum); + marc = ?, place = ?" + ); + $sth->execute( + $bibitemnum, $biblioitem->{'biblionumber'}, + $biblioitem->{'volume'}, $biblioitem->{'number'}, + $biblioitem->{'classification'}, $biblioitem->{'itemtype'}, + $biblioitem->{'url'}, $biblioitem->{'isbn'}, + $biblioitem->{'issn'}, $biblioitem->{'dewey'}, + $biblioitem->{'subclass'}, $biblioitem->{'publicationyear'}, + $biblioitem->{'publishercode'}, $biblioitem->{'volumedate'}, + $biblioitem->{'volumeddesc'}, $biblioitem->{'illus'}, + $biblioitem->{'pages'}, $biblioitem->{'bnotes'}, + $biblioitem->{'size'}, $biblioitem->{'lccn'}, + $biblioitem->{'marc'}, $biblioitem->{'place'} + ); + $sth->finish; + + # $dbh->disconnect; + return ($bibitemnum); } sub OLDnewsubject { - my ($dbh,$bibnum)=@_; - my $sth=$dbh->prepare("insert into bibliosubject (biblionumber) values (?)"); - $sth->execute($bibnum); - $sth->finish; + my ( $dbh, $bibnum ) = @_; + my $sth = + $dbh->prepare("insert into bibliosubject (biblionumber) values (?)"); + $sth->execute($bibnum); + $sth->finish; } sub OLDnewsubtitle { - my ($dbh,$bibnum, $subtitle) = @_; - my $sth = $dbh->prepare("insert into bibliosubtitle set biblionumber = ?, subtitle = ?"); - $sth->execute($bibnum,$subtitle); + my ( $dbh, $bibnum, $subtitle ) = @_; + my $sth = + $dbh->prepare( + "insert into bibliosubtitle set biblionumber = ?, subtitle = ?"); + $sth->execute( $bibnum, $subtitle ); $sth->finish; } - sub OLDnewitems { - my ($dbh,$item, $barcode) = @_; - # my $dbh = C4Connect; - my $sth = $dbh->prepare("Select max(itemnumber) from items"); - my $data; - my $itemnumber; - my $error = ""; - - $sth->execute; - $data = $sth->fetchrow_hashref; - $itemnumber = $data->{'max(itemnumber)'} + 1; - $sth->finish; + my ( $dbh, $item, $barcode ) = @_; + + # my $dbh = C4Connect; + my $sth = $dbh->prepare("Select max(itemnumber) from items"); + my $data; + my $itemnumber; + my $error = ""; + + $sth->execute; + $data = $sth->fetchrow_hashref; + $itemnumber = $data->{'max(itemnumber)'} + 1; + $sth->finish; + # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix. - if ($item->{'loan'}) { - $item->{'notforloan'} = $item->{'loan'}; - } -# if dateaccessioned is provided, use it. Otherwise, set to NOW() - if ($item->{'dateaccessioned'}) { - $sth=$dbh->prepare("Insert into items set + if ( $item->{'loan'} ) { + $item->{'notforloan'} = $item->{'loan'}; + } + + # if dateaccessioned is provided, use it. Otherwise, set to NOW() + if ( $item->{'dateaccessioned'} ) { + $sth = $dbh->prepare( "Insert into items set itemnumber = ?, biblionumber = ?, biblioitemnumber = ?, barcode = ?, booksellerid = ?, dateaccessioned = ?, @@ -1445,15 +1824,20 @@ sub OLDnewitems { price = ?, replacementprice = ?, replacementpricedate = NOW(), itemnotes = ?, itemcallnumber =?, notforloan = ? - "); - $sth->execute($itemnumber, $item->{'biblionumber'}, - $item->{'biblioitemnumber'},$barcode, - $item->{'booksellerid'},$item->{'dateaccessioned'}, - $item->{'homebranch'},$item->{'holdingbranch'}, - $item->{'price'},$item->{'replacementprice'}, - $item->{'itemnotes'},$item->{'itemcallnumber'},$item->{'notforloan'}); - } else { - $sth=$dbh->prepare("Insert into items set + " + ); + $sth->execute( + $itemnumber, $item->{'biblionumber'}, + $item->{'biblioitemnumber'}, $barcode, + $item->{'booksellerid'}, $item->{'dateaccessioned'}, + $item->{'homebranch'}, $item->{'holdingbranch'}, + $item->{'price'}, $item->{'replacementprice'}, + $item->{'itemnotes'}, $item->{'itemcallnumber'}, + $item->{'notforloan'} + ); + } + else { + $sth = $dbh->prepare( "Insert into items set itemnumber = ?, biblionumber = ?, biblioitemnumber = ?, barcode = ?, booksellerid = ?, dateaccessioned = NOW(), @@ -1461,35 +1845,44 @@ sub OLDnewitems { price = ?, replacementprice = ?, replacementpricedate = NOW(), itemnotes = ?, itemcallnumber = ? , notforloan = ? - "); - $sth->execute($itemnumber, $item->{'biblionumber'}, - $item->{'biblioitemnumber'},$barcode, - $item->{'booksellerid'}, - $item->{'homebranch'},$item->{'holdingbranch'}, - $item->{'price'},$item->{'replacementprice'}, - $item->{'itemnotes'},$item->{'itemcallnumber'},$item->{'notforloan'}); - } - if (defined $sth->errstr) { - $error .= $sth->errstr; - } - $sth->finish; - return($itemnumber,$error); + " + ); + $sth->execute( + $itemnumber, $item->{'biblionumber'}, + $item->{'biblioitemnumber'}, $barcode, + $item->{'booksellerid'}, $item->{'homebranch'}, + $item->{'holdingbranch'}, $item->{'price'}, + $item->{'replacementprice'}, $item->{'itemnotes'}, + $item->{'itemcallnumber'}, $item->{'notforloan'} + ); + } + if ( defined $sth->errstr ) { + $error .= $sth->errstr; + } + $sth->finish; + return ( $itemnumber, $error ); } sub OLDmoditem { - my ($dbh,$item) = @_; + my ( $dbh, $item ) = @_; + # my ($dbh,$loan,$itemnum,$bibitemnum,$barcode,$notes,$homebranch,$lost,$wthdrawn,$replacement)=@_; -# my $dbh=C4Connect; -$item->{'itemnum'}=$item->{'itemnumber'} unless $item->{'itemnum'}; - my $query="update items set barcode=?,itemnotes=?,itemcallnumber=?,notforloan=? where itemnumber=?"; - my @bind = ($item->{'barcode'},$item->{'notes'},$item->{'itemcallnumber'},$item->{'notforloan'},$item->{'itemnum'}); - if ($item->{'barcode'} eq ''){ - $item->{'notforloan'}=0 unless $item->{'notforloan'}; - $query="update items set notforloan=? where itemnumber=?"; - @bind = ($item->{'notforloan'},$item->{'itemnum'}); - } - if ($item->{'lost'} ne ''){ - $query="update items set biblioitemnumber=?, + # my $dbh=C4Connect; + $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'}; + my $query = +"update items set barcode=?,itemnotes=?,itemcallnumber=?,notforloan=? where itemnumber=?"; + my @bind = ( + $item->{'barcode'}, $item->{'notes'}, + $item->{'itemcallnumber'}, $item->{'notforloan'}, + $item->{'itemnum'} + ); + if ( $item->{'barcode'} eq '' ) { + $item->{'notforloan'} = 0 unless $item->{'notforloan'}; + $query = "update items set notforloan=? where itemnumber=?"; + @bind = ( $item->{'notforloan'}, $item->{'itemnum'} ); + } + if ( $item->{'lost'} ne '' ) { + $query = "update items set biblioitemnumber=?, barcode=?, itemnotes=?, homebranch=?, @@ -1498,108 +1891,137 @@ $item->{'itemnum'}=$item->{'itemnumber'} unless $item->{'itemnum'}; itemcallnumber=?, notforloan=?, where itemnumber=?"; - @bind = ($item->{'bibitemnum'},$item->{'barcode'},$item->{'notes'},$item->{'homebranch'},$item->{'lost'},$item->{'wthdrawn'},$item->{'itemcallnumber'},$item->{'notforloan'},$item->{'itemnum'}); - } - if ($item->{'replacement'} ne ''){ - $query=~ s/ where/,replacementprice='$item->{'replacement'}' where/; - } - my $sth=$dbh->prepare($query); - $sth->execute(@bind); - $sth->finish; -# $dbh->disconnect; + @bind = ( + $item->{'bibitemnum'}, $item->{'barcode'}, + $item->{'notes'}, $item->{'homebranch'}, + $item->{'lost'}, $item->{'wthdrawn'}, + $item->{'itemcallnumber'}, $item->{'notforloan'}, + $item->{'itemnum'} + ); + } + if ( $item->{'replacement'} ne '' ) { + $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/; + } + my $sth = $dbh->prepare($query); + $sth->execute(@bind); + $sth->finish; + + # $dbh->disconnect; } -sub OLDdelitem{ - my ($dbh,$itemnum)=@_; - # my $dbh=C4Connect; - my $sth=$dbh->prepare("select * from items where itemnumber=?"); - $sth->execute($itemnum); - my $data=$sth->fetchrow_hashref; - $sth->finish; - my $query="Insert into deleteditems set "; - my @bind = (); - foreach my $temp (keys %$data){ - $query .= "$temp = ?,"; - push(@bind,$data->{$temp}); - } - $query =~ s/\,$//; -# print $query; - $sth=$dbh->prepare($query); - $sth->execute(@bind); - $sth->finish; - $sth=$dbh->prepare("Delete from items where itemnumber=?"); - $sth->execute($itemnum); - $sth->finish; -# $dbh->disconnect; +sub OLDdelitem { + my ( $dbh, $itemnum ) = @_; + + # my $dbh=C4Connect; + my $sth = $dbh->prepare("select * from items where itemnumber=?"); + $sth->execute($itemnum); + my $data = $sth->fetchrow_hashref; + $sth->finish; + my $query = "Insert into deleteditems set "; + my @bind = (); + foreach my $temp ( keys %$data ) { + $query .= "$temp = ?,"; + push ( @bind, $data->{$temp} ); + } + $query =~ s/\,$//; + + # print $query; + $sth = $dbh->prepare($query); + $sth->execute(@bind); + $sth->finish; + $sth = $dbh->prepare("Delete from items where itemnumber=?"); + $sth->execute($itemnum); + $sth->finish; + + # $dbh->disconnect; } sub OLDdeletebiblioitem { - my ($dbh,$biblioitemnumber) = @_; -# my $dbh = C4Connect; - my $sth = $dbh->prepare("Select * from biblioitems -where biblioitemnumber = ?"); + my ( $dbh, $biblioitemnumber ) = @_; + + # my $dbh = C4Connect; + my $sth = $dbh->prepare( "Select * from biblioitems +where biblioitemnumber = ?" + ); my $results; $sth->execute($biblioitemnumber); - if ($results = $sth->fetchrow_hashref) { - $sth->finish; - $sth=$dbh->prepare("Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype, + if ( $results = $sth->fetchrow_hashref ) { + $sth->finish; + $sth = + $dbh->prepare( +"Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype, isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus , - pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"); - - $sth->execute($results->{biblioitemnumber}, $results->{biblionumber}, $results->{volume}, $results->{number}, $results->{classification}, $results->{itemtype}, - $results->{isbn}, $results->{issn} ,$results->{dewey} ,$results->{subclass} ,$results->{publicationyear} ,$results->{publishercode} ,$results->{volumedate} ,$results->{volumeddesc} ,$results->{timestamp} ,$results->{illus} , - $results->{pages} ,$results->{notes} ,$results->{size} ,$results->{url} ,$results->{lccn} ); - my $sth2 = $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?"); + pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)" + ); + + $sth->execute( + $results->{biblioitemnumber}, $results->{biblionumber}, + $results->{volume}, $results->{number}, + $results->{classification}, $results->{itemtype}, + $results->{isbn}, $results->{issn}, + $results->{dewey}, $results->{subclass}, + $results->{publicationyear}, $results->{publishercode}, + $results->{volumedate}, $results->{volumeddesc}, + $results->{timestamp}, $results->{illus}, + $results->{pages}, $results->{notes}, + $results->{size}, $results->{url}, + $results->{lccn} + ); + my $sth2 = + $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?"); $sth2->execute($biblioitemnumber); $sth2->finish(); - } # if + } # if + $sth->finish; + + # Now delete all the items attached to the biblioitem + $sth = $dbh->prepare("Select * from items where biblioitemnumber = ?"); + $sth->execute($biblioitemnumber); + my @results; + while ( my $data = $sth->fetchrow_hashref ) { + my $query = "Insert into deleteditems set "; + my @bind = (); + foreach my $temp ( keys %$data ) { + $query .= "$temp = ?,"; + push ( @bind, $data->{$temp} ); + } + $query =~ s/\,$//; + my $sth2 = $dbh->prepare($query); + $sth2->execute(@bind); + } # while + $sth->finish; + $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?"); + $sth->execute($biblioitemnumber); + $sth->finish(); + + # $dbh->disconnect; +} # sub deletebiblioitem + +sub OLDdelbiblio { + my ( $dbh, $biblio ) = @_; + my $sth = $dbh->prepare("select * from biblio where biblionumber=?"); + $sth->execute($biblio); + if ( my $data = $sth->fetchrow_hashref ) { + $sth->finish; + my $query = "Insert into deletedbiblio set "; + my @bind = (); + foreach my $temp ( keys %$data ) { + $query .= "$temp = ?,"; + push ( @bind, $data->{$temp} ); + } + + #replacing the last , by ",?)" + $query =~ s/\,$//; + $sth = $dbh->prepare($query); + $sth->execute(@bind); + $sth->finish; + $sth = $dbh->prepare("Delete from biblio where biblionumber=?"); + $sth->execute($biblio); + $sth->finish; + } $sth->finish; -# Now delete all the items attached to the biblioitem - $sth = $dbh->prepare("Select * from items where biblioitemnumber = ?"); - $sth->execute($biblioitemnumber); - my @results; - while (my $data = $sth->fetchrow_hashref) { - my $query="Insert into deleteditems set "; - my @bind = (); - foreach my $temp (keys %$data){ - $query .= "$temp = ?,"; - push(@bind,$data->{$temp}); - } - $query =~ s/\,$//; - my $sth2=$dbh->prepare($query); - $sth2->execute(@bind); - } # while - $sth->finish; - $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?"); - $sth->execute($biblioitemnumber); - $sth->finish(); -# $dbh->disconnect; -} # sub deletebiblioitem - -sub OLDdelbiblio{ - my ($dbh,$biblio)=@_; - my $sth=$dbh->prepare("select * from biblio where biblionumber=?"); - $sth->execute($biblio); - if (my $data=$sth->fetchrow_hashref){ - $sth->finish; - my $query="Insert into deletedbiblio set "; - my @bind =(); - foreach my $temp (keys %$data){ - $query .= "$temp = ?,"; - push(@bind,$data->{$temp}); - } - #replacing the last , by ",?)" - $query=~ s/\,$//; - $sth=$dbh->prepare($query); - $sth->execute(@bind); - $sth->finish; - $sth=$dbh->prepare("Delete from biblio where biblionumber=?"); - $sth->execute($biblio); - $sth->finish; - } - $sth->finish; } # @@ -1608,15 +2030,16 @@ sub OLDdelbiblio{ # # -sub itemcount{ - my ($biblio)=@_; - my $dbh = C4::Context->dbh; -# print $query; - my $sth=$dbh->prepare("Select count(*) from items where biblionumber=?"); - $sth->execute($biblio); - my $data=$sth->fetchrow_hashref; - $sth->finish; - return($data->{'count(*)'}); +sub itemcount { + my ($biblio) = @_; + my $dbh = C4::Context->dbh; + + # print $query; + my $sth = $dbh->prepare("Select count(*) from items where biblionumber=?"); + $sth->execute($biblio); + my $data = $sth->fetchrow_hashref; + $sth->finish; + return ( $data->{'count(*)'} ); } =item getorder @@ -1631,22 +2054,25 @@ fields from the biblio, biblioitems, aqorders, and aqorderbreakdown tables of the Koha database. =cut + #' # FIXME - This is effectively identical to &C4::Catalogue::getorder. # Pick one and stick with it. -sub getorder{ - my ($bi,$bib)=@_; - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("Select ordernumber +sub getorder { + my ( $bi, $bib ) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare( "Select ordernumber from aqorders - where biblionumber=? and biblioitemnumber=?"); - $sth->execute($bib,$bi); - # FIXME - Use fetchrow_array(), since we're only interested in the one - # value. - my $ordnum=$sth->fetchrow_hashref; - $sth->finish; - my $order=getsingleorder($ordnum->{'ordernumber'}); - return ($order,$ordnum->{'ordernumber'}); + where biblionumber=? and biblioitemnumber=?" + ); + $sth->execute( $bib, $bi ); + + # FIXME - Use fetchrow_array(), since we're only interested in the one + # value. + my $ordnum = $sth->fetchrow_hashref; + $sth->finish; + my $order = getsingleorder( $ordnum->{'ordernumber'} ); + return ( $order, $ordnum->{'ordernumber'} ); } =item getsingleorder @@ -1660,33 +2086,38 @@ C<$order> are fields from the biblio, biblioitems, aqorders, and aqorderbreakdown tables of the Koha database. =cut + #' # FIXME - This is effectively identical to # &C4::Catalogue::getsingleorder. # Pick one and stick with it. sub getsingleorder { - my ($ordnum)=@_; - my $dbh = C4::Context->dbh; - my $sth=$dbh->prepare("Select * from biblio,biblioitems,aqorders left join aqorderbreakdown + my ($ordnum) = @_; + my $dbh = C4::Context->dbh; + my $sth = + $dbh->prepare( + "Select * from biblio,biblioitems,aqorders left join aqorderbreakdown on aqorders.ordernumber=aqorderbreakdown.ordernumber where aqorders.ordernumber=? and biblio.biblionumber=aqorders.biblionumber - and biblioitems.biblioitemnumber=aqorders.biblioitemnumber"); - $sth->execute($ordnum); - my $data=$sth->fetchrow_hashref; - $sth->finish; - return($data); + and biblioitems.biblioitemnumber=aqorders.biblioitemnumber" + ); + $sth->execute($ordnum); + my $data = $sth->fetchrow_hashref; + $sth->finish; + return ($data); } sub newbiblio { - my ($biblio) = @_; - my $dbh = C4::Context->dbh; - my $bibnum=OLDnewbiblio($dbh,$biblio); - # finds new (MARC bibid -# my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum); - my $record = &MARCkoha2marcBiblio($dbh,$bibnum); - MARCaddbiblio($dbh,$record,$bibnum); - return($bibnum); + my ($biblio) = @_; + my $dbh = C4::Context->dbh; + my $bibnum = OLDnewbiblio( $dbh, $biblio ); + + # finds new (MARC bibid + # my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum); + my $record = &MARCkoha2marcBiblio( $dbh, $bibnum ); + MARCaddbiblio( $dbh, $record, $bibnum ); + return ($bibnum); } =item modbiblio @@ -1708,15 +2139,16 @@ successful or not. =cut sub modbiblio { - my ($biblio) = @_; - my $dbh = C4::Context->dbh; - my $biblionumber=OLDmodbiblio($dbh,$biblio); - my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber); - # finds new (MARC bibid - my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber); - MARCmodbiblio($dbh,$bibid,$record,0); - return($biblionumber); -} # sub modbiblio + my ($biblio) = @_; + my $dbh = C4::Context->dbh; + my $biblionumber = OLDmodbiblio( $dbh, $biblio ); + my $record = MARCkoha2marcBiblio( $dbh, $biblionumber, $biblionumber ); + + # finds new (MARC bibid + my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblionumber ); + MARCmodbiblio( $dbh, $bibid, $record, 0 ); + return ($biblionumber); +} # sub modbiblio =item modsubtitle @@ -1731,10 +2163,10 @@ C<$subtitle> is the new subtitle. =cut sub modsubtitle { - my ($bibnum, $subtitle) = @_; - my $dbh = C4::Context->dbh; - &OLDmodsubtitle($dbh,$bibnum,$subtitle); -} # sub modsubtitle + my ( $bibnum, $subtitle ) = @_; + my $dbh = C4::Context->dbh; + &OLDmodsubtitle( $dbh, $bibnum, $subtitle ); +} # sub modsubtitle =item modaddauthor @@ -1747,10 +2179,10 @@ C<&modaddauthor> deletes all additional authors. =cut sub modaddauthor { - my ($bibnum, $author) = @_; - my $dbh = C4::Context->dbh; - &OLDmodaddauthor($dbh,$bibnum,$author); -} # sub modaddauthor + my ( $bibnum, @authors ) = @_; + my $dbh = C4::Context->dbh; + &OLDmodaddauthor( $dbh, $bibnum, @authors ); +} # sub modaddauthor =item modsubject @@ -1763,421 +2195,471 @@ $error - Error message, or undef if successful. =cut sub modsubject { - my ($bibnum, $force, @subject) = @_; - my $dbh = C4::Context->dbh; - my $error= &OLDmodsubject($dbh,$bibnum,$force, @subject); - return($error); -} # sub modsubject + my ( $bibnum, $force, @subject ) = @_; + my $dbh = C4::Context->dbh; + my $error = &OLDmodsubject( $dbh, $bibnum, $force, @subject ); + return ($error); +} # sub modsubject sub modbibitem { my ($biblioitem) = @_; - my $dbh = C4::Context->dbh; - &OLDmodbibitem($dbh,$biblioitem); -} # sub modbibitem + my $dbh = C4::Context->dbh; + &OLDmodbibitem( $dbh, $biblioitem ); +} # sub modbibitem sub modnote { - my ($bibitemnum,$note)=@_; - my $dbh = C4::Context->dbh; - &OLDmodnote($dbh,$bibitemnum,$note); + my ( $bibitemnum, $note ) = @_; + my $dbh = C4::Context->dbh; + &OLDmodnote( $dbh, $bibitemnum, $note ); } sub newbiblioitem { - my ($biblioitem) = @_; - my $dbh = C4::Context->dbh; - my $bibitemnum = &OLDnewbiblioitem($dbh,$biblioitem); + my ($biblioitem) = @_; + my $dbh = C4::Context->dbh; + my $bibitemnum = &OLDnewbiblioitem( $dbh, $biblioitem ); + ################################################################ ## Fix template and shift this to newbiblio - my @subjects=split(/\n/,$biblioitem->{'subjectheadings'}); - modsubject($biblioitem->{'biblionumber'},1,@subjects); + my @subjects = split ( /\n/, $biblioitem->{'subjectheadings'} ); + modsubject( $biblioitem->{'biblionumber'}, 1, @subjects ); + ################################################################ - my $MARCbiblio= MARCkoha2marcBiblio($dbh,0,$bibitemnum); # the 0 means "do NOT retrieve biblio, only biblioitem, in the MARC record - my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblioitem->{biblionumber}); - &MARCaddbiblio($dbh,$MARCbiblio,$biblioitem->{biblionumber},$bibid); - return($bibitemnum); + my $MARCbiblio = + MARCkoha2marcBiblio( $dbh, 0, $bibitemnum ) + ; # the 0 means "do NOT retrieve biblio, only biblioitem, in the MARC record + my $bibid = + &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, + $biblioitem->{biblionumber} ); + &MARCaddbiblio( $dbh, $MARCbiblio, $biblioitem->{biblionumber}, $bibid ); + return ($bibitemnum); } sub newsubject { - my ($bibnum)=@_; - my $dbh = C4::Context->dbh; - &OLDnewsubject($dbh,$bibnum); + my ($bibnum) = @_; + my $dbh = C4::Context->dbh; + &OLDnewsubject( $dbh, $bibnum ); } sub newsubtitle { - my ($bibnum, $subtitle) = @_; - my $dbh = C4::Context->dbh; - &OLDnewsubtitle($dbh,$bibnum,$subtitle); + my ( $bibnum, $subtitle ) = @_; + my $dbh = C4::Context->dbh; + &OLDnewsubtitle( $dbh, $bibnum, $subtitle ); } sub newitems { - my ($item, @barcodes) = @_; - my $dbh = C4::Context->dbh; - my $errors; - my $itemnumber; - my $error; - foreach my $barcode (@barcodes) { - ($itemnumber,$error)=&OLDnewitems($dbh,$item,uc($barcode)); - $errors .=$error; - my $MARCitem = &MARCkoha2marcItem($dbh,$item->{biblionumber},$itemnumber); - &MARCadditem($dbh,$MARCitem,$item->{biblionumber}); - } - return($errors); + my ( $item, @barcodes ) = @_; + my $dbh = C4::Context->dbh; + my $errors; + my $itemnumber; + my $error; + foreach my $barcode (@barcodes) { + ( $itemnumber, $error ) = &OLDnewitems( $dbh, $item, uc($barcode) ); + $errors .= $error; + my $MARCitem = + &MARCkoha2marcItem( $dbh, $item->{biblionumber}, $itemnumber ); + &MARCadditem( $dbh, $MARCitem, $item->{biblionumber} ); + } + return ($errors); } sub moditem { my ($item) = @_; my $dbh = C4::Context->dbh; - &OLDmoditem($dbh,$item); - my $MARCitem = &MARCkoha2marcItem($dbh,$item->{'biblionumber'},$item->{'itemnum'}); - my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$item->{biblionumber}); - &MARCmoditem($dbh,$MARCitem,$bibid,$item->{itemnum},0); + &OLDmoditem( $dbh, $item ); + my $MARCitem = + &MARCkoha2marcItem( $dbh, $item->{'biblionumber'}, $item->{'itemnum'} ); + my $bibid = + &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $item->{biblionumber} ); + &MARCmoditem( $dbh, $MARCitem, $bibid, $item->{itemnum}, 0 ); } -sub checkitems{ - my ($count,@barcodes)=@_; - my $dbh = C4::Context->dbh; - my $error; - my $sth=$dbh->prepare("Select * from items where barcode=?"); - for (my $i=0;$i<$count;$i++){ - $barcodes[$i]=uc $barcodes[$i]; - $sth->execute($barcodes[$i]); - if (my $data=$sth->fetchrow_hashref){ - $error.=" Duplicate Barcode: $barcodes[$i]"; - } - } - $sth->finish; - return($error); +sub checkitems { + my ( $count, @barcodes ) = @_; + my $dbh = C4::Context->dbh; + my $error; + my $sth = $dbh->prepare("Select * from items where barcode=?"); + for ( my $i = 0 ; $i < $count ; $i++ ) { + $barcodes[$i] = uc $barcodes[$i]; + $sth->execute( $barcodes[$i] ); + if ( my $data = $sth->fetchrow_hashref ) { + $error .= " Duplicate Barcode: $barcodes[$i]"; + } + } + $sth->finish; + return ($error); } -sub countitems{ - my ($bibitemnum)=@_; - my $dbh = C4::Context->dbh; - my $query=""; - my $sth=$dbh->prepare("Select count(*) from items where biblioitemnumber=?"); - $sth->execute($bibitemnum); - my $data=$sth->fetchrow_hashref; - $sth->finish; - return($data->{'count(*)'}); +sub countitems { + my ($bibitemnum) = @_; + my $dbh = C4::Context->dbh; + my $query = ""; + my $sth = + $dbh->prepare("Select count(*) from items where biblioitemnumber=?"); + $sth->execute($bibitemnum); + my $data = $sth->fetchrow_hashref; + $sth->finish; + return ( $data->{'count(*)'} ); } -sub delitem{ - my ($itemnum)=@_; - my $dbh = C4::Context->dbh; - &OLDdelitem($dbh,$itemnum); +sub delitem { + my ($itemnum) = @_; + my $dbh = C4::Context->dbh; + &OLDdelitem( $dbh, $itemnum ); } sub deletebiblioitem { my ($biblioitemnumber) = @_; - my $dbh = C4::Context->dbh; - &OLDdeletebiblioitem($dbh,$biblioitemnumber); -} # sub deletebiblioitem - + my $dbh = C4::Context->dbh; + &OLDdeletebiblioitem( $dbh, $biblioitemnumber ); +} # sub deletebiblioitem sub delbiblio { - my ($biblio)=@_; - my $dbh = C4::Context->dbh; - &OLDdelbiblio($dbh,$biblio); - my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblio); - &MARCdelbiblio($dbh,$bibid,0); + my ($biblio) = @_; + my $dbh = C4::Context->dbh; + &OLDdelbiblio( $dbh, $biblio ); + my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio ); + &MARCdelbiblio( $dbh, $bibid, 0 ); } sub getbiblio { my ($biblionumber) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?"); - # || die "Cannot prepare $query\n" . $dbh->errstr; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?"); + + # || die "Cannot prepare $query\n" . $dbh->errstr; my $count = 0; my @results; $sth->execute($biblionumber); - # || die "Cannot execute $query\n" . $sth->errstr; - while (my $data = $sth->fetchrow_hashref) { - $results[$count] = $data; - $count++; - } # while + + # || die "Cannot execute $query\n" . $sth->errstr; + while ( my $data = $sth->fetchrow_hashref ) { + $results[$count] = $data; + $count++; + } # while $sth->finish; - return($count, @results); -} # sub getbiblio + return ( $count, @results ); +} # sub getbiblio sub getbiblioitem { my ($biblioitemnum) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("Select * from biblioitems where -biblioitemnumber = ?"); + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare( "Select * from biblioitems where +biblioitemnumber = ?" + ); my $count = 0; my @results; $sth->execute($biblioitemnum); - while (my $data = $sth->fetchrow_hashref) { + while ( my $data = $sth->fetchrow_hashref ) { $results[$count] = $data; - $count++; - } # while + $count++; + } # while $sth->finish; - return($count, @results); -} # sub getbiblioitem + return ( $count, @results ); +} # sub getbiblioitem sub getbiblioitembybiblionumber { my ($biblionumber) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?"); + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?"); my $count = 0; my @results; $sth->execute($biblionumber); - while (my $data = $sth->fetchrow_hashref) { + while ( my $data = $sth->fetchrow_hashref ) { + $results[$count] = $data; + $count++; + } # while + + $sth->finish; + return ( $count, @results ); +} # sub + +sub getitemtypes { + my $dbh = C4::Context->dbh; + my $query = "select * from itemtypes order by description"; + my $sth = $dbh->prepare($query); + + # || die "Cannot prepare $query" . $dbh->errstr; + my $count = 0; + my @results; + + $sth->execute; + + # || die "Cannot execute $query\n" . $sth->errstr; + while ( my $data = $sth->fetchrow_hashref ) { $results[$count] = $data; - $count++; - } # while + $count++; + } # while $sth->finish; - return($count, @results); -} # sub + return ( $count, @results ); +} # sub getitemtypes sub getitemsbybiblioitem { my ($biblioitemnum) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("Select * from items, biblio where + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare( "Select * from items, biblio where biblio.biblionumber = items.biblionumber and biblioitemnumber -= ?"); - # || die "Cannot prepare $query\n" . $dbh->errstr; += ?" + ); + + # || die "Cannot prepare $query\n" . $dbh->errstr; my $count = 0; my @results; $sth->execute($biblioitemnum); - # || die "Cannot execute $query\n" . $sth->errstr; - while (my $data = $sth->fetchrow_hashref) { - $results[$count] = $data; - $count++; - } # while - $sth->finish; - return($count, @results); -} # sub getitemsbybiblioitem + # || die "Cannot execute $query\n" . $sth->errstr; + while ( my $data = $sth->fetchrow_hashref ) { + $results[$count] = $data; + $count++; + } # while + $sth->finish; + return ( $count, @results ); +} # sub getitemsbybiblioitem sub logchange { -# Subroutine to log changes to databases + + # Subroutine to log changes to databases # Eventually, this subroutine will be used to create a log of all changes made, -# with the possibility of "undo"ing some changes - my $database=shift; - if ($database eq 'kohadb') { - my $type=shift; - my $section=shift; - my $item=shift; - my $original=shift; - my $new=shift; -# print STDERR "KOHA: $type $section $item $original $new\n"; - } elsif ($database eq 'marc') { - my $type=shift; - my $Record_ID=shift; - my $tag=shift; - my $mark=shift; - my $subfield_ID=shift; - my $original=shift; - my $new=shift; + # with the possibility of "undo"ing some changes + my $database = shift; + if ( $database eq 'kohadb' ) { + my $type = shift; + my $section = shift; + my $item = shift; + my $original = shift; + my $new = shift; + + # print STDERR "KOHA: $type $section $item $original $new\n"; + } + elsif ( $database eq 'marc' ) { + my $type = shift; + my $Record_ID = shift; + my $tag = shift; + my $mark = shift; + my $subfield_ID = shift; + my $original = shift; + my $new = shift; + # print STDERR "MARC: $type $Record_ID $tag $mark $subfield_ID $original $new\n"; } } #------------------------------------------------ - #--------------------------------------- # Find a biblio entry, or create a new one if it doesn't exist. # If a "subtitle" entry is in hash, add it to subtitle table sub getoraddbiblio { - # input params - my ( - $dbh, # db handle - # FIXME - Unused argument - $biblio, # hash ref to fields - )=@_; - # return - my $biblionumber; + # input params + my ( + $dbh, # db handle + # FIXME - Unused argument + $biblio, # hash ref to fields + ) = @_; - my $debug=0; - my $sth; - my $error; + # return + my $biblionumber; + + my $debug = 0; + my $sth; + my $error; - #----- - $dbh = C4::Context->dbh; + #----- + $dbh = C4::Context->dbh; - print "
Looking for biblio
\n" if $debug; - $sth=$dbh->prepare("select biblionumber + print "
Looking for biblio
\n" if $debug; + $sth = $dbh->prepare( "select biblionumber from biblio where title=? and author=? - and copyrightdate=? and seriestitle=?"); - $sth->execute( - $biblio->{title}, $biblio->{author}, - $biblio->{copyright}, $biblio->{seriestitle} ); - if ($sth->rows) { - ($biblionumber) = $sth->fetchrow; - print "
Biblio exists with number $biblionumber
\n" if $debug; - } else { - # Doesn't exist. Add new one. - print "
Adding biblio
\n" if $debug; - ($biblionumber,$error)=&newbiblio($biblio); - if ( $biblionumber ) { - print "
Added with biblio number=$biblionumber
\n" if $debug; - if ( $biblio->{subtitle} ) { - &newsubtitle($biblionumber,$biblio->{subtitle} ); - } # if subtitle - } else { - print "
Couldn't add biblio: $error
\n" if $debug; - } # if added - } - - return $biblionumber,$error; - -} # sub getoraddbiblio + and copyrightdate=? and seriestitle=?" + ); + $sth->execute( + $biblio->{title}, $biblio->{author}, + $biblio->{copyright}, $biblio->{seriestitle} + ); + if ( $sth->rows ) { + ($biblionumber) = $sth->fetchrow; + print "
Biblio exists with number $biblionumber
\n" if $debug; + } + else { + + # Doesn't exist. Add new one. + print "
Adding biblio
\n" if $debug; + ( $biblionumber, $error ) = &newbiblio($biblio); + if ($biblionumber) { + print "
Added with biblio number=$biblionumber
\n" + if $debug; + if ( $biblio->{subtitle} ) { + &newsubtitle( $biblionumber, $biblio->{subtitle} ); + } # if subtitle + } + else { + print "
Couldn't add biblio: $error
\n" if $debug; + } # if added + } + + return $biblionumber, $error; + +} # sub getoraddbiblio sub char_decode { - # converts ISO 5426 coded string to ISO 8859-1 - # sloppy code : should be improved in next issue - my ($string,$encoding) = @_ ; - $_ = $string ; -# $encoding = C4::Context->preference("marcflavour") unless $encoding; - if ($encoding eq "UNIMARC") { - s/\xe1/Æ/gm ; - s/\xe2/Ð/gm ; - s/\xe9/Ø/gm ; - s/\xec/þ/gm ; - s/\xf1/æ/gm ; - s/\xf3/ð/gm ; - s/\xf9/ø/gm ; - s/\xfb/ß/gm ; - s/\xc1\x61/à/gm ; - s/\xc1\x65/è/gm ; - s/\xc1\x69/ì/gm ; - s/\xc1\x6f/ò/gm ; - s/\xc1\x75/ù/gm ; - s/\xc1\x41/À/gm ; - s/\xc1\x45/È/gm ; - s/\xc1\x49/Ì/gm ; - s/\xc1\x4f/Ò/gm ; - s/\xc1\x55/Ù/gm ; - s/\xc2\x41/Á/gm ; - s/\xc2\x45/É/gm ; - s/\xc2\x49/Í/gm ; - s/\xc2\x4f/Ó/gm ; - s/\xc2\x55/Ú/gm ; - s/\xc2\x59/Ý/gm ; - s/\xc2\x61/á/gm ; - s/\xc2\x65/é/gm ; - s/\xc2\x69/í/gm ; - s/\xc2\x6f/ó/gm ; - s/\xc2\x75/ú/gm ; - s/\xc2\x79/ý/gm ; - s/\xc3\x41/Â/gm ; - s/\xc3\x45/Ê/gm ; - s/\xc3\x49/Î/gm ; - s/\xc3\x4f/Ô/gm ; - s/\xc3\x55/Û/gm ; - s/\xc3\x61/â/gm ; - s/\xc3\x65/ê/gm ; - s/\xc3\x69/î/gm ; - s/\xc3\x6f/ô/gm ; - s/\xc3\x75/û/gm ; - s/\xc4\x41/Ã/gm ; - s/\xc4\x4e/Ñ/gm ; - s/\xc4\x4f/Õ/gm ; - s/\xc4\x61/ã/gm ; - s/\xc4\x6e/ñ/gm ; - s/\xc4\x6f/õ/gm ; - s/\xc8\x45/Ë/gm ; - s/\xc8\x49/Ï/gm ; - s/\xc8\x65/ë/gm ; - s/\xc8\x69/ï/gm ; - s/\xc8\x76/ÿ/gm ; - s/\xc9\x41/Ä/gm ; - s/\xc9\x4f/Ö/gm ; - s/\xc9\x55/Ü/gm ; - s/\xc9\x61/ä/gm ; - s/\xc9\x6f/ö/gm ; - s/\xc9\x75/ü/gm ; - s/\xca\x41/Å/gm ; - s/\xca\x61/å/gm ; - s/\xd0\x43/Ç/gm ; - s/\xd0\x63/ç/gm ; - # this handles non-sorting blocks (if implementation requires this) - $string = nsb_clean($_) ; - } elsif ($encoding eq "USMARC" || $encoding eq "MARC21") { - if(/[\xc1-\xff]/) { - s/\xe1\x61/à/gm ; - s/\xe1\x65/è/gm ; - s/\xe1\x69/ì/gm ; - s/\xe1\x6f/ò/gm ; - s/\xe1\x75/ù/gm ; - s/\xe1\x41/À/gm ; - s/\xe1\x45/È/gm ; - s/\xe1\x49/Ì/gm ; - s/\xe1\x4f/Ò/gm ; - s/\xe1\x55/Ù/gm ; - s/\xe2\x41/Á/gm ; - s/\xe2\x45/É/gm ; - s/\xe2\x49/Í/gm ; - s/\xe2\x4f/Ó/gm ; - s/\xe2\x55/Ú/gm ; - s/\xe2\x59/Ý/gm ; - s/\xe2\x61/á/gm ; - s/\xe2\x65/é/gm ; - s/\xe2\x69/í/gm ; - s/\xe2\x6f/ó/gm ; - s/\xe2\x75/ú/gm ; - s/\xe2\x79/ý/gm ; - s/\xe3\x41/Â/gm ; - s/\xe3\x45/Ê/gm ; - s/\xe3\x49/Î/gm ; - s/\xe3\x4f/Ô/gm ; - s/\xe3\x55/Û/gm ; - s/\xe3\x61/â/gm ; - s/\xe3\x65/ê/gm ; - s/\xe3\x69/î/gm ; - s/\xe3\x6f/ô/gm ; - s/\xe3\x75/û/gm ; - s/\xe4\x41/Ã/gm ; - s/\xe4\x4e/Ñ/gm ; - s/\xe4\x4f/Õ/gm ; - s/\xe4\x61/ã/gm ; - s/\xe4\x6e/ñ/gm ; - s/\xe4\x6f/õ/gm ; - s/\xe8\x45/Ë/gm ; - s/\xe8\x49/Ï/gm ; - s/\xe8\x65/ë/gm ; - s/\xe8\x69/ï/gm ; - s/\xe8\x76/ÿ/gm ; - s/\xe9\x41/Ä/gm ; - s/\xe9\x4f/Ö/gm ; - s/\xe9\x55/Ü/gm ; - s/\xe9\x61/ä/gm ; - s/\xe9\x6f/ö/gm ; - s/\xe9\x75/ü/gm ; - s/\xea\x41/Å/gm ; - s/\xea\x61/å/gm ; - # this handles non-sorting blocks (if implementation requires this) - $string = nsb_clean($_) ; - } - } - return($string) ; + + # converts ISO 5426 coded string to ISO 8859-1 + # sloppy code : should be improved in next issue + my ( $string, $encoding ) = @_; + $_ = $string; + + # $encoding = C4::Context->preference("marcflavour") unless $encoding; + if ( $encoding eq "UNIMARC" ) { + s/\xe1/Æ/gm; + s/\xe2/Ð/gm; + s/\xe9/Ø/gm; + s/\xec/þ/gm; + s/\xf1/æ/gm; + s/\xf3/ð/gm; + s/\xf9/ø/gm; + s/\xfb/ß/gm; + s/\xc1\x61/à/gm; + s/\xc1\x65/è/gm; + s/\xc1\x69/ì/gm; + s/\xc1\x6f/ò/gm; + s/\xc1\x75/ù/gm; + s/\xc1\x41/À/gm; + s/\xc1\x45/È/gm; + s/\xc1\x49/Ì/gm; + s/\xc1\x4f/Ò/gm; + s/\xc1\x55/Ù/gm; + s/\xc2\x41/Á/gm; + s/\xc2\x45/É/gm; + s/\xc2\x49/Í/gm; + s/\xc2\x4f/Ó/gm; + s/\xc2\x55/Ú/gm; + s/\xc2\x59/Ý/gm; + s/\xc2\x61/á/gm; + s/\xc2\x65/é/gm; + s/\xc2\x69/í/gm; + s/\xc2\x6f/ó/gm; + s/\xc2\x75/ú/gm; + s/\xc2\x79/ý/gm; + s/\xc3\x41/Â/gm; + s/\xc3\x45/Ê/gm; + s/\xc3\x49/Î/gm; + s/\xc3\x4f/Ô/gm; + s/\xc3\x55/Û/gm; + s/\xc3\x61/â/gm; + s/\xc3\x65/ê/gm; + s/\xc3\x69/î/gm; + s/\xc3\x6f/ô/gm; + s/\xc3\x75/û/gm; + s/\xc4\x41/Ã/gm; + s/\xc4\x4e/Ñ/gm; + s/\xc4\x4f/Õ/gm; + s/\xc4\x61/ã/gm; + s/\xc4\x6e/ñ/gm; + s/\xc4\x6f/õ/gm; + s/\xc8\x45/Ë/gm; + s/\xc8\x49/Ï/gm; + s/\xc8\x65/ë/gm; + s/\xc8\x69/ï/gm; + s/\xc8\x76/ÿ/gm; + s/\xc9\x41/Ä/gm; + s/\xc9\x4f/Ö/gm; + s/\xc9\x55/Ü/gm; + s/\xc9\x61/ä/gm; + s/\xc9\x6f/ö/gm; + s/\xc9\x75/ü/gm; + s/\xca\x41/Å/gm; + s/\xca\x61/å/gm; + s/\xd0\x43/Ç/gm; + s/\xd0\x63/ç/gm; + + # this handles non-sorting blocks (if implementation requires this) + $string = nsb_clean($_); + } + elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) { + if (/[\xc1-\xff]/) { + s/\xe1\x61/à/gm; + s/\xe1\x65/è/gm; + s/\xe1\x69/ì/gm; + s/\xe1\x6f/ò/gm; + s/\xe1\x75/ù/gm; + s/\xe1\x41/À/gm; + s/\xe1\x45/È/gm; + s/\xe1\x49/Ì/gm; + s/\xe1\x4f/Ò/gm; + s/\xe1\x55/Ù/gm; + s/\xe2\x41/Á/gm; + s/\xe2\x45/É/gm; + s/\xe2\x49/Í/gm; + s/\xe2\x4f/Ó/gm; + s/\xe2\x55/Ú/gm; + s/\xe2\x59/Ý/gm; + s/\xe2\x61/á/gm; + s/\xe2\x65/é/gm; + s/\xe2\x69/í/gm; + s/\xe2\x6f/ó/gm; + s/\xe2\x75/ú/gm; + s/\xe2\x79/ý/gm; + s/\xe3\x41/Â/gm; + s/\xe3\x45/Ê/gm; + s/\xe3\x49/Î/gm; + s/\xe3\x4f/Ô/gm; + s/\xe3\x55/Û/gm; + s/\xe3\x61/â/gm; + s/\xe3\x65/ê/gm; + s/\xe3\x69/î/gm; + s/\xe3\x6f/ô/gm; + s/\xe3\x75/û/gm; + s/\xe4\x41/Ã/gm; + s/\xe4\x4e/Ñ/gm; + s/\xe4\x4f/Õ/gm; + s/\xe4\x61/ã/gm; + s/\xe4\x6e/ñ/gm; + s/\xe4\x6f/õ/gm; + s/\xe8\x45/Ë/gm; + s/\xe8\x49/Ï/gm; + s/\xe8\x65/ë/gm; + s/\xe8\x69/ï/gm; + s/\xe8\x76/ÿ/gm; + s/\xe9\x41/Ä/gm; + s/\xe9\x4f/Ö/gm; + s/\xe9\x55/Ü/gm; + s/\xe9\x61/ä/gm; + s/\xe9\x6f/ö/gm; + s/\xe9\x75/ü/gm; + s/\xea\x41/Å/gm; + s/\xea\x61/å/gm; + + # this handles non-sorting blocks (if implementation requires this) + $string = nsb_clean($_); + } + } + return ($string); } sub nsb_clean { - my $NSB = '\x88' ; # NSB : begin Non Sorting Block - my $NSE = '\x89' ; # NSE : Non Sorting Block end - # handles non sorting blocks - my ($string) = @_ ; - $_ = $string ; - s/$NSB/(/gm ; - s/[ ]{0,1}$NSE/) /gm ; - $string = $_ ; - return($string) ; + my $NSB = '\x88'; # NSB : begin Non Sorting Block + my $NSE = '\x89'; # NSE : Non Sorting Block end + # handles non sorting blocks + my ($string) = @_; + $_ = $string; + s/$NSB/(/gm; + s/[ ]{0,1}$NSE/) /gm; + $string = $_; + return ($string); } -END { } # module clean-up code here (global destructor) +END { } # module clean-up code here (global destructor) =back @@ -2191,6 +2673,10 @@ Paul POULAIN paul.poulain@free.fr # $Id$ # $Log$ +# Revision 1.95 2004/06/26 23:19:59 rangi +# Fixing modaddauthor, and adding getitemtypes. +# Also tidying up formatting of code +# # Revision 1.94 2004/06/17 08:16:32 tipaul # merging tag & subfield in marc_word for better perfs #