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
+ &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
+ &MARCfind_oldbiblionumber_from_MARCbibid
+ &MARCfind_MARCbibid_from_oldbiblionumber
+ &MARCfind_marc_from_kohafield
+ &MARCfindsubfield
+ &MARCfind_frameworkcode
+ &MARCgettagslib
- &NEWnewbiblio &NEWnewitem
- &NEWmodbiblio &NEWmoditem
- &NEWdelbiblio &NEWdelitem
+ &NEWnewbiblio &NEWnewitem
+ &NEWmodbiblio &NEWmoditem
+ &NEWdelbiblio &NEWdelitem
- &MARCaddbiblio &MARCadditem
- &MARCmodsubfield &MARCaddsubfield
- &MARCmodbiblio &MARCmoditem
- &MARCkoha2marcBiblio &MARCmarc2koha
- &MARCkoha2marcItem &MARChtml2marc
- &MARCgetbiblio &MARCgetitem
- &MARCaddword &MARCdelword
- &char_decode
- );
+ &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;
- }
+ my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
+ $frameworkcode = "" unless $frameworkcode;
+ my $sth;
+ my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
- $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);
+ # 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 );
- 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;
+ 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);
+ $query .= " and subfieldvalue=?";
+ push ( @bind_values, $subfieldvalue );
}
- my $sti=$dbh->prepare($query);
+ 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;
- } else {
- return $lastsubfieldid;
+ 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;
}
}
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 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 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});
- }
- }
+ "
+ );
+ $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'} );
}
- # 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;
+ my ( $dbh, $biblio ) = @_;
- 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'});
+ # 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;
- $sth->finish;
-# $dbh->disconnect;
- return($bibnum);
+ 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 ) = @_;
- $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'});
+ # my $dbh = C4Connect;
+ my $query;
+ my $sth;
- $sth->finish;
- return($biblio->{'biblionumber'});
-} # sub modbiblio
+ $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
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->finish;
- } # if
-} # sub modaddauthor
+ $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]);
+ my ( $dbh, $bibnum, $force, @subject ) = @_;
- 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',?)");
+ # 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] );
- $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
+ if ( my $data = $sth->fetchrow_hashref ) {
+ }
+ else {
+ if ( $force eq $subject[$i] || $force == 1 ) {
- # $dbh->disconnect;
- return($error);
-} # sub modsubject
+ # 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
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 ) = @_;
- $sth->execute;
- $data = $sth->fetchrow_arrayref;
- $bibitemnum = $$data[0] + 1;
+ # my $dbh = C4Connect;
+ my $sth = $dbh->prepare("Select max(biblioitemnumber) from biblioitems");
+ my $data;
+ my $bibitemnum;
- $sth->finish;
+ $sth->execute;
+ $data = $sth->fetchrow_arrayref;
+ $bibitemnum = $$data[0] + 1;
- $sth = $dbh->prepare("insert into biblioitems set
+ $sth->finish;
+
+ $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;
-}
-
-sub OLDnewsubtitle {
- my ($dbh,$bibnum, $subtitle) = @_;
- my $sth = $dbh->prepare("insert into bibliosubtitle set biblionumber = ?, subtitle = ?");
- $sth->execute($bibnum,$subtitle);
+ 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 );
+ $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 = "";
+ 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;
- $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(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)");
+ 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 = ?");
+ $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]";
+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);
+ $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
+ $count++;
+ } # while
$sth->finish;
- return($count, @results);
-} # sub
+ 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
+
+ $sth->finish;
+ 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
+
+ # || 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
-
+ 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;
- #-----
- $dbh = C4::Context->dbh;
+ my $debug = 0;
+ my $sth;
+ my $error;
- print "Looking for biblio
\n" if $debug;
- $sth=$dbh->prepare("select biblionumber
+ #-----
+ $dbh = C4::Context->dbh;
+
+ 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
- }
+ 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 {
- return $biblionumber,$error;
+ # 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
+ }
-} # sub getoraddbiblio
+ 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
#