-sub MARCmodbiblio {
- my ($dbh,$bibid,$record,$frameworkcode,$delete)=@_;
-# 1st delete the biblio,
-# 2nd recreate it
- my $biblionumber = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
- &MARCdelbiblio($dbh,$bibid,1);
- &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.
-
-# 1st of all, copy the MARC::Record to deletedbiblio table => if a true deletion, MARC data will be kept.
-# if deletion called before MARCmodbiblio => won't do anything, as the oldbiblionumber doesn't
- # exist in deletedbiblio table
- my $record = MARCgetbiblio( $dbh, $bibid );
- my $oldbiblionumber =
- MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
- my $copy2deleted =
- $dbh->prepare("update deletedbiblio set marc=? where biblionumber=?");
- $copy2deleted->execute( $record->as_usmarc(), $oldbiblionumber );
-
- # now, delete in MARC tables.
- if ( $keep_items eq 1 ) {
-
- #search item field code
- my $sth =
- $dbh->prepare(
-"select tagfield from marc_subfield_structure where kohafield like 'items.%'"
- );
- $sth->execute;
- my $itemtag = $sth->fetchrow_hashref->{tagfield};
- $dbh->do(
-"delete from marc_subfield_table where bibid=$bibid and tag<>$itemtag"
- );
- $dbh->do(
-"delete from marc_word where bibid=$bibid and not (tagsubfield like \"$itemtag%\")"
- );
- }
- else {
- $dbh->do("delete from marc_biblio where bibid=$bibid");
- $dbh->do("delete from marc_subfield_table where bibid=$bibid");
- $dbh->do("delete from marc_word where bibid=$bibid");
- }
-}
-
-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 );
-}
-
-sub MARCmoditem {
- my ($dbh,$record,$bibid,$itemnumber,$delete)=@_;
- 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 ) = @_;
- $dbh->do("lock tables marc_blob_subfield WRITE,marc_subfield_table WRITE");
- my $sth1 =
- $dbh->prepare(
- "select valuebloblink from marc_subfield_table where subfieldid=?");
- $sth1->execute($subfieldid);
- my ($oldvaluebloblink) = $sth1->fetchrow;
- $sth1->finish;
- my $sth;
-
- # if too long, use a bloblink
- if ( length($subfieldvalue) > 255 ) {
-
- # if already a bloblink, update it, otherwise, insert a new one.
- if ($oldvaluebloblink) {
- $sth =
- $dbh->prepare(
-"update marc_blob_subfield set subfieldvalue=? where blobidlink=?"
- );
- $sth->execute( $subfieldvalue, $oldvaluebloblink );
- }
- else {
- $sth =
- $dbh->prepare(
- "insert into marc_blob_subfield (subfieldvalue) values (?)");
- $sth->execute($subfieldvalue);
- $sth =
- $dbh->prepare("select max(blobidlink) from marc_blob_subfield");
- $sth->execute;
- my ($res) = $sth->fetchrow;
- $sth =
- $dbh->prepare(
-"update marc_subfield_table set subfieldvalue=null, valuebloblink=? where subfieldid=?"
- );
- $sth->execute( $res, $subfieldid );
- }
- }
- else {
-
-# note this can leave orphan bloblink. Not a big problem, but we should build somewhere a orphan deleting script...
- $sth =
- $dbh->prepare(
-"update marc_subfield_table set subfieldvalue=?,valuebloblink=null where subfieldid=?"
- );
- $sth->execute( $subfieldvalue, $subfieldid );
- }
- $dbh->do("unlock tables");
- $sth->finish;
- $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 );
-}
-
-sub MARCfindsubfield {
- my ( $dbh, $bibid, $tag, $subfieldcode, $subfieldorder, $subfieldvalue ) =
- @_;
- my $resultcounter = 0;
- my $subfieldid;
- my $lastsubfieldid;
- my $query =
-"select subfieldid from marc_subfield_table where bibid=? and tag=? and subfieldcode=?";
- my @bind_values = ( $bibid, $tag, $subfieldcode );
- if ($subfieldvalue) {
- $query .= " and subfieldvalue=?";
- push ( @bind_values, $subfieldvalue );
- }
- else {
- if ( $subfieldorder < 1 ) {
- $subfieldorder = 1;
- }
- $query .= " and subfieldorder=?";
- push ( @bind_values, $subfieldorder );
- }
- my $sti = $dbh->prepare($query);
- $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
- 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
- where bibid=? and tag=? and tagorder=?
- and subfieldcode=?"
- );
- $sth->execute( $bibid, $tag, $tagorder, $subfield );
- ($res) = $sth->fetchrow;
- }
- return $res;
-}
-