package C4::Biblio;
+
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
$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
- &getitemtypes &getbiblio
- &getbiblioitembybiblionumber
- &getbiblioitem &getitemsbybiblioitem
- &skip
- &newcompletebiblioitem
-
- &MARCfind_oldbiblionumber_from_MARCbibid
- &MARCfind_MARCbibid_from_oldbiblionumber
- &MARCfind_marc_from_kohafield
- &MARCfindsubfield
- &MARCgettagslib
-
- &NEWnewbiblio &NEWnewitem
- &NEWmodbiblio &NEWmoditem
- &NEWdelbiblio &NEWdelitem
-
- &MARCaddbiblio &MARCadditem
- &MARCmodsubfield &MARCaddsubfield
- &MARCmodbiblio &MARCmoditem
- &MARCkoha2marcBiblio &MARCmarc2koha
- &MARCkoha2marcItem &MARChtml2marc
- &MARCgetbiblio &MARCgetitem
- &MARCaddword &MARCdelword
- &char_decode
- );
+ &updateBiblio &updateBiblioItem &updateItem
+ &itemcount &newbiblio &newbiblioitem
+ &modnote &newsubject &newsubtitle
+ &modbiblio &checkitems
+ &newitems &modbibitem
+ &modsubtitle &modsubject &modaddauthor &moditem &countitems
+ &delitem &deletebiblioitem &delbiblio
+ &getbiblio
+ &getbiblioitembybiblionumber
+ &getbiblioitem &getitemsbybiblioitem
+ &skip &getitemtypes
+ &newcompletebiblioitem
+
+ &MARCfind_oldbiblionumber_from_MARCbibid
+ &MARCfind_MARCbibid_from_oldbiblionumber
+ &MARCfind_marc_from_kohafield
+ &MARCfindsubfield
+ &MARCfind_frameworkcode
+ &MARCgettagslib
+
+ &NEWnewbiblio &NEWnewitem
+ &NEWmodbiblio &NEWmoditem
+ &NEWdelbiblio &NEWdelitem
+ &NEWmodbiblioframework
+
+ &MARCaddbiblio &MARCadditem
+ &MARCmodsubfield &MARCaddsubfield
+ &MARCmodbiblio &MARCmoditem
+ &MARCkoha2marcBiblio &MARCmarc2koha
+ &MARCkoha2marcItem &MARChtml2marc
+ &MARCgetbiblio &MARCgetitem
+ &MARCaddword &MARCdelword
+ &MARCdelsubfield
+ &char_decode
+
+ &FindDuplicate
+ &DisplayISBN
+);
#
#
=over 4
-=item @tagslib = &MARCgettagslib($dbh,1|0);
+=item @tagslib = &MARCgettagslib($dbh,1|0,$itemtype);
last param is 1 for liblibrarian and 0 for libopac
+$itemtype contains the itemtype framework reference. If empty or does not exist, the default one is used
returns a hash with tag/subfield meaning
=item ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield);
Returns a MARC::Record for the biblio $bibid.
-=item &MARCmodbiblio($dbh,$bibid,$record,$delete);
+=item &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,$delete);
MARCmodbiblio changes a biblio for a biblio,MARC::Record passed as parameter
It 1st delete the biblio, then recreates it.
=item &MARCdelsubfield($dbh,$bibid,$tag,$tagorder,$subfield,$subfieldorder);
MARCdelsubfield delete a subfield for a bibid/tag/tagorder/subfield/subfieldorder
+If $subfieldorder is not set, delete all the $tag$subfield subfields
=item &MARCdelbiblio($dbh,$bibid);
=cut
sub MARCgettagslib {
- my ($dbh,$forlibrarian)= @_;
- my $sth;
- my $libfield = ($forlibrarian eq 1)? 'liblibrarian' : 'libopac';
- $sth=$dbh->prepare("select tagfield,$libfield as lib,mandatory from marc_tag_structure order by tagfield");
- $sth->execute;
- my ($lib,$tag,$res,$tab,$mandatory,$repeatable);
- while ( ($tag,$lib,$mandatory) = $sth->fetchrow) {
- $res->{$tag}->{lib}=$lib;
- $res->{$tab}->{tab}=""; # XXX
- $res->{$tag}->{mandatory}=$mandatory;
- }
+ 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,liblibrarian,libopac,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield"
+ );
+ $sth->execute($frameworkcode);
+ my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
+
+ while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
+ $res->{$tag}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
+ $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,thesaurus_category,value_builder,kohafield from marc_subfield_structure order by tagfield,tagsubfield");
- $sth->execute;
-
- my $subfield;
- my $authorised_value;
- my $thesaurus_category;
- my $value_builder;
- my $kohafield;
- while ( ($tag, $subfield, $lib, $tab, $mandatory, $repeatable,$authorised_value,$thesaurus_category,$value_builder,$kohafield) = $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}->{thesaurus_category}=$thesaurus_category;
- $res->{$tag}->{$subfield}->{value_builder}=$value_builder;
- $res->{$tag}->{$subfield}->{kohafield}=$kohafield;
- }
- return $res;
+ $sth =
+ $dbh->prepare(
+"select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link 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;
+ my $link;
+
+ while (
+ ( $tag, $subfield, $liblibrarian, , $libopac, $tab,
+ $mandatory, $repeatable, $authorised_value, $authtypecode,
+ $value_builder, $kohafield, $seealso, $hidden,
+ $isurl, $link )
+ = $sth->fetchrow
+ )
+ {
+ $res->{$tag}->{$subfield}->{lib} = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
+ $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;
+ $res->{$tag}->{$subfield}->{link} = $link;
+ }
+ return $res;
}
sub MARCfind_marc_from_kohafield {
- my ($dbh,$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 ( $dbh, $kohafield,$frameworkcode ) = @_;
+ return 0, 0 unless $kohafield;
+ my $relations = C4::Context->marcfromkohafield;
+ return ($relations->{$frameworkcode}->{$kohafield}->[0],$relations->{$frameworkcode}->{$kohafield}->[1]);
}
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,$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) values (now(),?)");
- $sth->execute($biblionumber);
- $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 $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
+ )
+ = @_;
+ return unless $subfieldvalues;
+# warn "$tagid / $subfieldcode / $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
+# warn "". $bidid;
+
+ #---- 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 ($dbh,$bibid,$record,$frameworkcode,$delete)=@_;
my $oldrecord=&MARCgetbiblio($dbh,$bibid);
if ($oldrecord eq $record) {
return;
# 2nd recreate it
my $biblionumber = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
&MARCdelbiblio($dbh,$bibid,1);
- &MARCaddbiblio($dbh,$record,$biblionumber,$bibid);
+ &MARCaddbiblio($dbh,$record,$biblionumber,$frameworkcode,$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 tag<>$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...
-# 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 {
-# 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);
-# warn "changing : $subfieldid, $bibid,".$field->tag(),",$tagorder,@$subfield[0],@$subfield[1],$subfieldorder";
- &MARCmodsubfield($dbh,$subfieldid,@$subfield[1]);
- }
- }
- }
- }
+ my $biblionumber = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
+ &MARCdelitem($dbh,$bibid,$itemnumber);
+ &MARCadditem($dbh,$record,$biblionumber);
}
-
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=$res where subfieldid=?");
- $sth->execute($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 $query =
+"select subfieldid from marc_subfield_table where bibid=? and tag=? and subfieldcode=?";
+ my @bind_values = ( $bibid, $tag, $subfieldcode );
if ($subfieldvalue) {
- $query .= " and subfieldvalue=".$dbh->quote($subfieldvalue);
- } else {
- if ($subfieldorder<1) {
- $subfieldorder=1;
- }
- $query .= " and subfieldorder=$subfieldorder";
+ $query .= " and subfieldvalue=?";
+ push ( @bind_values, $subfieldvalue );
}
- my $sti=$dbh->prepare($query);
- $sti->execute($bibid,$tag, $subfieldcode);
- while (($subfieldid) = $sti->fetchrow) {
- $resultcounter++;
- $lastsubfieldid=$subfieldid;
+ else {
+ if ( $subfieldorder < 1 ) {
+ $subfieldorder = 1;
+ }
+ $query .= " and subfieldorder=?";
+ push ( @bind_values, $subfieldorder );
}
- 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;
+ my $sti = $dbh->prepare($query);
+ $sti->execute(@bind_values);
+ 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;
}
}
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;
+}
+
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
- tag='$tag' and tagorder='$tagorder'
- and subfieldcode='$subfield' and subfieldorder='$subfieldorder
- ");
+
+ # delete a subfield for $bibid / tag / tagorder / subfield / subfieldorder
+ my ( $dbh, $bibid, $tag, $tagorder, $subfield, $subfieldorder ) = @_;
+ if ($subfieldorder) {
+ $dbh->do( "delete from marc_subfield_table where bibid='$bibid' and
+ tag='$tag' and tagorder='$tagorder'
+ and subfieldcode='$subfield' and subfieldorder='$subfieldorder'
+ "
+ );
+ $dbh->do( "delete from marc_word where bibid='$bibid' and
+ tagsubfield='$tag$subfield' and tagorder='$tagorder'
+ and subfieldorder='$subfieldorder'
+ "
+ );
+ } else {
+ $dbh->do( "delete from marc_subfield_table where bibid='$bibid' and
+ tag='$tag' and tagorder='$tagorder'
+ and subfieldcode='$subfield'"
+ );
+ $dbh->do( "delete from marc_word where bibid='$bibid' and
+ tagsubfield='$tag$subfield' and tagorder='$tagorder'"
+ );
+ }
}
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 frameworkcode=? and 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'},'' );
+ }
+ $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'},'' );
+ }
+ $sth2 =
+ $dbh->prepare(
+ " SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?");
+ $sth2->execute($biblionumber);
+ while ( my $row = $sth2->fetchrow_hashref ) {
+ &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle",
+ $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 frameworkcode=? and 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,bulk,issues,renewals,
+ 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 frameworkcode=? and 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,$frameworkcode ) = @_;
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);
- }
+ $sth->execute($frameworkcode,$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 );
+ }
}
return $record;
}
my $field; # if tag >=10
for (my $i=0; $i< @$rtags; $i++) {
# rebuild MARC::Record
+# warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
if (@$rtags[$i] ne $prevtag) {
if ($prevtag < 10) {
if ($prevvalue) {
$indicators{@$rtags[$i]}.=' ';
if (@$rtags[$i] <10) {
$prevvalue= @$rvalues[$i];
+ undef $field;
} else {
+ undef $prevvalue;
$field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
+# warn "1=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
}
$prevtag = @$rtags[$i];
} else {
if (@$rtags[$i] <10) {
$prevvalue=@$rvalues[$i];
} else {
- if (@$rvalues[$i]) {
+ if (length(@$rvalues[$i])>0) {
$field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
+# warn "2=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
}
}
$prevtag= @$rtags[$i];
}
}
# the last has not been included inside the loop... do it now !
- $record->add_fields($field);
-# warn $record->as_formatted;
+ $record->add_fields($field) if $field;
+# warn "HTML2MARC=".$record->as_formatted;
return $record;
}
sub MARCmarc2koha {
- my ($dbh,$record) = @_;
- my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where kohafield=?");
+ my ($dbh,$record,$frameworkcode) = @_;
+ my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and 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);
+ $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result,$frameworkcode);
}
$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);
+ $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result,$frameworkcode);
}
$sth2=$dbh->prepare("SHOW COLUMNS from items");
$sth2->execute;
while (($field)=$sth2->fetchrow) {
- $result = &MARCmarc2kohaOneField($sth,"items",$field,$record,$result);
+ $result=&MARCmarc2kohaOneField($sth,"items",$field,$record,$result,$frameworkcode);
}
# additional authors : specific
- $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result);
- $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result);
+ $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result,$frameworkcode);
+ $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result,$frameworkcode);
# modify copyrightdate to keep only the 1st year found
my $temp = $result->{'copyrightdate'};
$temp =~ m/c(\d\d\d\d)/; # search cYYYY first
$result->{'copyrightdate'} = $1;
}
# modify publicationyear to keep only the 1st year found
- my $temp = $result->{'publicationyear'};
+ $temp = $result->{'publicationyear'};
$temp =~ m/c(\d\d\d\d)/; # search cYYYY first
if ($1>0) {
$result->{'publicationyear'} = $1;
}
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,$frameworkcode ) = @_;
+ # warn "kohatable / $kohafield / $result / ";
+ my $res = "";
+ my $tagfield;
+ my $subfield;
+ ( $tagfield, $subfield ) = MARCfind_marc_from_kohafield("",$kohatable.".".$kohafield,$frameworkcode);
+ foreach my $field ( $record->field($tagfield) ) {
+ if ( $field->subfields ) {
+ my @subfields = $field->subfields();
+ foreach my $subfieldcount ( 0 .. $#subfields ) {
+ if ($subfields[$subfieldcount][0] eq $subfield) {
+ if ( $result->{$kohafield} ) {
+ $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
+ }
+ else {
+ $result->{$kohafield} = $subfields[$subfieldcount][1];
+ }
+ }
+ }
+ }
+ }
+# warn "OneField for $kohatable.$kohafield and $frameworkcode=> $tagfield, $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) =@_;
- $sentence =~ s/(\.|\?|\:|\!|\'|,|\-|\"|\(|\)|\[|\]|\{|\})/ /g;
- my @words = split / /,$sentence;
- my $stopwords= C4::Context->stopwords;
- my $sth=$dbh->prepare("insert into marc_word (bibid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word)
- values (?,?,?,?,?,?,soundex(?))");
+
+ # 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(?))"
+ );
foreach my $word (@words) {
-# we record only words longer than 2 car and not in stopwords hash
- if (length($word)>2 and !($stopwords->{uc($word)})) {
- $sth->execute($bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,$word);
+# we record only words one char long and not in stopwords hash
+ if (length($word)>=1 and !($stopwords->{uc($word)})) {
+ $sth->execute($bibid,$tag,$subfieldid,$tagorder,$subfieldorder,$word,$word);
if ($sth->err()) {
- warn "ERROR ==> insert into marc_word (bibid, tag, tagorder, subfieldid, subfieldorder, word, sndx_word) values ($bibid,$tag,$tagorder,$subfieldid,$subfieldorder,$word,soundex($word))\n";
+ 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 tag=? and tagorder=? and subfieldid=? and subfieldorder=?");
- $sth->execute($bibid,$tag,$tagorder,$subfield,$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 );
}
#
# 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
=cut
sub NEWnewbiblio {
- my ($dbh, $record, $oldbiblio, $oldbiblioitem) = @_;
- # note $oldbiblio and $oldbiblioitem are not mandatory.
- # if not present, they will be builded from $record with MARCmarc2koha function
- if (($oldbiblio) and not($oldbiblioitem)) {
- print STDERR "NEWnewbiblio : missing parameter\n";
- print "NEWnewbiblio : missing parameter : contact koha development team\n";
- die;
- }
- my $oldbibnum;
- my $oldbibitemnum;
- if ($oldbiblio) {
- $oldbibnum = OLDnewbiblio($dbh,$oldbiblio);
- $oldbiblioitem->{'biblionumber'} = $oldbibnum;
- $oldbibitemnum = OLDnewbiblioitem($dbh,$oldbiblioitem);
- } else {
- 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);
- return ($bibid,$oldbibnum,$oldbibitemnum );
+ my ( $dbh, $record, $frameworkcode ) = @_;
+ my $oldbibnum;
+ my $oldbibitemnum;
+ my $olddata = MARCmarc2koha( $dbh, $record,$frameworkcode );
+ $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",$frameworkcode );
+ 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.subtitle",$frameworkcode );
+ 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",$frameworkcode );
+ 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 NEWmodbiblioframework {
+ my ($dbh,$bibid,$frameworkcode) =@_;
+ my $sth = $dbh->prepare("Update marc_biblio SET frameworkcode=? WHERE bibid=$bibid");
+ $sth->execute($frameworkcode);
+ return 1;
+}
sub NEWmodbiblio {
- my ($dbh,$record,$bibid) =@_;
- &MARCmodbiblio($dbh,$bibid,$record,0);
- my $oldbiblio = MARCmarc2koha($dbh,$record);
+ my ($dbh,$record,$bibid,$frameworkcode) =@_;
+ $frameworkcode="" unless $frameworkcode;
+ &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,0);
+ my $oldbiblio = MARCmarc2koha($dbh,$record,$frameworkcode);
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 ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author",$frameworkcode);
my @addiauthfields = $record->field($tagfield);
foreach my $addiauthfield (@addiauthfields) {
my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
OLDmodaddauthor($dbh,$oldbiblionumber,$addiauthsubfields[$subfieldcount]);
}
}
- ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle");
+ ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle",$frameworkcode);
my @subtitlefields = $record->field($tagfield);
foreach my $subtitlefield (@subtitlefields) {
my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
+ # delete & create subtitle again because OLDmodsubtitle can't handle new subtitles
+ # between 2 modifs
+ $dbh->do("delete from bibliosubtitle where biblionumber=$oldbiblionumber");
foreach my $subfieldcount (0..$#subtitlesubfields) {
- OLDmodsubtitle($dbh,$oldbiblionumber,$subtitlesubfields[$subfieldcount]);
+ foreach my $subtit(split /\||#/,$subtitlesubfields[$subfieldcount]) {
+ OLDnewsubtitle($dbh,$oldbiblionumber,$subtit);
+ }
}
}
- ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject");
+ ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject",$frameworkcode);
my @subj = $record->field($tagfield);
my @subjects;
foreach my $subject (@subj) {
}
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 $frameworkcode=MARCfind_frameworkcode($dbh,$bibid);
+ my $item = &MARCmarc2koha( $dbh, $record,$frameworkcode );
+ # 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.
+ $sth =
+ $dbh->prepare(
+"select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
+ );
+ &MARCkoha2marcOnefield( $sth, $record, "items.itemnumber", $itemnumber,$frameworkcode );
+
+ # 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 $frameworkcode=MARCfind_frameworkcode($dbh,$bibid);
+ my $olditem = MARCmarc2koha( $dbh, $record,$frameworkcode );
+ 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 );
}
#
=cut
sub OLDnewbiblio {
- my ($dbh,$biblio) = @_;
-# my $dbh = &C4Connect;
- my $query = "Select max(biblionumber) from biblio";
- my $sth = $dbh->prepare($query);
- $sth->execute;
- my $data = $sth->fetchrow_arrayref;
- my $bibnum = $$data[0] + 1;
- my $series = 0;
-
- if ($biblio->{'seriestitle'}) { $series = 1 };
- $sth->finish;
- $query = "insert into biblio set biblionumber = ?, title = ?, author = ?, copyrightdate = ?,
- serial = ?, seriestitle = ?, notes = ?, abstract = ?";
- $sth = $dbh->prepare($query);
- $sth->execute($bibnum,$biblio->{'title'},$biblio->{'author'},$biblio->{'copyrightdate'},$series,$biblio->{'seriestitle'},$biblio->{'notes'},$biblio->{'abstract'});
-
- $sth->finish;
-# $dbh->disconnect;
- return($bibnum);
+ my ( $dbh, $biblio ) = @_;
+
+ # my $dbh = &C4Connect;
+ my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
+ $sth->execute;
+ my $data = $sth->fetchrow_arrayref;
+ my $bibnum = $$data[0] + 1;
+ my $series = 0;
+
+ if ( $biblio->{'seriestitle'} ) { $series = 1 }
+ $sth->finish;
+ $sth =
+ $dbh->prepare(
+"insert into biblio set biblionumber = ?, title = ?, author = ?, copyrightdate = ?, serial = ?, seriestitle = ?, notes = ?, abstract = ?, unititle = ?"
+ );
+ $sth->execute(
+ $bibnum, $biblio->{'title'},
+ $biblio->{'author'}, $biblio->{'copyrightdate'},
+ $biblio->{'serial'}, $biblio->{'seriestitle'},
+ $biblio->{'notes'}, $biblio->{'abstract'},
+ $biblio->{'unititle'},
+ );
+
+ $sth->finish;
+
+ # $dbh->disconnect;
+ return ($bibnum);
}
sub OLDmodbiblio {
- my ($dbh,$biblio) = @_;
- # my $dbh = C4Connect;
- my $query;
- my $sth;
+ my ( $dbh, $biblio ) = @_;
- $query = "Update biblio set title = ?, author = ?, abstract = ?, copyrightdate = ?,
- seriestitle = ?, serial = ?, unititle = ?, notes = ? where biblionumber = ?";
- $sth = $dbh->prepare($query);
- $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'}
+ );
-sub OLDmodsubtitle {
- my ($dbh,$bibnum, $subtitle) = @_;
- my $query = "update bibliosubtitle set subtitle = ? where biblionumber = ?";
- my $sth = $dbh->prepare($query);
- $sth->execute($subtitle,$bibnum);
- $sth->finish;
-} # sub modsubtitle
+ $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
sub OLDmodaddauthor {
- my ($dbh,$bibnum, $author) = @_;
-# my $dbh = C4Connect;
- my $query = "Delete from additionalauthors where biblionumber = $bibnum";
- my $sth = $dbh->prepare($query);
+ my ( $dbh, $bibnum, @authors ) = @_;
- $sth->execute;
+ # 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 '') {
- $query = "Insert into additionalauthors set
- author = ?,
- biblionumber = ?";
- $sth = $dbh->prepare($query);
+ $sth->execute( $author, $bibnum );
- $sth->execute($author,$bibnum);
+ $sth->finish;
+ } # if
+ }
+} # sub modaddauthor
+sub OLDmodsubject {
+ my ( $dbh, $bibnum, $force, @subject ) = @_;
+
+ # my $dbh = C4Connect;
+ my $count = @subject;
+ my $error;
+ for ( my $i = 0 ; $i < $count ; $i++ ) {
+ $subject[$i] =~ s/^ //g;
+ $subject[$i] =~ s/ $//g;
+ my $sth =
+ $dbh->prepare(
+"select * from catalogueentry where entrytype = 's' and catalogueentry = ?"
+ );
+ $sth->execute( $subject[$i] );
+
+ if ( my $data = $sth->fetchrow_hashref ) {
+ }
+ else {
+ if ( $force eq $subject[$i] || $force == 1 ) {
+
+ # subject not in aut, chosen to force anway
+ # so insert into cataloguentry so its in auth file
+ my $sth2 =
+ $dbh->prepare(
+"Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)"
+ );
+
+ $sth2->execute( $subject[$i] ) if ( $subject[$i] );
+ $sth2->finish;
+ }
+ else {
+ $error =
+ "$subject[$i]\n does not exist in the subject authority file";
+ my $sth2 =
+ $dbh->prepare(
+"Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)"
+ );
+ $sth2->execute( "$subject[$i] %", "% $subject[$i] %",
+ "% $subject[$i]" );
+ while ( my $data = $sth2->fetchrow_hashref ) {
+ $error .= "<br>$data->{'catalogueentry'}";
+ } # while
+ $sth2->finish;
+ } # else
+ } # else
$sth->finish;
- } # if
-} # sub modaddauthor
-
+ } # else
+ if ( $error eq '' ) {
+ my $sth =
+ $dbh->prepare("Delete from bibliosubject where biblionumber = ?");
+ $sth->execute($bibnum);
+ $sth->finish;
+ $sth =
+ $dbh->prepare(
+ "Insert into bibliosubject (subject,biblionumber) values (?,?)");
+ my $query;
+ foreach $query (@subject) {
+ $sth->execute( $query, $bibnum ) if ( $query && $bibnum );
+ } # foreach
+ $sth->finish;
+ } # if
-sub OLDmodsubject {
- my ($dbh,$bibnum, $force, @subject) = @_;
- # my $dbh = C4Connect;
- my $count = @subject;
- my $error;
- for (my $i = 0; $i < $count; $i++) {
- $subject[$i] =~ s/^ //g;
- $subject[$i] =~ s/ $//g;
- my $query = "select * from catalogueentry where entrytype = 's' and catalogueentry = '$subject[$i]'";
- my $sth = $dbh->prepare($query);
- $sth->execute;
-
- 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
- $query = "Insert into catalogueentry (entrytype,catalogueentry) values ('s','$subject[$i]')";
- my $sth2 = $dbh->prepare($query);
-
- $sth2->execute;
- $sth2->finish;
- } else {
- $error = "$subject[$i]\n does not exist in the subject authority file";
- $query = "Select * from catalogueentry where entrytype = 's' and (catalogueentry like '$subject[$i] %'
- or catalogueentry like '% $subject[$i] %' or catalogueentry like '% $subject[$i]')";
- my $sth2 = $dbh->prepare($query);
- $sth2->execute;
- while (my $data = $sth2->fetchrow_hashref) {
- $error .= "<br>$data->{'catalogueentry'}";
- } # while
- $sth2->finish;
- } # else
- } # else
- $sth->finish;
- } # else
- if ($error eq '') {
- my $query = "Delete from bibliosubject where biblionumber = $bibnum";
- my $sth = $dbh->prepare($query);
- $sth->execute;
- $sth->finish;
- $sth = $dbh->prepare("Insert into bibliosubject values (?,?)");
- foreach $query (@subject) {
- $sth->execute($query,$bibnum);
- } # foreach
- $sth->finish;
- } # if
-
- # $dbh->disconnect;
- return($error);
-} # sub modsubject
+ # $dbh->disconnect;
+ return ($error);
+} # sub modsubject
sub OLDmodbibitem {
- my ($dbh,$biblioitem) = @_;
-# my $dbh = C4Connect;
+ my ( $dbh, $biblioitem ) = @_;
my $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->{'issn'} = $dbh->quote( $biblioitem->{'issn'} );
+ $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'},
url = $biblioitem->{'url'},
isbn = $biblioitem->{'isbn'},
+issn = $biblioitem->{'issn'},
publishercode = $biblioitem->{'publishercode'},
publicationyear = $biblioitem->{'publicationyear'},
classification = $biblioitem->{'classification'},
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";
+ }
+} # 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 $query = "Select max(biblioitemnumber) from biblioitems";
- my $sth = $dbh->prepare($query);
- my $data;
- my $bibitemnum;
+ my ( $dbh, $biblioitem ) = @_;
+
+ # my $dbh = C4Connect;
+ my $sth = $dbh->prepare("Select max(biblioitemnumber) from biblioitems");
+ my $data;
+ my $bibitemnum;
- $sth->execute;
- $data = $sth->fetchrow_arrayref;
- $bibitemnum = $$data[0] + 1;
+ $sth->execute;
+ $data = $sth->fetchrow_arrayref;
+ $bibitemnum = $$data[0] + 1;
- $sth->finish;
+ $sth->finish;
- $sth = $dbh->prepare("insert into biblioitems set
+ $sth = $dbh->prepare( "insert into biblioitems set
biblioitemnumber = ?, biblionumber = ?,
volume = ?, number = ?,
classification = ?, itemtype = ?,
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 $query="insert into bibliosubject (biblionumber) values ($bibnum)";
- my $sth=$dbh->prepare($query);
- $sth->execute;
- $sth->finish;
+ my ( $dbh, $bibnum ) = @_;
+ my $sth =
+ $dbh->prepare("insert into bibliosubject (biblionumber) values (?)");
+ $sth->execute($bibnum);
+ $sth->finish;
}
sub OLDnewsubtitle {
- my ($dbh,$bibnum, $subtitle) = @_;
- my $query = "insert into bibliosubtitle set biblionumber = ?, subtitle = ?";
- my $sth = $dbh->prepare($query);
- $sth->execute($bibnum,$subtitle);
+ my ( $dbh, $bibnum, $subtitle ) = @_;
+ my $sth =
+ $dbh->prepare(
+ "insert into bibliosubtitle set biblionumber = ?, subtitle = ?");
+ $sth->execute( $bibnum, $subtitle ) if $subtitle;
$sth->finish;
}
-
sub OLDnewitems {
- my ($dbh,$item, $barcode) = @_;
- # my $dbh = C4Connect;
- my $query = "Select max(itemnumber) from items";
- my $sth = $dbh->prepare($query);
- my $data;
- my $itemnumber;
- my $error = "";
-
- $sth->execute;
- $data = $sth->fetchrow_hashref;
- $itemnumber = $data->{'max(itemnumber)'} + 1;
- $sth->finish;
+ my ( $dbh, $item, $barcode ) = @_;
+
+ # my $dbh = C4Connect;
+ my $sth = $dbh->prepare("Select max(itemnumber) from items");
+ my $data;
+ my $itemnumber;
+ my $error = "";
+
+ $sth->execute;
+ $data = $sth->fetchrow_hashref;
+ $itemnumber = $data->{'max(itemnumber)'} + 1;
+ $sth->finish;
+
# FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
- if ($item->{'loan'}) {
- $item->{'notforloan'} = $item->{'loan'};
- }
-# if dateaccessioned is provided, use it. Otherwise, set to NOW()
- if ($item->{'dateaccessioned'}) {
- $sth=$dbh->prepare("Insert into items set
+ if ( $item->{'loan'} ) {
+ $item->{'notforloan'} = $item->{'loan'};
+ }
+
+ # if dateaccessioned is provided, use it. Otherwise, set to NOW()
+ if ( $item->{'dateaccessioned'} ) {
+ $sth = $dbh->prepare( "Insert into items set
itemnumber = ?, biblionumber = ?,
biblioitemnumber = ?, barcode = ?,
booksellerid = ?, dateaccessioned = ?,
homebranch = ?, holdingbranch = ?,
price = ?, replacementprice = ?,
replacementpricedate = NOW(), itemnotes = ?,
- notforloan = ?
- ");
- $sth->execute($itemnumber, $item->{'biblionumber'},
- $item->{'biblioitemnumber'},$barcode,
- $item->{'booksellerid'},$item->{'dateaccessioned'},
- $item->{'homebranch'},$item->{'holdingbranch'},
- $item->{'price'},$item->{'replacementprice'},
- $item->{'itemnotes'},$item->{'notforloan'});
- } else {
- $sth=$dbh->prepare("Insert into items set
+ itemcallnumber =?, notforloan = ?,
+ location = ?
+ "
+ );
+ $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'}, $item->{'location'}
+ );
+ }
+ else {
+ $sth = $dbh->prepare( "Insert into items set
itemnumber = ?, biblionumber = ?,
biblioitemnumber = ?, barcode = ?,
booksellerid = ?, dateaccessioned = NOW(),
homebranch = ?, holdingbranch = ?,
price = ?, replacementprice = ?,
replacementpricedate = NOW(), itemnotes = ?,
- notforloan = ?
- ");
- $sth->execute($itemnumber, $item->{'biblionumber'},
- $item->{'biblioitemnumber'},$barcode,
- $item->{'booksellerid'},
- $item->{'homebranch'},$item->{'holdingbranch'},
- $item->{'price'},$item->{'replacementprice'},
- $item->{'itemnotes'},$item->{'notforloan'});
- }
- if (defined $sth->errstr) {
- $error .= $sth->errstr;
- }
- $sth->finish;
- return($itemnumber,$error);
+ itemcallnumber = ? , notforloan = ?,
+ location = ?
+ "
+ );
+ $sth->execute(
+ $itemnumber, $item->{'biblionumber'},
+ $item->{'biblioitemnumber'}, $barcode,
+ $item->{'booksellerid'}, $item->{'homebranch'},
+ $item->{'holdingbranch'}, $item->{'price'},
+ $item->{'replacementprice'}, $item->{'itemnotes'},
+ $item->{'itemcallnumber'}, $item->{'notforloan'},
+ $item->{'location'}
+ );
+ }
+ 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='$item->{'barcode'}',itemnotes='$item->{'notes'}'
- where itemnumber=$item->{'itemnum'}";
- if ($item->{'barcode'} eq ''){
- $item->{'notforloan'}=0 unless $item->{'notforloan'};
- $query="update items set notforloan=$item->{'notforloan'} where itemnumber=$item->{'itemnum'}";
- }
- if ($item->{'lost'} ne ''){
- $query="update items set biblioitemnumber=$item->{'bibitemnum'},
- barcode='$item->{'barcode'}',
- itemnotes='$item->{'notes'}',
- homebranch='$item->{'homebranch'}',
- itemlost='$item->{'lost'}',
- wthdrawn='$item->{'wthdrawn'}'
- where itemnumber=$item->{'itemnum'}";
- }
- if ($item->{'replacement'} ne ''){
- $query=~ s/ where/,replacementprice='$item->{'replacement'}' where/;
- }
- my $sth=$dbh->prepare($query);
- $sth->execute;
- $sth->finish;
-# $dbh->disconnect;
+ # my $dbh=C4Connect;
+ $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
+ my $query = "update items set barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=? where itemnumber=?";
+ my @bind = (
+ $item->{'barcode'}, $item->{'notes'},
+ $item->{'itemcallnumber'}, $item->{'notforloan'},
+ $item->{'location'}, $item->{'itemnum'}
+ );
+ if ( $item->{'lost'} ne '' ) {
+ $query = "update items set biblioitemnumber=?,
+ barcode=?,
+ itemnotes=?,
+ homebranch=?,
+ itemlost=?,
+ wthdrawn=?,
+ itemcallnumber=?,
+ notforloan=?,
+ location=?";
+ @bind = (
+ $item->{'bibitemnum'}, $item->{'barcode'},
+ $item->{'notes'}, $item->{'homebranch'},
+ $item->{'lost'}, $item->{'wthdrawn'},
+ $item->{'itemcallnumber'}, $item->{'notforloan'},
+ $item->{'location'}, $item->{'itemnum'}
+ );
+ if ($item->{homebranch}) {
+ $query.=",homebranch=?";
+ push @bind, $item->{homebranch};
+ }
+ if ($item->{holdingbranch}) {
+ $query.=",holdingbranch=?";
+ push @bind, $item->{holdingbranch};
+ }
+ $query.=" where itemnumber=?";
+ }
+ 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 $query="select * from items where itemnumber=$itemnum";
- my $sth=$dbh->prepare($query);
- $sth->execute;
- my $data=$sth->fetchrow_hashref;
- $sth->finish;
- $query="Insert into deleteditems set ";
- foreach my $temp (keys %$data){
- $query .= "$temp = ".$dbh->quote($data->{$temp}).",";
- }
- $query=~ s/\,$//;
-# print $query;
- $sth=$dbh->prepare($query);
- $sth->execute;
- $sth->finish;
- $query = "Delete from items where itemnumber=$itemnum";
- $sth=$dbh->prepare($query);
- $sth->execute;
- $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 $query = "Select * from biblioitems
-where biblioitemnumber = $biblioitemnumber";
- my $sth = $dbh->prepare($query);
+ my ( $dbh, $biblioitemnumber ) = @_;
+
+ # my $dbh = C4Connect;
+ my $sth = $dbh->prepare( "Select * from biblioitems
+where biblioitemnumber = ?"
+ );
my $results;
- $sth->execute;
+ $sth->execute($biblioitemnumber);
- if ($results = $sth->fetchrow_hashref) {
- $sth->finish;
- $sth=$dbh->prepare("Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
+ if ( $results = $sth->fetchrow_hashref ) {
+ $sth->finish;
+ $sth =
+ $dbh->prepare(
+"Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus ,
- pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)");
-
- $sth->execute($results->{biblioitemnumber}, $results->{biblionumber}, $results->{volume}, $results->{number}, $results->{classification}, $results->{itemtype},
- $results->{isbn}, $results->{issn} ,$results->{dewey} ,$results->{subclass} ,$results->{publicationyear} ,$results->{publishercode} ,$results->{volumedate} ,$results->{volumeddesc} ,$results->{timestamp} ,$results->{illus} ,
- $results->{pages} ,$results->{notes} ,$results->{size} ,$results->{url} ,$results->{lccn} );
- $query = "Delete from biblioitems
- where biblioitemnumber = $biblioitemnumber";
- $dbh->do($query);
- } # if
+ pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
+ );
+
+ $sth->execute(
+ $results->{biblioitemnumber}, $results->{biblionumber},
+ $results->{volume}, $results->{number},
+ $results->{classification}, $results->{itemtype},
+ $results->{isbn}, $results->{issn},
+ $results->{dewey}, $results->{subclass},
+ $results->{publicationyear}, $results->{publishercode},
+ $results->{volumedate}, $results->{volumeddesc},
+ $results->{timestamp}, $results->{illus},
+ $results->{pages}, $results->{notes},
+ $results->{size}, $results->{url},
+ $results->{lccn}
+ );
+ my $sth2 =
+ $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?");
+ $sth2->execute($biblioitemnumber);
+ $sth2->finish();
+ } # if
$sth->finish;
-# Now delete all the items attached to the biblioitem
- $query = "Select * from items where biblioitemnumber = $biblioitemnumber";
- $sth = $dbh->prepare($query);
- $sth->execute;
+
+ # Now delete all the items attached to the biblioitem
+ $sth = $dbh->prepare("Select * from items where biblioitemnumber = ?");
+ $sth->execute($biblioitemnumber);
my @results;
- while (@results = $sth->fetchrow_array) {
- $query = "Insert into deleteditems values (";
- foreach my $value (@results) {
- $value = $dbh->quote($value);
- $query .= "$value,";
- } # foreach
- $query =~ s/\,$/\)/;
- $dbh->do($query);
- } # while
+ 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;
- $query = "Delete from items where biblioitemnumber = $biblioitemnumber";
- $dbh->do($query);
-# $dbh->disconnect;
-} # sub deletebiblioitem
-
-sub OLDdelbiblio{
- my ($dbh,$biblio)=@_;
- my $query="select * from biblio where biblionumber=$biblio";
- my $sth=$dbh->prepare($query);
- $sth->execute;
- if (my @data=$sth->fetchrow_array){
- $sth->finish;
-# FIXME => replace insert values by insert (field) values ($value)
- $query="Insert into deletedbiblio values (";
- foreach my $temp (@data){
- $temp=~ s/\'/\\\'/g;
- $query .= "'$temp',";
+ $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;
}
- #replacing the last , by ",?)"
- $query=~ s/\,$/\,\?\)/;
- $sth=$dbh->prepare($query);
- $sth->execute;
$sth->finish;
- $query = "Delete from biblio where biblionumber=$biblio";
- $sth=$dbh->prepare($query);
- $sth->execute;
- $sth->finish;
- }
- $sth->finish;
}
#
#
#
-sub itemcount{
- my ($biblio)=@_;
- my $dbh = C4::Context->dbh;
- my $query="Select count(*) from items where biblionumber=$biblio";
-# print $query;
- my $sth=$dbh->prepare($query);
- $sth->execute;
- my $data=$sth->fetchrow_hashref;
- $sth->finish;
- return($data->{'count(*)'});
-}
-
-=item getorder
-
- ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
-
-Looks up the order with the given biblionumber and biblioitemnumber.
-
-Returns a two-element array. C<$ordernumber> is the order number.
-C<$order> is a reference-to-hash describing the order; its keys are
-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 $query="Select ordernumber
- from aqorders
- where biblionumber=? and biblioitemnumber=?";
- my $sth=$dbh->prepare($query);
- $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'});
-# print $query;
- return ($order,$ordnum->{'ordernumber'});
-}
-
-=item getsingleorder
-
- $order = &getsingleorder($ordernumber);
-
-Looks up an order by order number.
-
-Returns a reference-to-hash describing the order. The keys of
-C<$order> are fields from the biblio, biblioitems, aqorders, and
-aqorderbreakdown tables of the Koha database.
+sub itemcount {
+ my ($biblio) = @_;
+ my $dbh = C4::Context->dbh;
-=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 $query="Select * from biblio,biblioitems,aqorders,aqorderbreakdown
- where aqorders.ordernumber=?
- and biblio.biblionumber=aqorders.biblionumber and
- biblioitems.biblioitemnumber=aqorders.biblioitemnumber and
- aqorders.ordernumber=aqorderbreakdown.ordernumber";
- my $sth=$dbh->prepare($query);
- $sth->execute($ordnum);
- my $data=$sth->fetchrow_hashref;
- $sth->finish;
- return($data);
+ # 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 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
my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
# finds new (MARC bibid
my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
- MARCmodbiblio($dbh,$bibid,$record,0);
+ MARCmodbiblio($dbh,$bibid,$record,"",0);
return($biblionumber);
} # sub modbiblio
=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
=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
=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 );
+ if ($error eq ''){
+ # When MARC is off, ensures that the MARC biblio table gets updated with new
+ # subjects, of course, it deletes the biblio in marc, and then recreates.
+ # This check is to ensure that no MARC data exists to lose.
+
+ if (C4::Context->preference("MARC") eq '0'){
+ my $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibnum);
+ my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
+ &MARCmodbiblio($dbh,$bibid, $MARCRecord);
+ }
+
+ }
+ 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 $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 ($biblioitem) = @_;
+ my $dbh = C4::Context->dbh;
+ my $bibitemnum = &OLDnewbiblioitem( $dbh, $biblioitem );
+
+ 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;
- for (my $i=0;$i<$count;$i++){
- $barcodes[$i]=uc $barcodes[$i];
- my $query="Select * from items where barcode='$barcodes[$i]'";
- my $sth=$dbh->prepare($query);
- $sth->execute;
- 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);
+ return ($error);
}
-sub countitems{
- my ($bibitemnum)=@_;
- my $dbh = C4::Context->dbh;
- my $query="Select count(*) from items where biblioitemnumber='$bibitemnum'";
- my $sth=$dbh->prepare($query);
- $sth->execute;
- 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 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 getbiblio {
my ($biblionumber) = @_;
- my $dbh = C4::Context->dbh;
- my $query = "Select * from biblio where biblionumber = $biblionumber";
- my $sth = $dbh->prepare($query);
- # || 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;
- # || die "Cannot execute $query\n" . $sth->errstr;
- while (my $data = $sth->fetchrow_hashref) {
- $results[$count] = $data;
- $count++;
- } # while
+ $sth->execute($biblionumber);
+
+ # || 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 $query = "Select * from biblioitems where
-biblioitemnumber = $biblioitemnum";
- my $sth = $dbh->prepare($query);
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare( "Select * from biblioitems where
+biblioitemnumber = ?"
+ );
my $count = 0;
my @results;
- $sth->execute;
+ $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 $count = 0;
+ my @results;
+
+ $sth->execute($biblionumber);
+
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $results[$count] = $data;
+ $count++;
+ } # while
+
+ $sth->finish;
+ return ( $count, @results );
+} # sub
+
+sub getitemtypes {
my $dbh = C4::Context->dbh;
- my $query = "Select * from biblioitems where biblionumber =
-$biblionumber";
+ 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;
- while (my $data = $sth->fetchrow_hashref) {
+ # || die "Cannot execute $query\n" . $sth->errstr;
+ while ( my $data = $sth->fetchrow_hashref ) {
$results[$count] = $data;
- $count++;
- } # while
+ $count++;
+ } # while
$sth->finish;
- return($count, @results);
-} # sub
+ return ( $count, @results );
+} # sub getitemtypes
sub getitemsbybiblioitem {
my ($biblioitemnum) = @_;
- my $dbh = C4::Context->dbh;
- my $query = "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
-= $biblioitemnum";
- my $sth = $dbh->prepare($query);
- # || die "Cannot prepare $query\n" . $dbh->errstr;
+= ?"
+ );
+
+ # || die "Cannot prepare $query\n" . $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->execute($biblioitemnum);
- $sth->finish;
- return($count, @results);
-} # sub getitemsbybiblioitem
+ # || die "Cannot execute $query\n" . $sth->errstr;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $results[$count] = $data;
+ $count++;
+ } # while
+ $sth->finish;
+ return ( $count, @results );
+} # sub getitemsbybiblioitem
sub logchange {
-# Subroutine to log changes to databases
+
+ # Subroutine to log changes to databases
# Eventually, this subroutine will be used to create a log of all changes made,
-# with the possibility of "undo"ing some changes
- my $database=shift;
- if ($database eq 'kohadb') {
- my $type=shift;
- my $section=shift;
- my $item=shift;
- my $original=shift;
- my $new=shift;
-# print STDERR "KOHA: $type $section $item $original $new\n";
- } elsif ($database eq 'marc') {
- my $type=shift;
- my $Record_ID=shift;
- my $tag=shift;
- my $mark=shift;
- my $subfield_ID=shift;
- my $original=shift;
- my $new=shift;
+ # with the possibility of "undo"ing some changes
+ my $database = shift;
+ if ( $database eq 'kohadb' ) {
+ my $type = shift;
+ my $section = shift;
+ my $item = shift;
+ my $original = shift;
+ my $new = shift;
+
+ # print STDERR "KOHA: $type $section $item $original $new\n";
+ }
+ elsif ( $database eq 'marc' ) {
+ my $type = shift;
+ my $Record_ID = shift;
+ my $tag = shift;
+ my $mark = shift;
+ my $subfield_ID = shift;
+ my $original = shift;
+ my $new = shift;
+
# print STDERR "MARC: $type $Record_ID $tag $mark $subfield_ID $original $new\n";
}
}
#------------------------------------------------
-
#---------------------------------------
# Find a biblio entry, or create a new one if it doesn't exist.
# If a "subtitle" entry is in hash, add it to subtitle table
sub getoraddbiblio {
- # input params
- my (
- $dbh, # db handle
- # FIXME - Unused argument
- $biblio, # hash ref to fields
- )=@_;
- # return
- my $biblionumber;
+ # input params
+ my (
+ $dbh, # db handle
+ # FIXME - Unused argument
+ $biblio, # hash ref to fields
+ ) = @_;
- my $debug=0;
- my $sth;
- my $error;
+ # return
+ my $biblionumber;
- #-----
- $dbh = C4::Context->dbh;
+ my $debug = 0;
+ my $sth;
+ my $error;
+
+ #-----
+ $dbh = C4::Context->dbh;
-
print "<PRE>Looking for biblio </PRE>\n" if $debug;
- $sth=$dbh->prepare("select biblionumber
+ print "<PRE>Looking for biblio </PRE>\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 "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
- } else {
- # Doesn't exist. Add new one.
- print "<PRE>Adding biblio</PRE>\n" if $debug;
- ($biblionumber,$error)=&newbiblio($biblio);
- if ( $biblionumber ) {
- print "<PRE>Added with biblio number=$biblionumber</PRE>\n" if $debug;
- if ( $biblio->{subtitle} ) {
- &newsubtitle($biblionumber,$biblio->{subtitle} );
- } # if subtitle
- } else {
- print "<PRE>Couldn't add biblio: $error</PRE>\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 "<PRE>Biblio exists with number $biblionumber</PRE>\n" if $debug;
+ }
+ else {
+
+ # Doesn't exist. Add new one.
+ print "<PRE>Adding biblio</PRE>\n" if $debug;
+ ( $biblionumber, $error ) = &newbiblio($biblio);
+ if ($biblionumber) {
+ print "<PRE>Added with biblio number=$biblionumber</PRE>\n"
+ if $debug;
+ if ( $biblio->{subtitle} ) {
+ &newsubtitle( $biblionumber, $biblio->{subtitle} );
+ } # if subtitle
+ }
+ else {
+ print "<PRE>Couldn't add biblio: $error</PRE>\n" if $debug;
+ } # if added
+ }
- return $biblionumber,$error;
+ return $biblionumber, $error;
-} # sub getoraddbiblio
+} # 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)
+sub FindDuplicate {
+ my ($record)=@_;
+ my $dbh = C4::Context->dbh;
+ my $result = MARCmarc2koha($dbh,$record,'');
+ my $sth;
+ my ($biblionumber,$bibid,$title);
+ # search duplicate on ISBN, easy and fast...
+ if ($result->{isbn}) {
+ $sth = $dbh->prepare("select biblio.biblionumber,bibid,title from biblio,biblioitems,marc_biblio where biblio.biblionumber=biblioitems.biblionumber and marc_biblio.biblionumber=biblioitems.biblionumber and isbn=?");
+ $sth->execute($result->{'isbn'});
+ ($biblionumber,$bibid,$title) = $sth->fetchrow;
+ return $biblionumber,$bibid,$title if ($biblionumber);
+ }
+ # a more complex search : build a request for SearchMarc::catalogsearch()
+ my (@tags, @and_or, @excluding, @operator, @value, $offset,$length);
+ # search on biblio.title
+ my ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.title","");
+ if ($record->field($tag)) {
+ if ($record->field($tag)->subfields($subfield)) {
+ push @tags, "'".$tag.$subfield."'";
+ push @and_or, "and";
+ push @excluding, "";
+ push @operator, "contains";
+ push @value, $record->field($tag)->subfield($subfield);
+# warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
+ }
+ }
+ # ... and on biblio.author
+ ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.author","");
+ if ($record->field($tag)) {
+ if ($record->field($tag)->subfields($subfield)) {
+ push @tags, "'".$tag.$subfield."'";
+ push @and_or, "and";
+ push @excluding, "";
+ push @operator, "contains";
+ push @value, $record->field($tag)->subfield($subfield);
+# warn "for author, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
+ }
+ }
+ # ... and on publicationyear.
+ ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publicationyear","");
+ if ($record->field($tag)) {
+ if ($record->field($tag)->subfields($subfield)) {
+ push @tags, "'".$tag.$subfield."'";
+ push @and_or, "and";
+ push @excluding, "";
+ push @operator, "=";
+ push @value, $record->field($tag)->subfield($subfield);
+# warn "for publicationyear, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
+ }
+ }
+ # ... and on size.
+ ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.size","");
+ if ($record->field($tag)) {
+ if ($record->field($tag)->subfields($subfield)) {
+ push @tags, "'".$tag.$subfield."'";
+ push @and_or, "and";
+ push @excluding, "";
+ push @operator, "=";
+ push @value, $record->field($tag)->subfield($subfield);
+# warn "for size, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
+ }
+ }
+ # ... and on publisher.
+ ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publishercode","");
+ if ($record->field($tag)) {
+ if ($record->field($tag)->subfields($subfield)) {
+ push @tags, "'".$tag.$subfield."'";
+ push @and_or, "and";
+ push @excluding, "";
+ push @operator, "=";
+ push @value, $record->field($tag)->subfield($subfield);
+# warn "for publishercode, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
+ }
+ }
+ # ... and on volume.
+ ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.volume","");
+ if ($record->field($tag)) {
+ if ($record->field($tag)->subfields($subfield)) {
+ push @tags, "'".$tag.$subfield."'";
+ push @and_or, "and";
+ push @excluding, "";
+ push @operator, "=";
+ push @value, $record->field($tag)->subfield($subfield);
+# warn "for volume, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
+ }
+ }
+
+ my ($finalresult,$nbresult) = C4::SearchMarc::catalogsearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10);
+ # there is at least 1 result => return the 1st one
+ if ($nbresult) {
+# warn "$nbresult => ".@$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
+ return @$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
+ }
+ # no result, returns nothing
+ return;
+}
+sub DisplayISBN {
+ my ($isbn)=@_;
+ my $seg1;
+ if(substr($isbn, 0, 1) <=7) {
+ $seg1 = substr($isbn, 0, 1);
+ } elsif(substr($isbn, 0, 2) <= 94) {
+ $seg1 = substr($isbn, 0, 2);
+ } elsif(substr($isbn, 0, 3) <= 995) {
+ $seg1 = substr($isbn, 0, 3);
+ } elsif(substr($isbn, 0, 4) <= 9989) {
+ $seg1 = substr($isbn, 0, 4);
+ } else {
+ $seg1 = substr($isbn, 0, 5);
+ }
+ my $x = substr($isbn, length($seg1));
+ my $seg2;
+ if(substr($x, 0, 2) <= 19) {
+# if(sTmp2 < 10) sTmp2 = "0" sTmp2;
+ $seg2 = substr($x, 0, 2);
+ } elsif(substr($x, 0, 3) <= 699) {
+ $seg2 = substr($x, 0, 3);
+ } elsif(substr($x, 0, 4) <= 8399) {
+ $seg2 = substr($x, 0, 4);
+ } elsif(substr($x, 0, 5) <= 89999) {
+ $seg2 = substr($x, 0, 5);
+ } elsif(substr($x, 0, 6) <= 9499999) {
+ $seg2 = substr($x, 0, 6);
+ } else {
+ $seg2 = substr($x, 0, 7);
+ }
+ my $seg3=substr($x,length($seg2));
+ $seg3=substr($seg3,0,length($seg3)-1) ;
+ my $seg4 = substr($x, -1, 1);
+ return "$seg1-$seg2-$seg3-$seg4";
+}
+END { } # module clean-up code here (global destructor)
=back
# $Id$
# $Log$
+# Revision 1.121 2005/06/20 14:10:00 tipaul
+# synch'ing 2.2 and head
+#
+# Revision 1.120 2005/06/15 16:09:43 hdl
+# Displaying dashed isbn.
+#
+# Revision 1.119 2005/06/01 20:43:58 genjimoto
+# patch from Genji (Waylon R.) to update subjects in MARC tables when systempref has MARC=OFF
+#
+# Revision 1.118 2005/05/04 15:40:01 tipaul
+# synch'ing 2.2 and head
+#
+# Revision 1.115.2.9 2005/04/07 10:05:25 tipaul
+# adding / to the list of symbols that are replace by spaces for searches
+#
+# Revision 1.115.2.8 2005/03/25 16:23:49 tipaul
+# some improvements :
+# * return immediatly when a subfield is empty
+# * search duplicate on isbn must be done only when there is an isbn ;-)
+#
+# Revision 1.115.2.7 2005/03/10 15:52:28 tipaul
+# * adding glass to opac marc detail.
+# * changing glasses behaviour : It now appears only on subfields that have a "link" value. Avoid useless glasses and removes nothing. **** WARNING **** : if you don't change you MARC parameters, glasses DISAPPEAR, because no subfields have a link value. So you MUST "reactivate" them manually. If you want to enable the search glass on field 225$a (collection in UNIMARC), just put 225a to "link" field (Koha >> parameters >> framework >> 225 field >> subfield >> modify $a >> enter 225a in link input field (without quotes or anything else)
+# * fixing bug with libopac
+#
+# Revision 1.115.2.6 2005/03/09 15:56:01 tipaul
+# Changing MARCmoditem to be like MARCmodbiblio : a modif is a delete & create.
+# Longer, but solves problems with repeated subfields.
+#
+# The previous version was not buggy except under certain circumstances (a repeated subfield, that does not exist usually in items)
+#
+# Revision 1.115.2.5 2005/02/24 13:54:04 tipaul
+# exporting MARCdelsubfield sub. It's used in authority merging.
+# Modifying it too to enable deletion of all subfields from a given tag/subfield or just one.
+#
+# Revision 1.115.2.4 2005/02/17 12:44:25 tipaul
+# bug in acquisition : the title was also stored as subtitle.
+#
+# Revision 1.115.2.3 2005/02/10 13:14:36 tipaul
+# * multiple main authors are now correctly handled in simple (non-MARC) view
+#
+# Revision 1.115.2.2 2005/01/11 16:02:35 tipaul
+# in catalogue, modifs were not stored properly the non-MARC item DB. Affect only libraries without barcodes.
+#
+# Revision 1.115.2.1 2005/01/11 14:45:37 tipaul
+# bugfix : issn were not stored correctly in non-MARC DB on biblio modification
+#
+# Revision 1.115 2005/01/06 14:32:17 tipaul
+# improvement of speed for bulkmarcimport.
+# A sub had been forgotten to use the C4::Context->marcfromkohafield array, that caches DB datas.
+# this is only a little improvement for normal DB modif, but almost x2 the speed of bulkmarcimport... from 6records/seconds to more than 10.
+#
+# Revision 1.114 2005/01/03 10:48:33 tipaul
+# * bugfix for the search on a MARC detail, when you clic on the magnifying glass (caused an internal server error)
+# * partial support of the "linkage" MARC feature : if you enter a "link" on a MARC subfield, the magnifying glass won't search on the field, but on the linked field. I agree it's a partial support. Will be improved, but I need to investigate MARC21 & UNIMARC diffs on this topic.
+#
+# Revision 1.113 2004/12/10 16:27:53 tipaul
+# limiting the number of search term to 8. There was no limit before, but 8 words seems to be the upper limit mySQL can deal with (in less than a second. tested on a DB with 13 000 items)
+# In 2.4, a new DB structure will highly speed things and this limit will be removed.
+# FindDuplicate is activated again, the perf problems were due to this problem.
+#
+# Revision 1.112 2004/12/08 10:14:42 tipaul
+# * desactivate FindDuplicate
+# * fix from Genji
+#
+# Revision 1.111 2004/11/25 17:39:44 tipaul
+# removing useless &branches in package declaration
+#
+# Revision 1.110 2004/11/24 16:00:01 tipaul
+# removing sub branches (commited by chris for MARC=OFF bugfix, but sub branches is already in Acquisition.pm)
+#
+# Revision 1.109 2004/11/24 15:58:31 tipaul
+# * critical fix for acquisition (see RC3 release notes)
+# * critical fix for duplicate finder
+#
+# Revision 1.108 2004/11/19 19:41:22 rangi
+# Shifting branches() from deprecated C4::Catalogue to C4::Biblio
+# Allowing the non marc interface acquisitions to work.
+#
+# Revision 1.107 2004/11/05 10:15:27 tipaul
+# Improving FindDuplicate to find duplicate records on adding biblio
+#
+# Revision 1.106 2004/11/02 16:44:45 tipaul
+# new feature : checking for duplicate biblio.
+#
+# For instance, it's only done on ISBN only. Will be improved soon.
+#
+# When a duplicate is detected, the biblio is not saved, but the user is asked for a confirmations.
+#
+# Revision 1.105 2004/09/23 16:15:37 tipaul
+# indenting diff
+#
+# Revision 1.104 2004/09/16 15:06:46 tipaul
+# enabling # (| still possible too) for repeatable subfields
+#
+# Revision 1.103 2004/09/06 14:17:34 tipaul
+# some commented warning added + 1 major bugfix => drop empty fields, NOT fields containing 0
+#
+# Revision 1.102 2004/09/06 10:00:19 tipaul
+# adding a "location" field to the library.
+# This field is useful when the callnumber contains no information on the room where the item is stored.
+# With this field, we now have 3 levels of informations to find a book :
+# * the branch.
+# * the location.
+# * the callnumber.
+#
+# This should be versatile enough to solve any storing method.
+# This hack is quite simple, due to the nice Biblio.pm API. The MARC => koha db link is automatically managed. Just add the link in the parameters section.
+#
+# Revision 1.101 2004/08/18 16:01:37 tipaul
+# modifs to support frameworkcodes
+#
+# Revision 1.100 2004/08/13 16:37:25 tipaul
+# adding frameworkcode to API in some subs
+#
+# Revision 1.99 2004/07/30 13:54:50 doxulting
+# Beginning of serial commit
+#
+# Revision 1.98 2004/07/15 09:48:10 tipaul
+# * removing useless sub
+# * minor bugfix in moditem (managing homebranch & holdingbranch)
+#
+# Revision 1.97 2004/07/02 15:53:53 tipaul
+# bugfix (due to frameworkcode field)
+#
+# Revision 1.96 2004/06/29 16:07:10 tipaul
+# last sync for 2.1.0 release
+#
+# 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
+#
+# Revision 1.93 2004/06/11 15:38:06 joshferraro
+# Changes MARCaddword to index words >= 1 char ... needed for more accurate
+# searches using SearchMarc routines.
+#
+# Revision 1.92 2004/06/10 08:29:01 tipaul
+# MARC authority management (continued)
+#
+# Revision 1.91 2004/06/03 10:03:01 tipaul
+# * frameworks and itemtypes are independant
+# * in the MARC editor, showing the + to duplicate a tag only if the tag is repeatable
+#
+# Revision 1.90 2004/05/28 08:25:53 tipaul
+# hidding hidden & isurl constraints into MARC subfield structure
+#
+# Revision 1.89 2004/05/27 21:47:21 rangi
+# Fix for bug 787
+#
+# Revision 1.88 2004/05/18 15:23:49 tipaul
+# framework management : 1 MARC framework for each itemtype
+#
+# Revision 1.87 2004/05/18 11:54:07 tipaul
+# getitemtypes moved in Koha.pm
+#
+# Revision 1.86 2004/05/03 09:19:22 tipaul
+# some fixes for mysql prepare & execute
+#
+# Revision 1.85 2004/04/02 14:55:48 tipaul
+# renaming items.bulk field to items.itemcallnumber.
+# Will be used to store call number for libraries that don't use dewey classification.
+# Note it's related to ITEMS, not biblio.
+#
+# Revision 1.84 2004/03/24 17:18:30 joshferraro
+# Fixes bug 749 by removing the comma on line 1488.
+#
+# Revision 1.83 2004/03/15 14:31:50 tipaul
+# adding a minor check
+#
+# Revision 1.82 2004/03/07 05:47:31 acli
+# Various updates/fixes from rel_2_0
+# Fixes for bugs 721 (templating), 727, and 734
+#
+# Revision 1.81 2004/03/06 20:26:13 tipaul
+# adding seealso feature in MARC searches
+#
+# Revision 1.80 2004/02/12 13:40:56 tipaul
+# deleting subs duplicated by error
+#
+# Revision 1.79 2004/02/11 08:40:09 tipaul
+# synch'ing 2.0.0 branch and head
+#
+# Revision 1.78.2.3 2004/02/10 13:15:46 tipaul
+# removing 2 warnings
+#
+# Revision 1.78.2.2 2004/01/26 10:38:06 tipaul
+# dealing correctly "bulk" field
+#
+# Revision 1.78.2.1 2004/01/13 17:29:53 tipaul
+# * minor html fixes
+# * adding publisher in acquisition process (& ordering basket by publisher)
+#
+# Revision 1.78 2003/12/09 15:57:28 tipaul
+# rolling back to working char_decode sub
+#
+# Revision 1.77 2003/12/03 17:47:14 tipaul
+# bugfixes for biblio deletion
+#
+# Revision 1.76 2003/12/03 01:43:41 slef
+# conflict markers?
+#
+# Revision 1.75 2003/12/03 01:42:03 slef
+# bug 662 fixes securing DBI
+#
+# Revision 1.74 2003/11/28 09:48:33 tipaul
+# bugfix : misusing prepare & execute => now using prepare(?) and execute($var)
+#
# Revision 1.73 2003/11/28 09:45:25 tipaul
# bugfix for iso2709 file import in the "notforloan" field.
#
projects / koha.git / blobdiff