3945 lines
121 KiB
Perl
3945 lines
121 KiB
Perl
package C4::Biblio;
|
||
|
||
# Copyright 2000-2002 Katipo Communications
|
||
#
|
||
# This file is part of Koha.
|
||
#
|
||
# Koha is free software; you can redistribute it and/or modify it under the
|
||
# terms of the GNU General Public License as published by the Free Software
|
||
# Foundation; either version 2 of the License, or (at your option) any later
|
||
# version.
|
||
#
|
||
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
|
||
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
|
||
# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
||
#
|
||
# You should have received a copy of the GNU General Public License along with
|
||
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
|
||
# Suite 330, Boston, MA 02111-1307 USA
|
||
|
||
use strict;
|
||
|
||
require Exporter;
|
||
use C4::Context;
|
||
use MARC::Record;
|
||
use MARC::File::USMARC;
|
||
use MARC::File::XML;
|
||
use ZOOM;
|
||
use C4::Koha;
|
||
use C4::Date;
|
||
use utf8;
|
||
use C4::Log; # logaction
|
||
|
||
use vars qw($VERSION @ISA @EXPORT);
|
||
|
||
# set the version for version checking
|
||
$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v).".".join( "_", map { sprintf "%03d", $_ } @v ); };
|
||
|
||
@ISA = qw( Exporter );
|
||
|
||
# EXPORTED FUNCTIONS.
|
||
|
||
# to add biblios or items
|
||
push @EXPORT, qw( &AddBiblio &AddItem );
|
||
|
||
# to get something
|
||
push @EXPORT, qw(
|
||
&GetBiblio
|
||
&GetBiblioData
|
||
&GetBiblioItemData
|
||
&GetBiblioItemInfosOf
|
||
&GetBiblioItemByBiblioNumber
|
||
&GetBiblioFromItemNumber
|
||
|
||
&GetItemInfosOf
|
||
&GetItemStatus
|
||
&GetItemLocation
|
||
|
||
&GetItemsInfo
|
||
&GetItemFromBarcode
|
||
&getitemsbybiblioitem
|
||
&get_itemnumbers_of
|
||
&GetAuthorisedValueDesc
|
||
&GetXmlBiblio
|
||
);
|
||
|
||
# To modify something
|
||
push @EXPORT, qw(
|
||
&ModBiblio
|
||
&ModItem
|
||
&ModBiblioframework
|
||
);
|
||
|
||
# To delete something
|
||
push @EXPORT, qw(
|
||
&DelBiblio
|
||
&DelItem
|
||
);
|
||
|
||
# Marc related functions
|
||
push @EXPORT, qw(
|
||
&MARCfind_marc_from_kohafield
|
||
&MARCfind_frameworkcode
|
||
&MARCgettagslib
|
||
&MARCmoditemonefield
|
||
&MARCaddbiblio
|
||
&MARCadditem
|
||
&MARCmodbiblio
|
||
&MARCmoditem
|
||
&MARCkoha2marcBiblio
|
||
&MARCmarc2koha
|
||
&MARCkoha2marcItem
|
||
&MARChtml2marc
|
||
&MARChtml2xml
|
||
&MARCgetitem
|
||
&MARCaddword
|
||
&MARCdelword
|
||
&MARCdelsubfield
|
||
&GetMarcNotes
|
||
&GetMarcSubjects
|
||
&GetMarcBiblio
|
||
&GetMarcAuthors
|
||
&GetMarcSeries
|
||
&Koha2Marc
|
||
);
|
||
|
||
# Others functions
|
||
push @EXPORT, qw(
|
||
&PrepareItemrecordDisplay
|
||
&zebraop
|
||
&char_decode
|
||
&itemcalculator
|
||
&calculatelc
|
||
);
|
||
|
||
# OLD functions,
|
||
push @EXPORT, qw(
|
||
&newitems
|
||
&modbiblio
|
||
&modbibitem
|
||
&moditem
|
||
&checkitems
|
||
);
|
||
|
||
=head1 NAME
|
||
|
||
C4::Biblio - acquisitions and cataloging management functions
|
||
|
||
=head1 DESCRIPTION
|
||
|
||
Biblio.pm contains functions for managing storage and editing of bibliographic data within Koha. Most of the functions in this module are used for cataloging records: adding, editing, or removing biblios, biblioitems, or items. Koha's stores bibliographic information in three places:
|
||
|
||
=over 4
|
||
|
||
=item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
|
||
|
||
=item 2. as raw MARC in the Zebra index and storage engine
|
||
|
||
=item 3. as raw MARC the biblioitems.marc
|
||
|
||
=back
|
||
|
||
In the 2.4 version of Koha, the authoritative record-level information is in biblioitems.marc and the authoritative items information is in the items table.
|
||
|
||
Because the data isn't completely normalized there's a chance for information to get out of sync. The design choice to go with a un-normalized schema was driven by performance and stability concerns:
|
||
|
||
=over 4
|
||
|
||
=item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
|
||
|
||
=item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
|
||
|
||
=back
|
||
|
||
Because of this design choice, the process of managing storage and editing is a bit convoluted. Historically, Biblio.pm's grown to an unmanagable size and as a result we have several types of functions currently:
|
||
|
||
=over 4
|
||
|
||
=item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
|
||
|
||
=item 2. _koha_* - low-level internal functions for managing the koha tables
|
||
|
||
=item 3. MARC* functions for interacting with the MARC data in both biblioitems.marc Zebra (biblioitems.marc is authoritative)
|
||
|
||
=item 4. Zebra functions used to update the Zebra index
|
||
|
||
=item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
|
||
|
||
=item 6. other functions that don't belong in Biblio.pm that will be cleaned out in time. (like MARCfind_marc_from_kohafield which belongs in Search.pm)
|
||
|
||
In time, as we solidify the new API these older functions will be weeded out.
|
||
|
||
=back
|
||
|
||
=head1 EXPORTED FUNCTIONS
|
||
|
||
=head2 AddBiblio
|
||
|
||
($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
|
||
|
||
Exported function (core API) for adding a new biblio to koha.
|
||
|
||
=cut
|
||
|
||
sub AddBiblio {
|
||
my ( $record, $frameworkcode ) = @_;
|
||
my $oldbibnum;
|
||
my $oldbibitemnum;
|
||
my $dbh = C4::Context->dbh;
|
||
# transform the data into koha-table style data
|
||
my $olddata = MARCmarc2koha( $dbh, $record, $frameworkcode );
|
||
$oldbibnum = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
|
||
$olddata->{'biblionumber'} = $oldbibnum;
|
||
$oldbibitemnum = _koha_add_biblioitem( $dbh, $olddata );
|
||
|
||
# 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;
|
||
|
||
my $newfield;
|
||
|
||
# biblionumber & biblioitemnumber are in different fields
|
||
if ( $tagfield1 != $tagfield2 ) {
|
||
|
||
# deal with biblionumber
|
||
if ( $tagfield1 < 10 ) {
|
||
$newfield = MARC::Field->new( $tagfield1, $oldbibnum, );
|
||
}
|
||
else {
|
||
$newfield =
|
||
MARC::Field->new( $tagfield1, '', '',
|
||
"$tagsubfield1" => $oldbibnum, );
|
||
}
|
||
|
||
# drop old field and create new one...
|
||
my $old_field = $record->field($tagfield1);
|
||
$record->delete_field($old_field);
|
||
$record->append_fields($newfield);
|
||
|
||
# deal with biblioitemnumber
|
||
if ( $tagfield2 < 10 ) {
|
||
$newfield = MARC::Field->new( $tagfield2, $oldbibitemnum, );
|
||
}
|
||
else {
|
||
$newfield =
|
||
MARC::Field->new( $tagfield2, '', '',
|
||
"$tagsubfield2" => $oldbibitemnum, );
|
||
}
|
||
# drop old field and create new one...
|
||
$old_field = $record->field($tagfield2);
|
||
$record->delete_field($old_field);
|
||
$record->insert_fields_ordered($newfield);
|
||
|
||
# biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
|
||
}
|
||
else {
|
||
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->insert_fields_ordered($newfield);
|
||
}
|
||
|
||
###NEU specific add cataloguers cardnumber as well
|
||
my $cardtag = C4::Context->preference('cataloguersfield');
|
||
if ($cardtag) {
|
||
my $tag = substr( $cardtag, 0, 3 );
|
||
my $subf = substr( $cardtag, 3, 1 );
|
||
my $me = C4::Context->userenv;
|
||
my $cataloger = $me->{'cardnumber'} if ($me);
|
||
my $newtag = MARC::Field->new( $tag, '', '', $subf => $cataloger )
|
||
if ($me);
|
||
$record->delete_field($newtag);
|
||
$record->insert_fields_ordered($newtag);
|
||
}
|
||
|
||
# now add the record
|
||
my $biblionumber =
|
||
MARCaddbiblio( $record, $oldbibnum, $frameworkcode );
|
||
|
||
&logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$biblionumber,"biblio")
|
||
if C4::Context->preference("CataloguingLog");
|
||
|
||
return ( $biblionumber, $oldbibitemnum );
|
||
}
|
||
|
||
=head2 AddItem
|
||
|
||
$biblionumber = AddItem( $record, $biblionumber)
|
||
|
||
Exported function (core API) for adding a new item to Koha
|
||
|
||
=cut
|
||
|
||
sub AddItem {
|
||
my ( $record, $biblionumber ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
|
||
# add item in old-DB
|
||
my $frameworkcode = MARCfind_frameworkcode( $biblionumber );
|
||
my $item = &MARCmarc2koha( $dbh, $record, $frameworkcode );
|
||
|
||
# needs old biblionumber and biblioitemnumber
|
||
$item->{'biblionumber'} = $biblionumber;
|
||
my $sth =
|
||
$dbh->prepare(
|
||
"select biblioitemnumber,itemtype from biblioitems where biblionumber=?"
|
||
);
|
||
$sth->execute( $item->{'biblionumber'} );
|
||
my $itemtype;
|
||
( $item->{'biblioitemnumber'}, $itemtype ) = $sth->fetchrow;
|
||
$sth =
|
||
$dbh->prepare(
|
||
"select notforloan from itemtypes where itemtype='$itemtype'");
|
||
$sth->execute();
|
||
my $notforloan = $sth->fetchrow;
|
||
##Change the notforloan field if $notforloan found
|
||
if ( $notforloan > 0 ) {
|
||
$item->{'notforloan'} = $notforloan;
|
||
&MARCitemchange( $record, "items.notforloan", $notforloan );
|
||
}
|
||
if ( !$item->{'dateaccessioned'} || $item->{'dateaccessioned'} eq '' ) {
|
||
|
||
# find today's date
|
||
my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
|
||
localtime(time);
|
||
$year += 1900;
|
||
$mon += 1;
|
||
my $date =
|
||
"$year-" . sprintf( "%0.2d", $mon ) . "-" . sprintf( "%0.2d", $mday );
|
||
$item->{'dateaccessioned'} = $date;
|
||
&MARCitemchange( $record, "items.dateaccessioned", $date );
|
||
}
|
||
my ( $itemnumber, $error ) =
|
||
&_koha_new_items( $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 );
|
||
|
||
##NEU specific add cataloguers cardnumber as well
|
||
my $cardtag = C4::Context->preference('itemcataloguersubfield');
|
||
if ($cardtag) {
|
||
$sth->execute( $frameworkcode, "items.itemnumber" );
|
||
my ( $itemtag, $subtag ) = $sth->fetchrow;
|
||
my $me = C4::Context->userenv;
|
||
my $cataloguer = $me->{'cardnumber'} if ($me);
|
||
my $newtag = $record->field($itemtag);
|
||
$newtag->update( $cardtag => $cataloguer ) if ($me);
|
||
$record->delete_field($newtag);
|
||
$record->append_fields($newtag);
|
||
}
|
||
|
||
# add the item
|
||
&MARCadditem( $record, $item->{'biblionumber'},$frameworkcode );
|
||
|
||
&logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$itemnumber,"item")
|
||
if C4::Context->preference("CataloguingLog");
|
||
|
||
return ($item->{biblionumber}, $item->{biblioitemnumber},$itemnumber);
|
||
}
|
||
|
||
=head2 ModBiblio
|
||
|
||
ModBiblio( $record,$biblionumber,$frameworkcode);
|
||
|
||
Exported function (core API) to modify a biblio
|
||
|
||
=cut
|
||
|
||
sub ModBiblio {
|
||
my ( $record, $biblionumber, $frameworkcode ) = @_;
|
||
|
||
if (C4::Context->preference("CataloguingLog")) {
|
||
my $newrecord = GetMarcBiblio($biblionumber);
|
||
&logaction(C4::Context->userenv->{'number'},"CATALOGUING","MODIFY",$biblionumber,$newrecord->as_formatted)
|
||
}
|
||
|
||
my $dbh = C4::Context->dbh;
|
||
|
||
$frameworkcode = "" unless $frameworkcode;
|
||
|
||
# update the MARC record with the new record data
|
||
&MARCmodbiblio( $dbh, $biblionumber, $record, $frameworkcode, 1 );
|
||
|
||
# load the koha-table data object
|
||
my $oldbiblio = MARCmarc2koha( $dbh, $record, $frameworkcode );
|
||
|
||
# modify the other koha tables
|
||
my $oldbiblionumber = _koha_modify_biblio( $dbh, $oldbiblio );
|
||
_koha_modify_biblioitem( $dbh, $oldbiblio );
|
||
|
||
return 1;
|
||
}
|
||
|
||
=head2 ModItem
|
||
|
||
Exported function (core API) for modifying an item in Koha.
|
||
|
||
=cut
|
||
|
||
sub ModItem {
|
||
my ( $record, $biblionumber, $itemnumber, $delete, $new_item_hashref )
|
||
= @_;
|
||
|
||
#logging
|
||
&logaction(C4::Context->userenv->{'number'},"CATALOGUING","MODIFY",$itemnumber,$record->as_formatted)
|
||
if C4::Context->preference("CataloguingLog");
|
||
|
||
my $dbh = C4::Context->dbh;
|
||
|
||
# if we have a MARC record, we're coming from cataloging and so
|
||
# we do the whole routine: update the MARC and zebra, then update the koha
|
||
# tables
|
||
if ($record) {
|
||
my $frameworkcode = MARCfind_frameworkcode( $biblionumber );
|
||
MARCmoditem( $record, $biblionumber, $itemnumber, $frameworkcode, $delete );
|
||
my $olditem = MARCmarc2koha( $dbh, $record, $frameworkcode );
|
||
_koha_modify_item( $dbh, $olditem );
|
||
return $biblionumber;
|
||
}
|
||
|
||
# otherwise, we're just looking to modify something quickly
|
||
# (like a status) so we just update the koha tables
|
||
elsif ($new_item_hashref) {
|
||
_koha_modify_item( $dbh, $new_item_hashref );
|
||
}
|
||
}
|
||
|
||
=head2 ModBiblioframework
|
||
|
||
ModBiblioframework($biblionumber,$frameworkcode);
|
||
|
||
Exported function to modify a biblio framework
|
||
|
||
=cut
|
||
|
||
sub ModBiblioframework {
|
||
my ( $biblionumber, $frameworkcode ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
my $sth =
|
||
$dbh->prepare(
|
||
"UPDATE biblio SET frameworkcode=? WHERE biblionumber=$biblionumber");
|
||
|
||
warn "IN ModBiblioframework";
|
||
$sth->execute($frameworkcode);
|
||
return 1;
|
||
}
|
||
|
||
=head2 DelBiblio
|
||
|
||
my $error = &DelBiblio($dbh,$biblionumber);
|
||
|
||
Exported function (core API) for deleting a biblio in koha.
|
||
|
||
Deletes biblio record from Zebra and Koha tables (biblio,biblioitems,items)
|
||
|
||
Also backs it up to deleted* tables
|
||
|
||
Checks to make sure there are not issues on any of the items
|
||
|
||
return:
|
||
C<$error> : undef unless an error occurs
|
||
|
||
=cut
|
||
|
||
sub DelBiblio {
|
||
my ( $biblionumber ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
my $error; # for error handling
|
||
|
||
# First make sure there are no items with issues are still attached
|
||
my $sth =
|
||
$dbh->prepare(
|
||
"SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
|
||
$sth->execute($biblionumber);
|
||
while ( my $biblioitemnumber = $sth->fetchrow ) {
|
||
my @issues = C4::Circulation::Circ2::itemissues($biblioitemnumber);
|
||
foreach my $issue (@issues) {
|
||
if ( ( $issue->{date_due} )
|
||
&& ( $issue->{date_due} ne "Available" ) )
|
||
{
|
||
|
||
#FIXME: we need a status system in Biblio like in Circ to return standard codes and messages
|
||
# instead of hard-coded strings
|
||
$error .=
|
||
"Item is checked out to a patron -- you must return it before deleting the Biblio";
|
||
}
|
||
}
|
||
}
|
||
return $error if $error;
|
||
|
||
# Delete in Zebra
|
||
zebraop($dbh,$biblionumber,"delete_record","biblioserver");
|
||
|
||
# delete biblio from Koha tables and save in deletedbiblio
|
||
$error = &_koha_delete_biblio( $dbh, $biblionumber );
|
||
|
||
# delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
|
||
$sth =
|
||
$dbh->prepare(
|
||
"SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
|
||
$sth->execute($biblionumber);
|
||
while ( my $biblioitemnumber = $sth->fetchrow ) {
|
||
|
||
# delete this biblioitem
|
||
$error = &_koha_delete_biblioitems( $dbh, $biblioitemnumber );
|
||
return $error if $error;
|
||
|
||
# delete items
|
||
my $items_sth =
|
||
$dbh->prepare(
|
||
"SELECT itemnumber FROM items WHERE biblioitemnumber=?");
|
||
$items_sth->execute($biblioitemnumber);
|
||
while ( my $itemnumber = $items_sth->fetchrow ) {
|
||
$error = &_koha_delete_items( $dbh, $itemnumber );
|
||
return $error if $error;
|
||
}
|
||
}
|
||
&logaction(C4::Context->userenv->{'number'},"CATALOGUING","DELETE",$biblionumber,"")
|
||
if C4::Context->preference("CataloguingLog");
|
||
return;
|
||
}
|
||
|
||
=head2 DelItem
|
||
|
||
DelItem( $biblionumber, $itemnumber );
|
||
|
||
Exported function (core API) for deleting an item record in Koha.
|
||
|
||
=cut
|
||
|
||
sub DelItem {
|
||
my ( $biblionumber, $itemnumber ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
&_koha_delete_item( $dbh, $itemnumber );
|
||
my $newrec = &MARCdelitem( $biblionumber, $itemnumber );
|
||
&MARCaddbiblio( $newrec, $biblionumber, MARCfind_frameworkcode($biblionumber) );
|
||
&logaction(C4::Context->userenv->{'number'},"CATALOGUING","DELETE",$itemnumber,"item")
|
||
if C4::Context->preference("CataloguingLog");
|
||
}
|
||
|
||
=head2 GetBiblioData
|
||
|
||
$data = &GetBiblioData($biblionumber, $type);
|
||
|
||
Returns information about the book with the given biblionumber.
|
||
|
||
C<$type> is ignored.
|
||
|
||
C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
|
||
the C<biblio> and C<biblioitems> tables in the
|
||
Koha database.
|
||
|
||
In addition, C<$data-E<gt>{subject}> is the list of the book's
|
||
subjects, separated by C<" , "> (space, comma, space).
|
||
|
||
If there are multiple biblioitems with the given biblionumber, only
|
||
the first one is considered.
|
||
|
||
=cut
|
||
|
||
#'
|
||
sub GetBiblioData {
|
||
my ( $bibnum, $type ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
|
||
my $query = "
|
||
SELECT * , biblioitems.notes AS bnotes, biblio.notes
|
||
FROM biblio
|
||
LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
|
||
LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
|
||
WHERE biblio.biblionumber = ?
|
||
AND biblioitems.biblionumber = biblio.biblionumber
|
||
";
|
||
my $sth = $dbh->prepare($query);
|
||
$sth->execute($bibnum);
|
||
my $data;
|
||
$data = $sth->fetchrow_hashref;
|
||
$sth->finish;
|
||
|
||
return ($data);
|
||
} # sub GetBiblioData
|
||
|
||
|
||
=head2 GetItemsInfo
|
||
|
||
@results = &GetItemsInfo($biblionumber, $type);
|
||
|
||
Returns information about books with the given biblionumber.
|
||
|
||
C<$type> may be either C<intra> or anything else. If it is not set to
|
||
C<intra>, then the search will exclude lost, very overdue, and
|
||
withdrawn items.
|
||
|
||
C<&GetItemsInfo> returns a list of references-to-hash. Each element
|
||
contains a number of keys. Most of them are table items from the
|
||
C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
|
||
Koha database. Other keys include:
|
||
|
||
=over 4
|
||
|
||
=item C<$data-E<gt>{branchname}>
|
||
|
||
The name (not the code) of the branch to which the book belongs.
|
||
|
||
=item C<$data-E<gt>{datelastseen}>
|
||
|
||
This is simply C<items.datelastseen>, except that while the date is
|
||
stored in YYYY-MM-DD format in the database, here it is converted to
|
||
DD/MM/YYYY format. A NULL date is returned as C<//>.
|
||
|
||
=item C<$data-E<gt>{datedue}>
|
||
|
||
=item C<$data-E<gt>{class}>
|
||
|
||
This is the concatenation of C<biblioitems.classification>, the book's
|
||
Dewey code, and C<biblioitems.subclass>.
|
||
|
||
=item C<$data-E<gt>{ocount}>
|
||
|
||
I think this is the number of copies of the book available.
|
||
|
||
=item C<$data-E<gt>{order}>
|
||
|
||
If this is set, it is set to C<One Order>.
|
||
|
||
=back
|
||
|
||
=cut
|
||
|
||
#'
|
||
sub GetItemsInfo {
|
||
my ( $biblionumber, $type ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
my $query = "SELECT *,items.notforloan as itemnotforloan
|
||
FROM items, biblio, biblioitems
|
||
LEFT JOIN itemtypes on biblioitems.itemtype = itemtypes.itemtype
|
||
WHERE items.biblionumber = ?
|
||
AND biblioitems.biblioitemnumber = items.biblioitemnumber
|
||
AND biblio.biblionumber = items.biblionumber
|
||
ORDER BY items.dateaccessioned desc
|
||
";
|
||
my $sth = $dbh->prepare($query);
|
||
$sth->execute($biblionumber);
|
||
my $i = 0;
|
||
my @results;
|
||
my ( $date_due, $count_reserves );
|
||
|
||
while ( my $data = $sth->fetchrow_hashref ) {
|
||
my $datedue = '';
|
||
my $isth = $dbh->prepare(
|
||
"SELECT issues.*,borrowers.cardnumber
|
||
FROM issues, borrowers
|
||
WHERE itemnumber = ?
|
||
AND returndate IS NULL
|
||
AND issues.borrowernumber=borrowers.borrowernumber"
|
||
);
|
||
$isth->execute( $data->{'itemnumber'} );
|
||
if ( my $idata = $isth->fetchrow_hashref ) {
|
||
$data->{borrowernumber} = $idata->{borrowernumber};
|
||
$data->{cardnumber} = $idata->{cardnumber};
|
||
$datedue = format_date( $idata->{'date_due'} );
|
||
}
|
||
if ( $datedue eq '' ) {
|
||
#$datedue="Available";
|
||
my ( $restype, $reserves ) =
|
||
C4::Reserves2::CheckReserves( $data->{'itemnumber'} );
|
||
if ($restype) {
|
||
|
||
#$datedue=$restype;
|
||
$count_reserves = $restype;
|
||
}
|
||
}
|
||
$isth->finish;
|
||
|
||
#get branch information.....
|
||
my $bsth = $dbh->prepare(
|
||
"SELECT * FROM branches WHERE branchcode = ?
|
||
"
|
||
);
|
||
$bsth->execute( $data->{'holdingbranch'} );
|
||
if ( my $bdata = $bsth->fetchrow_hashref ) {
|
||
$data->{'branchname'} = $bdata->{'branchname'};
|
||
}
|
||
my $date = format_date( $data->{'datelastseen'} );
|
||
$data->{'datelastseen'} = $date;
|
||
$data->{'datedue'} = $datedue;
|
||
$data->{'count_reserves'} = $count_reserves;
|
||
|
||
# get notforloan complete status if applicable
|
||
my $sthnflstatus = $dbh->prepare(
|
||
'SELECT authorised_value
|
||
FROM marc_subfield_structure
|
||
WHERE kohafield="items.notforloan"
|
||
'
|
||
);
|
||
|
||
$sthnflstatus->execute;
|
||
my ($authorised_valuecode) = $sthnflstatus->fetchrow;
|
||
if ($authorised_valuecode) {
|
||
$sthnflstatus = $dbh->prepare(
|
||
"SELECT lib FROM authorised_values
|
||
WHERE category=?
|
||
AND authorised_value=?"
|
||
);
|
||
$sthnflstatus->execute( $authorised_valuecode,
|
||
$data->{itemnotforloan} );
|
||
my ($lib) = $sthnflstatus->fetchrow;
|
||
$data->{notforloan} = $lib;
|
||
}
|
||
|
||
# my stack procedures
|
||
my $stackstatus = $dbh->prepare(
|
||
'SELECT authorised_value
|
||
FROM marc_subfield_structure
|
||
WHERE kohafield="items.stack"
|
||
'
|
||
);
|
||
$stackstatus->execute;
|
||
|
||
($authorised_valuecode) = $stackstatus->fetchrow;
|
||
if ($authorised_valuecode) {
|
||
$stackstatus = $dbh->prepare(
|
||
"SELECT lib
|
||
FROM authorised_values
|
||
WHERE category=?
|
||
AND authorised_value=?
|
||
"
|
||
);
|
||
$stackstatus->execute( $authorised_valuecode, $data->{stack} );
|
||
my ($lib) = $stackstatus->fetchrow;
|
||
$data->{stack} = $lib;
|
||
}
|
||
$results[$i] = $data;
|
||
$i++;
|
||
}
|
||
$sth->finish;
|
||
|
||
return (@results);
|
||
}
|
||
|
||
=head2 getitemstatus
|
||
|
||
$itemstatushash = &getitemstatus($fwkcode);
|
||
returns information about status.
|
||
Can be MARC dependant.
|
||
fwkcode is optional.
|
||
But basically could be can be loan or not
|
||
Create a status selector with the following code
|
||
|
||
=head3 in PERL SCRIPT
|
||
|
||
my $itemstatushash = getitemstatus;
|
||
my @itemstatusloop;
|
||
foreach my $thisstatus (keys %$itemstatushash) {
|
||
my %row =(value => $thisstatus,
|
||
statusname => $itemstatushash->{$thisstatus}->{'statusname'},
|
||
);
|
||
push @itemstatusloop, \%row;
|
||
}
|
||
$template->param(statusloop=>\@itemstatusloop);
|
||
|
||
|
||
=head3 in TEMPLATE
|
||
<select name="statusloop">
|
||
<option value="">Default</option>
|
||
<!-- TMPL_LOOP name="statusloop" -->
|
||
<option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="statusname" --></option>
|
||
<!-- /TMPL_LOOP -->
|
||
</select>
|
||
|
||
=cut
|
||
|
||
sub GetItemStatus {
|
||
|
||
# returns a reference to a hash of references to status...
|
||
my ($fwk) = @_;
|
||
my %itemstatus;
|
||
my $dbh = C4::Context->dbh;
|
||
my $sth;
|
||
$fwk = '' unless ($fwk);
|
||
my ( $tag, $subfield ) =
|
||
MARCfind_marc_from_kohafield( $dbh, "items.notforloan", $fwk );
|
||
if ( $tag and $subfield ) {
|
||
my $sth =
|
||
$dbh->prepare(
|
||
"select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?"
|
||
);
|
||
$sth->execute( $tag, $subfield, $fwk );
|
||
if ( my ($authorisedvaluecat) = $sth->fetchrow ) {
|
||
my $authvalsth =
|
||
$dbh->prepare(
|
||
"select authorised_value, lib from authorised_values where category=? order by lib"
|
||
);
|
||
$authvalsth->execute($authorisedvaluecat);
|
||
while ( my ( $authorisedvalue, $lib ) = $authvalsth->fetchrow ) {
|
||
$itemstatus{$authorisedvalue} = $lib;
|
||
}
|
||
$authvalsth->finish;
|
||
return \%itemstatus;
|
||
exit 1;
|
||
}
|
||
else {
|
||
|
||
#No authvalue list
|
||
# build default
|
||
}
|
||
$sth->finish;
|
||
}
|
||
|
||
#No authvalue list
|
||
#build default
|
||
$itemstatus{"1"} = "Not For Loan";
|
||
return \%itemstatus;
|
||
}
|
||
|
||
=head2 getitemlocation
|
||
|
||
$itemlochash = &getitemlocation($fwk);
|
||
returns informations about location.
|
||
where fwk stands for an optional framework code.
|
||
Create a location selector with the following code
|
||
|
||
=head3 in PERL SCRIPT
|
||
|
||
my $itemlochash = getitemlocation;
|
||
my @itemlocloop;
|
||
foreach my $thisloc (keys %$itemlochash) {
|
||
my $selected = 1 if $thisbranch eq $branch;
|
||
my %row =(locval => $thisloc,
|
||
selected => $selected,
|
||
locname => $itemlochash->{$thisloc},
|
||
);
|
||
push @itemlocloop, \%row;
|
||
}
|
||
$template->param(itemlocationloop => \@itemlocloop);
|
||
|
||
=head3 in TEMPLATE
|
||
<select name="location">
|
||
<option value="">Default</option>
|
||
<!-- TMPL_LOOP name="itemlocationloop" -->
|
||
<option value="<!-- TMPL_VAR name="locval" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="locname" --></option>
|
||
<!-- /TMPL_LOOP -->
|
||
</select>
|
||
|
||
=cut
|
||
|
||
sub GetItemLocation {
|
||
|
||
# returns a reference to a hash of references to location...
|
||
my ($fwk) = @_;
|
||
my %itemlocation;
|
||
my $dbh = C4::Context->dbh;
|
||
my $sth;
|
||
$fwk = '' unless ($fwk);
|
||
my ( $tag, $subfield ) =
|
||
MARCfind_marc_from_kohafield( $dbh, "items.location", $fwk );
|
||
if ( $tag and $subfield ) {
|
||
my $sth =
|
||
$dbh->prepare(
|
||
"select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?"
|
||
);
|
||
$sth->execute( $tag, $subfield, $fwk );
|
||
if ( my ($authorisedvaluecat) = $sth->fetchrow ) {
|
||
my $authvalsth =
|
||
$dbh->prepare(
|
||
"select authorised_value, lib from authorised_values where category=? order by lib"
|
||
);
|
||
$authvalsth->execute($authorisedvaluecat);
|
||
while ( my ( $authorisedvalue, $lib ) = $authvalsth->fetchrow ) {
|
||
$itemlocation{$authorisedvalue} = $lib;
|
||
}
|
||
$authvalsth->finish;
|
||
return \%itemlocation;
|
||
exit 1;
|
||
}
|
||
else {
|
||
|
||
#No authvalue list
|
||
# build default
|
||
}
|
||
$sth->finish;
|
||
}
|
||
|
||
#No authvalue list
|
||
#build default
|
||
$itemlocation{"1"} = "Not For Loan";
|
||
return \%itemlocation;
|
||
}
|
||
|
||
=head2 &GetBiblioItemData
|
||
|
||
$itemdata = &GetBiblioItemData($biblioitemnumber);
|
||
|
||
Looks up the biblioitem with the given biblioitemnumber. Returns a
|
||
reference-to-hash. The keys are the fields from the C<biblio>,
|
||
C<biblioitems>, and C<itemtypes> tables in the Koha database, except
|
||
that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
|
||
|
||
=cut
|
||
|
||
#'
|
||
sub GetBiblioItemData {
|
||
my ($bibitem) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
my $sth =
|
||
$dbh->prepare(
|
||
"Select *,biblioitems.notes as bnotes from biblioitems, biblio,itemtypes where biblio.biblionumber = biblioitems.biblionumber and biblioitemnumber = ? and biblioitems.itemtype = itemtypes.itemtype"
|
||
);
|
||
my $data;
|
||
|
||
$sth->execute($bibitem);
|
||
|
||
$data = $sth->fetchrow_hashref;
|
||
|
||
$sth->finish;
|
||
return ($data);
|
||
} # sub &GetBiblioItemData
|
||
|
||
=head2 GetItemFromBarcode
|
||
|
||
$result = GetItemFromBarcode($barcode);
|
||
|
||
=cut
|
||
|
||
sub GetItemFromBarcode {
|
||
my ($barcode) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
|
||
my $rq =
|
||
$dbh->prepare("SELECT itemnumber from items where items.barcode=?");
|
||
$rq->execute($barcode);
|
||
my ($result) = $rq->fetchrow;
|
||
return ($result);
|
||
}
|
||
|
||
=head2 GetBiblioItemByBiblioNumber
|
||
|
||
NOTE : This function has been copy/paste from C4/Biblio.pm from head before zebra integration.
|
||
|
||
=cut
|
||
|
||
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 ) {
|
||
push @results, $data;
|
||
}
|
||
|
||
$sth->finish;
|
||
return @results;
|
||
}
|
||
|
||
=head2 GetBiblioFromItemNumber
|
||
|
||
$item = &GetBiblioFromItemNumber($itemnumber);
|
||
|
||
Looks up the item with the given itemnumber.
|
||
|
||
C<&itemnodata> returns a reference-to-hash whose keys are the fields
|
||
from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
|
||
database.
|
||
|
||
=cut
|
||
|
||
#'
|
||
sub GetBiblioFromItemNumber {
|
||
my ( $itemnumber ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
my $env;
|
||
my $sth = $dbh->prepare(
|
||
"SELECT * FROM biblio,items,biblioitems
|
||
WHERE items.itemnumber = ?
|
||
AND biblio.biblionumber = items.biblionumber
|
||
AND biblioitems.biblioitemnumber = items.biblioitemnumber"
|
||
);
|
||
|
||
$sth->execute($itemnumber);
|
||
my $data = $sth->fetchrow_hashref;
|
||
$sth->finish;
|
||
return ($data);
|
||
}
|
||
|
||
=head2 GetBiblio
|
||
|
||
( $count, @results ) = &GetBiblio($biblionumber);
|
||
|
||
=cut
|
||
|
||
sub GetBiblio {
|
||
my ($biblionumber) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
my $sth = $dbh->prepare("Select * from biblio 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 GetBiblio
|
||
|
||
=head2 getitemsbybiblioitem
|
||
|
||
( $count, @results ) = &getitemsbybiblioitem($biblioitemnum);
|
||
|
||
=cut
|
||
|
||
sub getitemsbybiblioitem {
|
||
my ($biblioitemnum) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
my $sth = $dbh->prepare(
|
||
"Select * from items, biblio where
|
||
biblio.biblionumber = items.biblionumber and biblioitemnumber
|
||
= ?"
|
||
);
|
||
|
||
# || die "Cannot prepare $query\n" . $dbh->errstr;
|
||
my $count = 0;
|
||
my @results;
|
||
|
||
$sth->execute($biblioitemnum);
|
||
|
||
# || die "Cannot execute $query\n" . $sth->errstr;
|
||
while ( my $data = $sth->fetchrow_hashref ) {
|
||
$results[$count] = $data;
|
||
$count++;
|
||
} # while
|
||
|
||
$sth->finish;
|
||
return ( $count, @results );
|
||
} # sub getitemsbybiblioitem
|
||
|
||
=head2 get_itemnumbers_of
|
||
|
||
my @itemnumbers_of = get_itemnumbers_of(@biblionumbers);
|
||
|
||
Given a list of biblionumbers, return the list of corresponding itemnumbers
|
||
for each biblionumber.
|
||
|
||
Return a reference on a hash where keys are biblionumbers and values are
|
||
references on array of itemnumbers.
|
||
|
||
=cut
|
||
|
||
sub get_itemnumbers_of {
|
||
my @biblionumbers = @_;
|
||
|
||
my $dbh = C4::Context->dbh;
|
||
|
||
my $query = '
|
||
SELECT itemnumber,
|
||
biblionumber
|
||
FROM items
|
||
WHERE biblionumber IN (?' . ( ',?' x scalar @biblionumbers - 1 ) . ')
|
||
';
|
||
my $sth = $dbh->prepare($query);
|
||
$sth->execute(@biblionumbers);
|
||
|
||
my %itemnumbers_of;
|
||
|
||
while ( my ( $itemnumber, $biblionumber ) = $sth->fetchrow_array ) {
|
||
push @{ $itemnumbers_of{$biblionumber} }, $itemnumber;
|
||
}
|
||
|
||
return \%itemnumbers_of;
|
||
}
|
||
|
||
=head2 getRecord
|
||
|
||
$record = getRecord( $server, $koha_query, $recordSyntax );
|
||
|
||
get a single record in piggyback mode from Zebra and return it in the requested record syntax
|
||
|
||
default record syntax is XML
|
||
|
||
=cut
|
||
|
||
sub getRecord {
|
||
my ( $server, $koha_query, $recordSyntax ) = @_;
|
||
$recordSyntax = "xml" unless $recordSyntax;
|
||
my $Zconn = C4::Context->Zconn( $server, 0, 1, 1, $recordSyntax );
|
||
my $rs = $Zconn->search( new ZOOM::Query::CCL2RPN( $koha_query, $Zconn ) );
|
||
if ( $rs->record(0) ) {
|
||
return $rs->record(0)->raw();
|
||
}
|
||
}
|
||
|
||
=head2 GetItemInfosOf
|
||
|
||
GetItemInfosOf(@itemnumbers);
|
||
|
||
=cut
|
||
|
||
sub GetItemInfosOf {
|
||
my @itemnumbers = @_;
|
||
|
||
my $query = '
|
||
SELECT *
|
||
FROM items
|
||
WHERE itemnumber IN (' . join( ',', @itemnumbers ) . ')
|
||
';
|
||
return get_infos_of( $query, 'itemnumber' );
|
||
}
|
||
|
||
=head2 GetBiblioItemInfosOf
|
||
|
||
GetBiblioItemInfosOf(@biblioitemnumbers);
|
||
|
||
=cut
|
||
|
||
sub GetBiblioItemInfosOf {
|
||
my @biblioitemnumbers = @_;
|
||
|
||
my $query = '
|
||
SELECT biblioitemnumber,
|
||
publicationyear,
|
||
itemtype
|
||
FROM biblioitems
|
||
WHERE biblioitemnumber IN (' . join( ',', @biblioitemnumbers ) . ')
|
||
';
|
||
return get_infos_of( $query, 'biblioitemnumber' );
|
||
}
|
||
|
||
=head2 z3950_extended_services
|
||
|
||
z3950_extended_services($serviceType,$serviceOptions,$record);
|
||
|
||
z3950_extended_services is used to handle all interactions with Zebra's extended serices package, which is employed to perform all management of the MARC data stored in Zebra.
|
||
|
||
C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
|
||
|
||
C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
|
||
|
||
action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
|
||
|
||
and maybe
|
||
|
||
recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
|
||
syntax => the record syntax (transfer syntax)
|
||
databaseName = Database from connection object
|
||
|
||
To set serviceOptions, call set_service_options($serviceType)
|
||
|
||
C<$record> the record, if one is needed for the service type
|
||
|
||
A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
|
||
|
||
=cut
|
||
|
||
sub z3950_extended_services {
|
||
my ( $server, $serviceType, $action, $serviceOptions ) = @_;
|
||
|
||
# get our connection object
|
||
my $Zconn = C4::Context->Zconn( $server, 0, 1 );
|
||
|
||
# create a new package object
|
||
my $Zpackage = $Zconn->package();
|
||
|
||
# set our options
|
||
$Zpackage->option( action => $action );
|
||
|
||
if ( $serviceOptions->{'databaseName'} ) {
|
||
$Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
|
||
}
|
||
if ( $serviceOptions->{'recordIdNumber'} ) {
|
||
$Zpackage->option(
|
||
recordIdNumber => $serviceOptions->{'recordIdNumber'} );
|
||
}
|
||
if ( $serviceOptions->{'recordIdOpaque'} ) {
|
||
$Zpackage->option(
|
||
recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
|
||
}
|
||
|
||
# this is an ILL request (Zebra doesn't support it, but Koha could eventually)
|
||
#if ($serviceType eq 'itemorder') {
|
||
# $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
|
||
# $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
|
||
# $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
|
||
# $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
|
||
#}
|
||
|
||
if ( $serviceOptions->{record} ) {
|
||
$Zpackage->option( record => $serviceOptions->{record} );
|
||
|
||
# can be xml or marc
|
||
if ( $serviceOptions->{'syntax'} ) {
|
||
$Zpackage->option( syntax => $serviceOptions->{'syntax'} );
|
||
}
|
||
}
|
||
|
||
# send the request, handle any exception encountered
|
||
eval { $Zpackage->send($serviceType) };
|
||
if ( $@ && $@->isa("ZOOM::Exception") ) {
|
||
return "error: " . $@->code() . " " . $@->message() . "\n";
|
||
}
|
||
|
||
# free up package resources
|
||
$Zpackage->destroy();
|
||
}
|
||
|
||
=head2 set_service_options
|
||
|
||
my $serviceOptions = set_service_options($serviceType);
|
||
|
||
C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
|
||
|
||
Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
|
||
|
||
=cut
|
||
|
||
sub set_service_options {
|
||
my ($serviceType) = @_;
|
||
my $serviceOptions;
|
||
|
||
# FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
|
||
# $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
|
||
|
||
if ( $serviceType eq 'commit' ) {
|
||
|
||
# nothing to do
|
||
}
|
||
if ( $serviceType eq 'create' ) {
|
||
|
||
# nothing to do
|
||
}
|
||
if ( $serviceType eq 'drop' ) {
|
||
die "ERROR: 'drop' not currently supported (by Zebra)";
|
||
}
|
||
return $serviceOptions;
|
||
}
|
||
|
||
=head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
|
||
|
||
=head2 MARCgettagslib
|
||
|
||
=cut
|
||
|
||
sub MARCgettagslib {
|
||
my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
|
||
$frameworkcode = "" unless $frameworkcode;
|
||
my $sth;
|
||
my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
|
||
|
||
# check that framework exists
|
||
$sth =
|
||
$dbh->prepare(
|
||
"select count(*) from marc_tag_structure where frameworkcode=?");
|
||
$sth->execute($frameworkcode);
|
||
my ($total) = $sth->fetchrow;
|
||
$frameworkcode = "" unless ( $total > 0 );
|
||
$sth =
|
||
$dbh->prepare(
|
||
"select tagfield,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,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;
|
||
}
|
||
|
||
=head2 MARCfind_marc_from_kohafield
|
||
|
||
=cut
|
||
|
||
sub MARCfind_marc_from_kohafield {
|
||
my ( $dbh, $kohafield, $frameworkcode ) = @_;
|
||
return 0, 0 unless $kohafield;
|
||
my $relations = C4::Context->marcfromkohafield;
|
||
return (
|
||
$relations->{$frameworkcode}->{$kohafield}->[0],
|
||
$relations->{$frameworkcode}->{$kohafield}->[1]
|
||
);
|
||
}
|
||
|
||
=head2 MARCaddbiblio
|
||
|
||
&MARCaddbiblio($newrec,$biblionumber,$frameworkcode);
|
||
|
||
Add MARC data for a biblio to koha
|
||
|
||
=cut
|
||
|
||
sub MARCaddbiblio {
|
||
|
||
# pass the MARC::Record to this function, and it will create the records in the marc tables
|
||
my ( $record, $biblionumber, $frameworkcode ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
my @fields = $record->fields();
|
||
if ( !$frameworkcode ) {
|
||
$frameworkcode = "";
|
||
}
|
||
my $sth =
|
||
$dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
|
||
$sth->execute( $frameworkcode, $biblionumber );
|
||
$sth->finish;
|
||
my $encoding = C4::Context->preference("marcflavour");
|
||
|
||
# deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
|
||
if ( $encoding eq "UNIMARC" ) {
|
||
my $string;
|
||
if ( $record->subfield( 100, "a" ) ) {
|
||
$string = $record->subfield( 100, "a" );
|
||
my $f100 = $record->field(100);
|
||
$record->delete_field($f100);
|
||
}
|
||
else {
|
||
$string = POSIX::strftime( "%Y%m%d", localtime );
|
||
$string =~ s/\-//g;
|
||
$string = sprintf( "%-*s", 35, $string );
|
||
}
|
||
substr( $string, 22, 6, "frey50" );
|
||
unless ( $record->subfield( 100, "a" ) ) {
|
||
$record->insert_grouped_field(
|
||
MARC::Field->new( 100, "", "", "a" => $string ) );
|
||
}
|
||
}
|
||
# warn "biblionumber : ".$biblionumber;
|
||
$sth =
|
||
$dbh->prepare(
|
||
"update biblioitems set marc=?,marcxml=? where biblionumber=?");
|
||
$sth->execute( $record->as_usmarc(), $record->as_xml_record(),
|
||
$biblionumber );
|
||
# warn $record->as_xml_record();
|
||
$sth->finish;
|
||
zebraop($dbh,$biblionumber,"specialUpdate","biblioserver");
|
||
return $biblionumber;
|
||
}
|
||
|
||
=head2 MARCadditem
|
||
|
||
$newbiblionumber = MARCadditem( $record, $biblionumber, $frameworkcode );
|
||
|
||
=cut
|
||
|
||
sub MARCadditem {
|
||
|
||
# pass the MARC::Record to this function, and it will create the records in the marc tables
|
||
my ( $record, $biblionumber, $frameworkcode ) = @_;
|
||
my $newrec = &GetMarcBiblio($biblionumber);
|
||
|
||
# 2nd recreate it
|
||
my @fields = $record->fields();
|
||
foreach my $field (@fields) {
|
||
$newrec->append_fields($field);
|
||
}
|
||
|
||
# FIXME: should we be making sure the biblionumbers are the same?
|
||
my $newbiblionumber =
|
||
&MARCaddbiblio( $newrec, $biblionumber, $frameworkcode );
|
||
return $newbiblionumber;
|
||
}
|
||
|
||
=head2 GetMarcBiblio
|
||
|
||
Returns MARC::Record of the biblionumber passed in parameter.
|
||
|
||
=cut
|
||
|
||
sub GetMarcBiblio {
|
||
my $biblionumber = shift;
|
||
my $dbh = C4::Context->dbh;
|
||
my $sth =
|
||
$dbh->prepare("select marcxml from biblioitems where biblionumber=? ");
|
||
$sth->execute($biblionumber);
|
||
my ($marcxml) = $sth->fetchrow;
|
||
# warn "marcxml : $marcxml";
|
||
MARC::File::XML->default_record_format(C4::Context->preference('marcflavour'));
|
||
$marcxml =~ s/\x1e//g;
|
||
$marcxml =~ s/\x1f//g;
|
||
$marcxml =~ s/\x1d//g;
|
||
$marcxml =~ s/\x0f//g;
|
||
$marcxml =~ s/\x0c//g;
|
||
my $record = MARC::Record->new();
|
||
$record = MARC::Record::new_from_xml( $marcxml, "utf8",C4::Context->preference('marcflavour')) if $marcxml;
|
||
return $record;
|
||
}
|
||
|
||
=head2 GetXmlBiblio
|
||
|
||
my $marcxml = GetXmlBiblio($biblionumber);
|
||
|
||
Returns biblioitems.marcxml of the biblionumber passed in parameter.
|
||
|
||
=cut
|
||
|
||
sub GetXmlBiblio {
|
||
my ( $biblionumber ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
my $sth =
|
||
$dbh->prepare("select marcxml from biblioitems where biblionumber=? ");
|
||
$sth->execute($biblionumber);
|
||
my ($marcxml) = $sth->fetchrow;
|
||
return $marcxml;
|
||
}
|
||
|
||
=head2 GetAuthorisedValueDesc
|
||
|
||
my $subfieldvalue =get_authorised_value_desc(
|
||
$tag, $subf[$i][0],$subf[$i][1], '', $taglib);
|
||
|
||
=cut
|
||
|
||
sub GetAuthorisedValueDesc {
|
||
my ( $tag, $subfield, $value, $framework, $tagslib ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
|
||
#---- branch
|
||
if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
|
||
return C4::Branch::GetBranchName($value);
|
||
}
|
||
|
||
#---- itemtypes
|
||
if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
|
||
return getitemtypeinfo($value);
|
||
}
|
||
|
||
#---- "true" authorized value
|
||
my $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
|
||
|
||
if ( $category ne "" ) {
|
||
my $sth =
|
||
$dbh->prepare(
|
||
"select lib from authorised_values where category = ? and authorised_value = ?"
|
||
);
|
||
$sth->execute( $category, $value );
|
||
my $data = $sth->fetchrow_hashref;
|
||
return $data->{'lib'};
|
||
}
|
||
else {
|
||
return $value; # if nothing is found return the original value
|
||
}
|
||
}
|
||
|
||
=head2 MARCgetitem
|
||
|
||
Returns MARC::Record of the item passed in parameter.
|
||
|
||
=cut
|
||
|
||
sub MARCgetitem {
|
||
my ( $biblionumber, $itemnumber ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
my $newrecord = MARC::Record->new();
|
||
my $marcflavour = C4::Context->preference('marcflavour');
|
||
|
||
my $marcxml = GetXmlBiblio($biblionumber);
|
||
my $record = MARC::Record->new();
|
||
# warn "marcxml :$marcxml";
|
||
$record = MARC::Record::new_from_xml( $marcxml, "utf8", $marcflavour );
|
||
# warn "record :".$record->as_formatted;
|
||
# now, find where the itemnumber is stored & extract only the item
|
||
my ( $itemnumberfield, $itemnumbersubfield ) =
|
||
MARCfind_marc_from_kohafield( $dbh, 'items.itemnumber', '' );
|
||
my @fields = $record->field($itemnumberfield);
|
||
foreach my $field (@fields) {
|
||
if ( $field->subfield($itemnumbersubfield) eq $itemnumber ) {
|
||
$newrecord->insert_fields_ordered($field);
|
||
}
|
||
}
|
||
return $newrecord;
|
||
}
|
||
|
||
=head2 GetMarcNotes
|
||
|
||
$marcnotesarray = GetMarcNotes( $record, $marcflavour );
|
||
|
||
get a single record in piggyback mode from Zebra and return it in the requested record syntax
|
||
|
||
default record syntax is XML
|
||
|
||
=cut
|
||
|
||
sub GetMarcNotes {
|
||
my ( $record, $marcflavour ) = @_;
|
||
my $scope;
|
||
if ( $marcflavour eq "MARC21" ) {
|
||
$scope = '5..';
|
||
}
|
||
else { # assume unimarc if not marc21
|
||
$scope = '3..';
|
||
}
|
||
my @marcnotes;
|
||
my $note = "";
|
||
my $tag = "";
|
||
my $marcnote;
|
||
foreach my $field ( $record->field($scope) ) {
|
||
my $value = $field->as_string();
|
||
if ( $note ne "" ) {
|
||
$marcnote = { marcnote => $note, };
|
||
push @marcnotes, $marcnote;
|
||
$note = $value;
|
||
}
|
||
if ( $note ne $value ) {
|
||
$note = $note . " " . $value;
|
||
}
|
||
}
|
||
|
||
if ( $note ) {
|
||
$marcnote = { marcnote => $note };
|
||
push @marcnotes, $marcnote; #load last tag into array
|
||
}
|
||
return \@marcnotes;
|
||
} # end GetMarcNotes
|
||
|
||
=head2 GetMarcSubjects
|
||
|
||
$marcsubjcts = GetMarcSubjects($record,$marcflavour);
|
||
|
||
=cut
|
||
|
||
sub GetMarcSubjects {
|
||
my ( $record, $marcflavour ) = @_;
|
||
my ( $mintag, $maxtag );
|
||
if ( $marcflavour eq "MARC21" ) {
|
||
$mintag = "600";
|
||
$maxtag = "699";
|
||
}
|
||
else { # assume unimarc if not marc21
|
||
$mintag = "600";
|
||
$maxtag = "611";
|
||
}
|
||
|
||
my @marcsubjcts;
|
||
|
||
foreach my $field ( $record->fields ) {
|
||
next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
|
||
my @subfields = $field->subfields();
|
||
my $link;
|
||
my $label = "su:";
|
||
my $flag = 0;
|
||
for my $subject_subfield ( @subfields ) {
|
||
my $code = $subject_subfield->[0];
|
||
$label .= $subject_subfield->[1] . " and su-to:" unless ( $code == 9 );
|
||
if ( $code == 9 ) {
|
||
$link = "Koha-Auth-Number:".$subject_subfield->[1];
|
||
$flag = 1;
|
||
}
|
||
elsif ( ! $flag ) {
|
||
$link = $label;
|
||
$link =~ s/ and\ssu-to:$//;
|
||
}
|
||
}
|
||
$label =~ s/su/ /g;
|
||
$label =~ s/://g;
|
||
$label =~ s/-to//g;
|
||
$label =~ s/and//g;
|
||
push @marcsubjcts,
|
||
{
|
||
label => $label,
|
||
link => $link
|
||
}
|
||
}
|
||
return \@marcsubjcts;
|
||
} #end GetMarcSubjects
|
||
|
||
=head2 GetMarcAuthors
|
||
|
||
authors = GetMarcAuthors($record,$marcflavour);
|
||
|
||
=cut
|
||
|
||
sub GetMarcAuthors {
|
||
my ( $record, $marcflavour ) = @_;
|
||
my ( $mintag, $maxtag );
|
||
if ( $marcflavour eq "MARC21" ) {
|
||
$mintag = "100";
|
||
$maxtag = "111";
|
||
}
|
||
else { # assume unimarc if not marc21
|
||
$mintag = "701";
|
||
$maxtag = "712";
|
||
}
|
||
|
||
my @marcauthors;
|
||
|
||
foreach my $field ( $record->fields ) {
|
||
next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
|
||
my %hash;
|
||
my @subfields = $field->subfields();
|
||
my $count_auth = 0;
|
||
my $and ;
|
||
for my $authors_subfield (@subfields) {
|
||
if ($count_auth ne '0'){
|
||
$and = " and au:";
|
||
}
|
||
$count_auth++;
|
||
my $subfieldcode = $authors_subfield->[0];
|
||
my $value = $authors_subfield->[1];
|
||
$hash{'tag'} = $field->tag;
|
||
$hash{value} .= $value . " " if ($subfieldcode != 9) ;
|
||
$hash{link} .= $value if ($subfieldcode eq 9);
|
||
}
|
||
push @marcauthors, \%hash;
|
||
}
|
||
return \@marcauthors;
|
||
}
|
||
|
||
=head2 GetMarcSeries
|
||
|
||
$marcseriessarray = GetMarcSeries($record,$marcflavour);
|
||
|
||
=cut
|
||
|
||
sub GetMarcSeries {
|
||
my ($record, $marcflavour) = @_;
|
||
my ($mintag, $maxtag);
|
||
if ($marcflavour eq "MARC21") {
|
||
$mintag = "440";
|
||
$maxtag = "490";
|
||
} else { # assume unimarc if not marc21
|
||
$mintag = "600";
|
||
$maxtag = "619";
|
||
}
|
||
|
||
my @marcseries;
|
||
my $subjct = "";
|
||
my $subfield = "";
|
||
my $marcsubjct;
|
||
|
||
foreach my $field ($record->field('440'), $record->field('490')) {
|
||
my @subfields_loop;
|
||
#my $value = $field->subfield('a');
|
||
#$marcsubjct = {MARCSUBJCT => $value,};
|
||
my @subfields = $field->subfields();
|
||
#warn "subfields:".join " ", @$subfields;
|
||
my $counter = 0;
|
||
my @link_loop;
|
||
for my $series_subfield (@subfields) {
|
||
my $volume_number;
|
||
undef $volume_number;
|
||
# see if this is an instance of a volume
|
||
if ($series_subfield->[0] eq 'v') {
|
||
$volume_number=1;
|
||
}
|
||
|
||
my $code = $series_subfield->[0];
|
||
my $value = $series_subfield->[1];
|
||
my $linkvalue = $value;
|
||
$linkvalue =~ s/(\(|\))//g;
|
||
my $operator = " and " unless $counter==0;
|
||
push @link_loop, {link => $linkvalue, operator => $operator };
|
||
my $separator = C4::Context->preference("authoritysep") unless $counter==0;
|
||
if ($volume_number) {
|
||
push @subfields_loop, {volumenum => $value};
|
||
}
|
||
else {
|
||
push @subfields_loop, {code => $code, value => $value, link_loop => \@link_loop, separator => $separator, volumenum => $volume_number};
|
||
}
|
||
$counter++;
|
||
}
|
||
push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
|
||
#$marcsubjct = {MARCSUBJCT => $field->as_string(),};
|
||
#push @marcsubjcts, $marcsubjct;
|
||
#$subjct = $value;
|
||
|
||
}
|
||
my $marcseriessarray=\@marcseries;
|
||
return $marcseriessarray;
|
||
} #end getMARCseriess
|
||
|
||
=head2 MARCmodbiblio
|
||
|
||
MARCmodbibio($dbh,$biblionumber,$record,$frameworkcode,1);
|
||
|
||
Modify a biblio record with the option to save items data
|
||
|
||
=cut
|
||
|
||
sub MARCmodbiblio {
|
||
my ( $dbh, $biblionumber, $record, $frameworkcode, $keep_items ) = @_;
|
||
|
||
# delete original record but save the items
|
||
my $newrec = &MARCdelbiblio( $biblionumber, $keep_items );
|
||
|
||
# recreate it and add the new fields
|
||
my @fields = $record->fields();
|
||
foreach my $field (@fields) {
|
||
|
||
# this requires a more recent version of MARC::Record
|
||
# but ensures the fields are in order
|
||
$newrec->insert_fields_ordered($field);
|
||
}
|
||
|
||
# give back our old leader
|
||
$newrec->leader( $record->leader() );
|
||
|
||
# add the record back with the items info preserved
|
||
&MARCaddbiblio( $newrec, $biblionumber, $frameworkcode );
|
||
}
|
||
|
||
=head2 MARCdelbiblio
|
||
|
||
&MARCdelbiblio( $biblionumber, $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
|
||
|
||
=cut
|
||
|
||
sub MARCdelbiblio {
|
||
my ( $biblionumber, $keep_items ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
|
||
my $record = GetMarcBiblio($biblionumber);
|
||
my $oldbiblionumber = $biblionumber;
|
||
my $copy2deleted =
|
||
$dbh->prepare("update deletedbiblio set marc=? where biblionumber=?");
|
||
$copy2deleted->execute( $record->as_usmarc(), $oldbiblionumber );
|
||
my @fields = $record->fields();
|
||
|
||
# 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};
|
||
|
||
foreach my $field (@fields) {
|
||
|
||
if ( $field->tag() ne $itemtag ) {
|
||
$record->delete_field($field);
|
||
} #if
|
||
} #foreach
|
||
}
|
||
else {
|
||
foreach my $field (@fields) {
|
||
|
||
$record->delete_field($field);
|
||
} #foreach
|
||
}
|
||
return $record;
|
||
}
|
||
|
||
=head2 MARCdelitem
|
||
|
||
MARCdelitem( $biblionumber, $itemnumber )
|
||
|
||
delete the item field from the MARC record for the itemnumber specified
|
||
|
||
=cut
|
||
|
||
sub MARCdelitem {
|
||
my ( $biblionumber, $itemnumber ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
|
||
# get the MARC record
|
||
my $record = GetMarcBiblio($biblionumber);
|
||
|
||
# backup the record
|
||
my $copy2deleted =
|
||
$dbh->prepare("UPDATE deleteditems SET marc=? WHERE itemnumber=?");
|
||
$copy2deleted->execute( $record->as_usmarc(), $itemnumber );
|
||
|
||
#search item field code
|
||
my $sth =
|
||
$dbh->prepare(
|
||
"SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE kohafield LIKE 'items.itemnumber'"
|
||
);
|
||
$sth->execute;
|
||
my ( $itemtag, $itemsubfield ) = $sth->fetchrow;
|
||
my @fields = $record->field($itemtag);
|
||
# delete the item specified
|
||
foreach my $field (@fields) {
|
||
if ( $field->subfield($itemsubfield) eq $itemnumber ) {
|
||
$record->delete_field($field);
|
||
}
|
||
}
|
||
return $record;
|
||
}
|
||
|
||
=head2 MARCmoditemonefield
|
||
|
||
&MARCmoditemonefield( $biblionumber, $itemnumber, $itemfield, $newvalue )
|
||
|
||
=cut
|
||
|
||
sub MARCmoditemonefield {
|
||
my ( $biblionumber, $itemnumber, $itemfield, $newvalue ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
if ( !defined $newvalue ) {
|
||
$newvalue = "";
|
||
}
|
||
|
||
my $record = MARCgetitem( $biblionumber, $itemnumber );
|
||
|
||
my $sth =
|
||
$dbh->prepare(
|
||
"select tagfield,tagsubfield from marc_subfield_structure where kohafield=?"
|
||
);
|
||
my $tagfield;
|
||
my $tagsubfield;
|
||
$sth->execute($itemfield);
|
||
if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
|
||
my $tag = $record->field($tagfield);
|
||
if ($tag) {
|
||
my $tagsubs = $record->field($tagfield)->subfield($tagsubfield);
|
||
$tag->update( $tagsubfield => $newvalue );
|
||
$record->delete_field($tag);
|
||
$record->insert_fields_ordered($tag);
|
||
&MARCmoditem( $record, $biblionumber, $itemnumber, 0 );
|
||
}
|
||
}
|
||
}
|
||
|
||
=head2 MARCmoditem
|
||
|
||
&MARCmoditem( $record, $biblionumber, $itemnumber, $frameworkcode, $delete )
|
||
|
||
=cut
|
||
|
||
sub MARCmoditem {
|
||
my ( $record, $biblionumber, $itemnumber, $frameworkcode, $delete ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
|
||
# delete this item from MARC
|
||
my $newrec = &MARCdelitem( $biblionumber, $itemnumber );
|
||
|
||
# 2nd recreate it
|
||
my @fields = $record->fields();
|
||
###NEU specific add cataloguers cardnumber as well
|
||
my $cardtag = C4::Context->preference('itemcataloguersubfield');
|
||
|
||
foreach my $field (@fields) {
|
||
if ($cardtag) {
|
||
my $me = C4::Context->userenv;
|
||
my $cataloguer = $me->{'cardnumber'} if ($me);
|
||
$field->update( $cardtag => $cataloguer ) if ($me);
|
||
}
|
||
$newrec->append_fields($field);
|
||
}
|
||
&MARCaddbiblio( $newrec, $biblionumber, $frameworkcode );
|
||
}
|
||
|
||
=head2 MARCfind_frameworkcode
|
||
|
||
$frameworkcode = MARCfind_frameworkcode( $biblionumber )
|
||
|
||
=cut
|
||
|
||
sub MARCfind_frameworkcode {
|
||
my ( $biblionumber ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
my $sth =
|
||
$dbh->prepare("select frameworkcode from biblio where biblionumber=?");
|
||
$sth->execute($biblionumber);
|
||
my ($frameworkcode) = $sth->fetchrow;
|
||
return $frameworkcode;
|
||
}
|
||
|
||
=head2 Koha2Marc
|
||
|
||
$record = Koha2Marc( $hash )
|
||
|
||
This function builds partial MARC::Record from a hash
|
||
|
||
Hash entries can be from biblio or biblioitems.
|
||
|
||
This function is called in acquisition module, to create a basic catalogue entry from user entry
|
||
|
||
=cut
|
||
|
||
sub Koha2Marc {
|
||
|
||
my ( $hash ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
my $sth =
|
||
$dbh->prepare(
|
||
"select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
|
||
);
|
||
my $record = MARC::Record->new();
|
||
foreach (keys %{$hash}) {
|
||
&MARCkoha2marcOnefield( $sth, $record, $_,
|
||
$hash->{$_}, '' );
|
||
}
|
||
return $record;
|
||
}
|
||
|
||
=head2 MARCkoha2marcBiblio
|
||
|
||
$record = MARCkoha2marcBiblio( $biblionumber, $biblioitemnumber )
|
||
|
||
this function builds partial MARC::Record from the old koha-DB fields
|
||
|
||
=cut
|
||
|
||
sub MARCkoha2marcBiblio {
|
||
|
||
my ( $biblionumber, $biblioitemnumber ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
my $sth =
|
||
$dbh->prepare(
|
||
"select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
|
||
);
|
||
my $record = MARC::Record->new();
|
||
|
||
#--- if biblionumber, then retrieve old-style koha data
|
||
if ( $biblionumber > 0 ) {
|
||
my $sth2 = $dbh->prepare(
|
||
"select biblionumber,author,title,unititle,notes,abstract,serial,seriestitle,copyrightdate,timestamp
|
||
from biblio where biblionumber=?"
|
||
);
|
||
$sth2->execute($biblionumber);
|
||
my $row = $sth2->fetchrow_hashref;
|
||
my $code;
|
||
foreach $code ( keys %$row ) {
|
||
if ( $row->{$code} ) {
|
||
&MARCkoha2marcOnefield( $sth, $record, "biblio." . $code,
|
||
$row->{$code}, '' );
|
||
}
|
||
}
|
||
}
|
||
|
||
#--- if biblioitem, then retrieve old-style koha data
|
||
if ( $biblioitemnumber > 0 ) {
|
||
my $sth2 = $dbh->prepare(
|
||
" SELECT biblioitemnumber,biblionumber,volume,number,classification,
|
||
itemtype,url,isbn,issn,dewey,subclass,publicationyear,publishercode,
|
||
volumedate,volumeddesc,timestamp,illus,pages,notes AS bnotes,size,place
|
||
FROM biblioitems
|
||
WHERE biblioitemnumber=?
|
||
"
|
||
);
|
||
$sth2->execute($biblioitemnumber);
|
||
my $row = $sth2->fetchrow_hashref;
|
||
my $code;
|
||
foreach $code ( keys %$row ) {
|
||
if ( $row->{$code} ) {
|
||
&MARCkoha2marcOnefield( $sth, $record, "biblioitems." . $code,
|
||
$row->{$code}, '' );
|
||
}
|
||
}
|
||
}
|
||
return $record;
|
||
}
|
||
|
||
=head2 MARCkoha2marcItem
|
||
|
||
$record = MARCkoha2marcItem( $dbh, $biblionumber, $itemnumber );
|
||
|
||
=cut
|
||
|
||
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 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,
|
||
booksellerid,homebranch,price,replacementprice,replacementpricedate,datelastborrowed,
|
||
datelastseen,multivolume,stack,notforloan,itemlost,wthdrawn,itemcallnumber,issues,renewals,
|
||
reserves,restricted,binding,itemnotes,holdingbranch,timestamp,onloan,Cutterextra
|
||
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}, '' );
|
||
}
|
||
}
|
||
}
|
||
return $record;
|
||
}
|
||
|
||
=head2 MARCkoha2marcOnefield
|
||
|
||
$record = MARCkoha2marcOnefield( $sth, $record, $kohafieldname, $value, $frameworkcode );
|
||
|
||
=cut
|
||
|
||
sub MARCkoha2marcOnefield {
|
||
my ( $sth, $record, $kohafieldname, $value, $frameworkcode ) = @_;
|
||
$frameworkcode='' unless $frameworkcode;
|
||
my $tagfield;
|
||
my $tagsubfield;
|
||
|
||
if ( !defined $sth ) {
|
||
my $dbh = C4::Context->dbh;
|
||
$sth =
|
||
$dbh->prepare(
|
||
"select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
|
||
);
|
||
}
|
||
$sth->execute( $frameworkcode, $kohafieldname );
|
||
if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
|
||
my $tag = $record->field($tagfield);
|
||
if ($tag) {
|
||
$tag->update( $tagsubfield => $value );
|
||
$record->delete_field($tag);
|
||
$record->insert_fields_ordered($tag);
|
||
}
|
||
else {
|
||
$record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
|
||
}
|
||
}
|
||
return $record;
|
||
}
|
||
|
||
=head2 MARChtml2xml
|
||
|
||
$xml = MARChtml2xml( $tags, $subfields, $values, $indicator, $ind_tag )
|
||
|
||
=cut
|
||
|
||
sub MARChtml2xml {
|
||
my ( $tags, $subfields, $values, $indicator, $ind_tag ) = @_;
|
||
my $xml = MARC::File::XML::header('UTF-8');
|
||
if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
|
||
MARC::File::XML->default_record_format('UNIMARC');
|
||
use POSIX qw(strftime);
|
||
my $string = strftime( "%Y%m%d", localtime(time) );
|
||
$string = sprintf( "%-*s", 35, $string );
|
||
substr( $string, 22, 6, "frey50" );
|
||
$xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
|
||
$xml .= "<subfield code=\"a\">$string</subfield>\n";
|
||
$xml .= "</datafield>\n";
|
||
}
|
||
my $prevvalue;
|
||
my $prevtag = -1;
|
||
my $first = 1;
|
||
my $j = -1;
|
||
for ( my $i = 0 ; $i <= @$tags ; $i++ ) {
|
||
@$values[$i] =~ s/&/&/g;
|
||
@$values[$i] =~ s/</</g;
|
||
@$values[$i] =~ s/>/>/g;
|
||
@$values[$i] =~ s/"/"/g;
|
||
@$values[$i] =~ s/'/'/g;
|
||
if ( !utf8::is_utf8( @$values[$i] ) ) {
|
||
utf8::decode( @$values[$i] );
|
||
}
|
||
if ( ( @$tags[$i] ne $prevtag ) ) {
|
||
$j++ unless ( @$tags[$i] eq "" );
|
||
if ( !$first ) {
|
||
$xml .= "</datafield>\n";
|
||
if ( ( @$tags[$i] && @$tags[$i] > 10 )
|
||
&& ( @$values[$i] ne "" ) )
|
||
{
|
||
my $ind1 = substr( @$indicator[$j], 0, 1 );
|
||
my $ind2;
|
||
if ( @$indicator[$j] ) {
|
||
$ind2 = substr( @$indicator[$j], 1, 1 );
|
||
}
|
||
else {
|
||
warn "Indicator in @$tags[$i] is empty";
|
||
$ind2 = " ";
|
||
}
|
||
$xml .=
|
||
"<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
|
||
$xml .=
|
||
"<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
|
||
$first = 0;
|
||
}
|
||
else {
|
||
$first = 1;
|
||
}
|
||
}
|
||
else {
|
||
if ( @$values[$i] ne "" ) {
|
||
|
||
# leader
|
||
if ( @$tags[$i] eq "000" ) {
|
||
$xml .= "<leader>@$values[$i]</leader>\n";
|
||
$first = 1;
|
||
|
||
# rest of the fixed fields
|
||
}
|
||
elsif ( @$tags[$i] < 10 ) {
|
||
$xml .=
|
||
"<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
|
||
$first = 1;
|
||
}
|
||
else {
|
||
my $ind1 = substr( @$indicator[$j], 0, 1 );
|
||
my $ind2 = substr( @$indicator[$j], 1, 1 );
|
||
$xml .=
|
||
"<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
|
||
$xml .=
|
||
"<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
|
||
$first = 0;
|
||
}
|
||
}
|
||
}
|
||
}
|
||
else { # @$tags[$i] eq $prevtag
|
||
if ( @$values[$i] eq "" ) {
|
||
}
|
||
else {
|
||
if ($first) {
|
||
my $ind1 = substr( @$indicator[$j], 0, 1 );
|
||
my $ind2 = substr( @$indicator[$j], 1, 1 );
|
||
$xml .=
|
||
"<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
|
||
$first = 0;
|
||
}
|
||
$xml .=
|
||
"<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
|
||
}
|
||
}
|
||
$prevtag = @$tags[$i];
|
||
}
|
||
$xml .= MARC::File::XML::footer();
|
||
|
||
return $xml;
|
||
}
|
||
|
||
=head2 MARChtml2marc
|
||
|
||
$record = MARChtml2marc( $dbh, $rtags, $rsubfields, $rvalues, %indicators )
|
||
|
||
=cut
|
||
|
||
sub MARChtml2marc {
|
||
my ( $dbh, $rtags, $rsubfields, $rvalues, %indicators ) = @_;
|
||
my $prevtag = -1;
|
||
my $record = MARC::Record->new();
|
||
|
||
# my %subfieldlist=();
|
||
my $prevvalue; # if tag <10
|
||
my $field; # if tag >=10
|
||
for ( my $i = 0 ; $i < @$rtags ; $i++ ) {
|
||
next unless @$rvalues[$i];
|
||
|
||
# rebuild MARC::Record
|
||
# warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
|
||
if ( @$rtags[$i] ne $prevtag ) {
|
||
if ( $prevtag < 10 ) {
|
||
if ($prevvalue) {
|
||
|
||
if ( $prevtag ne '000' ) {
|
||
$record->insert_fields_ordered(
|
||
( sprintf "%03s", $prevtag ), $prevvalue );
|
||
}
|
||
else {
|
||
|
||
$record->leader($prevvalue);
|
||
|
||
}
|
||
}
|
||
}
|
||
else {
|
||
if ($field) {
|
||
$record->insert_fields_ordered($field);
|
||
}
|
||
}
|
||
$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]
|
||
);
|
||
}
|
||
$prevtag = @$rtags[$i];
|
||
}
|
||
else {
|
||
if ( @$rtags[$i] < 10 ) {
|
||
$prevvalue = @$rvalues[$i];
|
||
}
|
||
else {
|
||
if ( length( @$rvalues[$i] ) > 0 ) {
|
||
$field->add_subfields( @$rsubfields[$i] => @$rvalues[$i] );
|
||
}
|
||
}
|
||
$prevtag = @$rtags[$i];
|
||
}
|
||
}
|
||
|
||
# the last has not been included inside the loop... do it now !
|
||
$record->insert_fields_ordered($field) if $field;
|
||
|
||
# warn "HTML2MARC=".$record->as_formatted;
|
||
$record->encoding('UTF-8');
|
||
|
||
# $record->MARC::File::USMARC::update_leader();
|
||
return $record;
|
||
}
|
||
|
||
=head2 MARCmarc2koha
|
||
|
||
$result = MARCmarc2koha( $dbh, $record, $frameworkcode )
|
||
|
||
=cut
|
||
|
||
sub MARCmarc2koha {
|
||
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;
|
||
while ( ($field) = $sth2->fetchrow ) {
|
||
$result =
|
||
&MARCmarc2kohaOneField( "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( "biblioitems", $field, $record, $result,
|
||
$frameworkcode );
|
||
}
|
||
$sth2 = $dbh->prepare("SHOW COLUMNS from items");
|
||
$sth2->execute;
|
||
while ( ($field) = $sth2->fetchrow ) {
|
||
$result =
|
||
&MARCmarc2kohaOneField( "items", $field, $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
|
||
if ( $1 > 0 ) {
|
||
$result->{'copyrightdate'} = $1;
|
||
}
|
||
else { # if no cYYYY, get the 1st date.
|
||
$temp =~ m/(\d\d\d\d)/;
|
||
$result->{'copyrightdate'} = $1;
|
||
}
|
||
|
||
# modify publicationyear to keep only the 1st year found
|
||
$temp = $result->{'publicationyear'};
|
||
$temp =~ m/c(\d\d\d\d)/; # search cYYYY first
|
||
if ( $1 > 0 ) {
|
||
$result->{'publicationyear'} = $1;
|
||
}
|
||
else { # if no cYYYY, get the 1st date.
|
||
$temp =~ m/(\d\d\d\d)/;
|
||
$result->{'publicationyear'} = $1;
|
||
}
|
||
return $result;
|
||
}
|
||
|
||
=head2 MARCmarc2kohaOneField
|
||
|
||
$result = MARCmarc2kohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
|
||
|
||
=cut
|
||
|
||
sub MARCmarc2kohaOneField {
|
||
|
||
# FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
|
||
my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
|
||
|
||
my $res = "";
|
||
my ( $tagfield, $subfield ) =
|
||
MARCfind_marc_from_kohafield( "", $kohatable . "." . $kohafield,
|
||
$frameworkcode );
|
||
foreach my $field ( $record->field($tagfield) ) {
|
||
if ( $field->tag() < 10 ) {
|
||
if ( $result->{$kohafield} ) {
|
||
$result->{$kohafield} .= " | " . $field->data();
|
||
}
|
||
else {
|
||
$result->{$kohafield} = $field->data();
|
||
}
|
||
}
|
||
else {
|
||
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];
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
}
|
||
return $result;
|
||
}
|
||
|
||
=head2 MARCitemchange
|
||
|
||
&MARCitemchange( $record, $itemfield, $newvalue )
|
||
|
||
=cut
|
||
|
||
sub MARCitemchange {
|
||
my ( $record, $itemfield, $newvalue ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
|
||
my ( $tagfield, $tagsubfield ) =
|
||
MARCfind_marc_from_kohafield( $dbh, $itemfield, "" );
|
||
if ( ($tagfield) && ($tagsubfield) ) {
|
||
my $tag = $record->field($tagfield);
|
||
if ($tag) {
|
||
$tag->update( $tagsubfield => $newvalue );
|
||
$record->delete_field($tag);
|
||
$record->insert_fields_ordered($tag);
|
||
}
|
||
}
|
||
}
|
||
|
||
=head1 INTERNAL FUNCTIONS
|
||
|
||
=head2 _koha_add_biblio
|
||
|
||
_koha_add_biblio($dbh,$biblioitem);
|
||
|
||
Internal function to add a biblio ($biblio is a hash with the values)
|
||
|
||
=cut
|
||
|
||
sub _koha_add_biblio {
|
||
my ( $dbh, $biblio, $frameworkcode ) = @_;
|
||
my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
|
||
$sth->execute;
|
||
my $data = $sth->fetchrow_arrayref;
|
||
my $biblionumber = $$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 = ?, frameworkcode = ? "
|
||
);
|
||
$sth->execute(
|
||
$biblionumber, $biblio->{'title'},
|
||
$biblio->{'author'}, $biblio->{'copyrightdate'},
|
||
$biblio->{'serial'}, $biblio->{'seriestitle'},
|
||
$biblio->{'notes'}, $biblio->{'abstract'},
|
||
$biblio->{'unititle'}, $frameworkcode
|
||
);
|
||
|
||
$sth->finish;
|
||
return ($biblionumber);
|
||
}
|
||
|
||
=head2 _find_value
|
||
|
||
($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
|
||
|
||
Find the given $subfield in the given $tag in the given
|
||
MARC::Record $record. If the subfield is found, returns
|
||
the (indicators, value) pair; otherwise, (undef, undef) is
|
||
returned.
|
||
|
||
PROPOSITION :
|
||
Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
|
||
I suggest we export it from this module.
|
||
|
||
=cut
|
||
|
||
sub _find_value {
|
||
my ( $tagfield, $insubfield, $record, $encoding ) = @_;
|
||
my @result;
|
||
my $indicator;
|
||
if ( $tagfield < 10 ) {
|
||
if ( $record->field($tagfield) ) {
|
||
push @result, $record->field($tagfield)->data();
|
||
}
|
||
else {
|
||
push @result, "";
|
||
}
|
||
}
|
||
else {
|
||
foreach my $field ( $record->field($tagfield) ) {
|
||
my @subfields = $field->subfields();
|
||
foreach my $subfield (@subfields) {
|
||
if ( @$subfield[0] eq $insubfield ) {
|
||
push @result, @$subfield[1];
|
||
$indicator = $field->indicator(1) . $field->indicator(2);
|
||
}
|
||
}
|
||
}
|
||
}
|
||
return ( $indicator, @result );
|
||
}
|
||
|
||
=head2 _koha_modify_biblio
|
||
|
||
Internal function for updating the biblio table
|
||
|
||
=cut
|
||
|
||
sub _koha_modify_biblio {
|
||
my ( $dbh, $biblio ) = @_;
|
||
|
||
# FIXME: this code could be made more portable by not hard-coding the values that are supposed to be in biblio table
|
||
my $sth =
|
||
$dbh->prepare(
|
||
"Update biblio set title = ?, author = ?, abstract = ?, copyrightdate = ?, seriestitle = ?, serial = ?, unititle = ?, notes = ? where biblionumber = ?"
|
||
);
|
||
$sth->execute(
|
||
$biblio->{'title'}, $biblio->{'author'},
|
||
$biblio->{'abstract'}, $biblio->{'copyrightdate'},
|
||
$biblio->{'seriestitle'}, $biblio->{'serial'},
|
||
$biblio->{'unititle'}, $biblio->{'notes'},
|
||
$biblio->{'biblionumber'}
|
||
);
|
||
$sth->finish;
|
||
return ( $biblio->{'biblionumber'} );
|
||
}
|
||
|
||
=head2 _koha_modify_biblioitem
|
||
|
||
_koha_modify_biblioitem( $dbh, $biblioitem );
|
||
|
||
=cut
|
||
|
||
sub _koha_modify_biblioitem {
|
||
my ( $dbh, $biblioitem ) = @_;
|
||
my $query;
|
||
##Recalculate LC in case it changed --TG
|
||
|
||
$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'} );
|
||
$biblioitem->{'ccode'} = $dbh->quote( $biblioitem->{'ccode'} );
|
||
$biblioitem->{'biblionumber'} =
|
||
$dbh->quote( $biblioitem->{'biblionumber'} );
|
||
|
||
$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'},
|
||
dewey = $biblioitem->{'dewey'},
|
||
subclass = $biblioitem->{'subclass'},
|
||
illus = $biblioitem->{'illus'},
|
||
pages = $biblioitem->{'pages'},
|
||
volumeddesc = $biblioitem->{'volumeddesc'},
|
||
notes = $biblioitem->{'bnotes'},
|
||
size = $biblioitem->{'size'},
|
||
place = $biblioitem->{'place'},
|
||
ccode = $biblioitem->{'ccode'}
|
||
where biblionumber = $biblioitem->{'biblionumber'}";
|
||
|
||
$dbh->do($query);
|
||
if ( $dbh->errstr ) {
|
||
warn "$query";
|
||
}
|
||
}
|
||
|
||
=head2 _koha_modify_note
|
||
|
||
_koha_modify_note( $dbh, $bibitemnum, $note );
|
||
|
||
=cut
|
||
|
||
sub _koha_modify_note {
|
||
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;
|
||
}
|
||
|
||
=head2 _koha_add_biblioitem
|
||
|
||
_koha_add_biblioitem( $dbh, $biblioitem );
|
||
|
||
Internal function to add a biblioitem
|
||
|
||
=cut
|
||
|
||
sub _koha_add_biblioitem {
|
||
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->finish;
|
||
|
||
$sth = $dbh->prepare(
|
||
"INSERT INTO biblioitems SET
|
||
biblioitemnumber = ?, biblionumber = ?,
|
||
volume = ?, number = ?,
|
||
classification = ?, itemtype = ?,
|
||
url = ?, isbn = ?,
|
||
issn = ?, dewey = ?,
|
||
subclass = ?, publicationyear = ?,
|
||
publishercode = ?, volumedate = ?,
|
||
volumeddesc = ?, illus = ?,
|
||
pages = ?, notes = ?,
|
||
size = ?, lccn = ?,
|
||
marc = ?, lcsort =?,
|
||
place = ?, ccode = ?
|
||
"
|
||
);
|
||
my ($lcsort) =
|
||
calculatelc( $biblioitem->{'classification'} )
|
||
. $biblioitem->{'subclass'};
|
||
$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'},
|
||
$lcsort, $biblioitem->{'ccode'}
|
||
);
|
||
$sth->finish;
|
||
return ($bibitemnum);
|
||
}
|
||
|
||
=head2 _koha_new_items
|
||
|
||
_koha_new_items( $dbh, $item, $barcode );
|
||
|
||
=cut
|
||
|
||
sub _koha_new_items {
|
||
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;
|
||
## Now calculate lccalnumber
|
||
my ($cutterextra) = itemcalculator(
|
||
$dbh,
|
||
$item->{'biblioitemnumber'},
|
||
$item->{'itemcallnumber'}
|
||
);
|
||
|
||
# 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'} eq '' || !$item->{'dateaccessioned'} ) {
|
||
|
||
$sth = $dbh->prepare(
|
||
"Insert into items set
|
||
itemnumber = ?, biblionumber = ?,
|
||
multivolumepart = ?,
|
||
biblioitemnumber = ?, barcode = ?,
|
||
booksellerid = ?, dateaccessioned = NOW(),
|
||
homebranch = ?, holdingbranch = ?,
|
||
price = ?, replacementprice = ?,
|
||
replacementpricedate = NOW(), datelastseen = NOW(),
|
||
multivolume = ?, stack = ?,
|
||
itemlost = ?, wthdrawn = ?,
|
||
paidfor = ?, itemnotes = ?,
|
||
itemcallnumber =?, notforloan = ?,
|
||
location = ?, Cutterextra = ?
|
||
"
|
||
);
|
||
$sth->execute(
|
||
$itemnumber, $item->{'biblionumber'},
|
||
$item->{'multivolumepart'}, $item->{'biblioitemnumber'},
|
||
$barcode, $item->{'booksellerid'},
|
||
$item->{'homebranch'}, $item->{'holdingbranch'},
|
||
$item->{'price'}, $item->{'replacementprice'},
|
||
$item->{multivolume}, $item->{stack},
|
||
$item->{itemlost}, $item->{wthdrawn},
|
||
$item->{paidfor}, $item->{'itemnotes'},
|
||
$item->{'itemcallnumber'}, $item->{'notforloan'},
|
||
$item->{'location'}, $cutterextra
|
||
);
|
||
}
|
||
else {
|
||
$sth = $dbh->prepare(
|
||
"INSERT INTO items SET
|
||
itemnumber = ?, biblionumber = ?,
|
||
multivolumepart = ?,
|
||
biblioitemnumber = ?, barcode = ?,
|
||
booksellerid = ?, dateaccessioned = ?,
|
||
homebranch = ?, holdingbranch = ?,
|
||
price = ?, replacementprice = ?,
|
||
replacementpricedate = NOW(), datelastseen = NOW(),
|
||
multivolume = ?, stack = ?,
|
||
itemlost = ?, wthdrawn = ?,
|
||
paidfor = ?, itemnotes = ?,
|
||
itemcallnumber = ?, notforloan = ?,
|
||
location = ?,
|
||
Cutterextra = ?
|
||
"
|
||
);
|
||
$sth->execute(
|
||
$itemnumber, $item->{'biblionumber'},
|
||
$item->{'multivolumepart'}, $item->{'biblioitemnumber'},
|
||
$barcode, $item->{'booksellerid'},
|
||
$item->{'dateaccessioned'}, $item->{'homebranch'},
|
||
$item->{'holdingbranch'}, $item->{'price'},
|
||
$item->{'replacementprice'}, $item->{multivolume},
|
||
$item->{stack}, $item->{itemlost},
|
||
$item->{wthdrawn}, $item->{paidfor},
|
||
$item->{'itemnotes'}, $item->{'itemcallnumber'},
|
||
$item->{'notforloan'}, $item->{'location'},
|
||
$cutterextra
|
||
);
|
||
}
|
||
if ( defined $sth->errstr ) {
|
||
$error .= $sth->errstr;
|
||
}
|
||
return ( $itemnumber, $error );
|
||
}
|
||
|
||
=head2 _koha_modify_item
|
||
|
||
_koha_modify_item( $dbh, $item, $op );
|
||
|
||
=cut
|
||
|
||
sub _koha_modify_item {
|
||
my ( $dbh, $item, $op ) = @_;
|
||
$item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
|
||
|
||
# if all we're doing is setting statuses, just update those and get out
|
||
if ( $op eq "setstatus" ) {
|
||
my $query =
|
||
"UPDATE items SET itemlost=?,wthdrawn=?,binding=? WHERE itemnumber=?";
|
||
my @bind = (
|
||
$item->{'itemlost'}, $item->{'wthdrawn'},
|
||
$item->{'binding'}, $item->{'itemnumber'}
|
||
);
|
||
my $sth = $dbh->prepare($query);
|
||
$sth->execute(@bind);
|
||
$sth->finish;
|
||
return undef;
|
||
}
|
||
## Now calculate lccalnumber
|
||
my ($cutterextra) =
|
||
itemcalculator( $dbh, $item->{'bibitemnum'}, $item->{'itemcallnumber'} );
|
||
|
||
my $query = "UPDATE items SET
|
||
barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,homebranch=?,cutterextra=?, onloan=?, binding=?";
|
||
|
||
my @bind = (
|
||
$item->{'barcode'}, $item->{'notes'},
|
||
$item->{'itemcallnumber'}, $item->{'notforloan'},
|
||
$item->{'location'}, $item->{multivolumepart},
|
||
$item->{multivolume}, $item->{stack},
|
||
$item->{wthdrawn}, $item->{holdingbranch},
|
||
$item->{homebranch}, $cutterextra,
|
||
$item->{onloan}, $item->{binding}
|
||
);
|
||
if ( $item->{'lost'} ne '' ) {
|
||
$query =
|
||
"update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
|
||
itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
|
||
location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,cutterextra=?,onloan=?, binding=?";
|
||
@bind = (
|
||
$item->{'bibitemnum'}, $item->{'barcode'},
|
||
$item->{'notes'}, $item->{'homebranch'},
|
||
$item->{'lost'}, $item->{'wthdrawn'},
|
||
$item->{'itemcallnumber'}, $item->{'notforloan'},
|
||
$item->{'location'}, $item->{multivolumepart},
|
||
$item->{multivolume}, $item->{stack},
|
||
$item->{wthdrawn}, $item->{holdingbranch},
|
||
$cutterextra, $item->{onloan},
|
||
$item->{binding}
|
||
);
|
||
if ( $item->{homebranch} ) {
|
||
$query .= ",homebranch=?";
|
||
push @bind, $item->{homebranch};
|
||
}
|
||
if ( $item->{holdingbranch} ) {
|
||
$query .= ",holdingbranch=?";
|
||
push @bind, $item->{holdingbranch};
|
||
}
|
||
}
|
||
$query .= " where itemnumber=?";
|
||
push @bind, $item->{'itemnum'};
|
||
if ( $item->{'replacement'} ne '' ) {
|
||
$query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
|
||
}
|
||
my $sth = $dbh->prepare($query);
|
||
$sth->execute(@bind);
|
||
$sth->finish;
|
||
}
|
||
|
||
=head2 _koha_delete_item
|
||
|
||
_koha_delete_item( $dbh, $itemnum );
|
||
|
||
Internal function to delete an item record from the koha tables
|
||
|
||
=cut
|
||
|
||
sub _koha_delete_item {
|
||
my ( $dbh, $itemnum ) = @_;
|
||
|
||
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;
|
||
}
|
||
|
||
=head2 _koha_delete_biblio
|
||
|
||
$error = _koha_delete_biblio($dbh,$biblionumber);
|
||
|
||
Internal sub for deleting from biblio table -- also saves to deletedbiblio
|
||
|
||
C<$dbh> - the database handle
|
||
C<$biblionumber> - the biblionumber of the biblio to be deleted
|
||
|
||
=cut
|
||
|
||
# FIXME: add error handling
|
||
|
||
sub _koha_delete_biblio {
|
||
my ( $dbh, $biblionumber ) = @_;
|
||
|
||
# get all the data for this biblio
|
||
my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
|
||
$sth->execute($biblionumber);
|
||
|
||
if ( my $data = $sth->fetchrow_hashref ) {
|
||
|
||
# save the record in deletedbiblio
|
||
# find the fields to save
|
||
my $query = "INSERT INTO deletedbiblio SET ";
|
||
my @bind = ();
|
||
foreach my $temp ( keys %$data ) {
|
||
$query .= "$temp = ?,";
|
||
push( @bind, $data->{$temp} );
|
||
}
|
||
|
||
# replace the last , by ",?)"
|
||
$query =~ s/\,$//;
|
||
my $bkup_sth = $dbh->prepare($query);
|
||
$bkup_sth->execute(@bind);
|
||
$bkup_sth->finish;
|
||
|
||
# delete the biblio
|
||
my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
|
||
$del_sth->execute($biblionumber);
|
||
$del_sth->finish;
|
||
}
|
||
$sth->finish;
|
||
return undef;
|
||
}
|
||
|
||
=head2 _koha_delete_biblioitems
|
||
|
||
$error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
|
||
|
||
Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
|
||
|
||
C<$dbh> - the database handle
|
||
C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
|
||
|
||
=cut
|
||
|
||
# FIXME: add error handling
|
||
|
||
sub _koha_delete_biblioitems {
|
||
my ( $dbh, $biblioitemnumber ) = @_;
|
||
|
||
# get all the data for this biblioitem
|
||
my $sth =
|
||
$dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
|
||
$sth->execute($biblioitemnumber);
|
||
|
||
if ( my $data = $sth->fetchrow_hashref ) {
|
||
|
||
# save the record in deletedbiblioitems
|
||
# find the fields to save
|
||
my $query = "INSERT INTO deletedbiblioitems SET ";
|
||
my @bind = ();
|
||
foreach my $temp ( keys %$data ) {
|
||
$query .= "$temp = ?,";
|
||
push( @bind, $data->{$temp} );
|
||
}
|
||
|
||
# replace the last , by ",?)"
|
||
$query =~ s/\,$//;
|
||
my $bkup_sth = $dbh->prepare($query);
|
||
$bkup_sth->execute(@bind);
|
||
$bkup_sth->finish;
|
||
|
||
# delete the biblioitem
|
||
my $del_sth =
|
||
$dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
|
||
$del_sth->execute($biblioitemnumber);
|
||
$del_sth->finish;
|
||
}
|
||
$sth->finish;
|
||
return undef;
|
||
}
|
||
|
||
=head2 _koha_delete_items
|
||
|
||
$error = _koha_delete_items($dbh,$itemnumber);
|
||
|
||
Internal sub for deleting from items table -- also saves to deleteditems
|
||
|
||
C<$dbh> - the database handle
|
||
C<$itemnumber> - the itemnumber of the item to be deleted
|
||
|
||
=cut
|
||
|
||
# FIXME: add error handling
|
||
|
||
sub _koha_delete_items {
|
||
my ( $dbh, $itemnumber ) = @_;
|
||
|
||
# get all the data for this item
|
||
my $sth = $dbh->prepare("SELECT * FROM items WHERE itemnumber=?");
|
||
$sth->execute($itemnumber);
|
||
|
||
if ( my $data = $sth->fetchrow_hashref ) {
|
||
|
||
# save the record in deleteditems
|
||
# find the fields to save
|
||
my $query = "INSERT INTO deleteditems SET ";
|
||
my @bind = ();
|
||
foreach my $temp ( keys %$data ) {
|
||
$query .= "$temp = ?,";
|
||
push( @bind, $data->{$temp} );
|
||
}
|
||
|
||
# replace the last , by ",?)"
|
||
$query =~ s/\,$//;
|
||
my $bkup_sth = $dbh->prepare($query);
|
||
$bkup_sth->execute(@bind);
|
||
$bkup_sth->finish;
|
||
|
||
# delete the item
|
||
my $del_sth = $dbh->prepare("DELETE FROM items WHERE itemnumber=?");
|
||
$del_sth->execute($itemnumber);
|
||
$del_sth->finish;
|
||
}
|
||
$sth->finish;
|
||
return undef;
|
||
}
|
||
|
||
|
||
|
||
=head2 modbiblio
|
||
|
||
$biblionumber = &modbiblio($biblio);
|
||
|
||
Update a biblio record.
|
||
|
||
C<$biblio> is a reference-to-hash whose keys are the fields in the
|
||
biblio table in the Koha database. All fields must be present, not
|
||
just the ones you wish to change.
|
||
|
||
C<&modbiblio> updates the record defined by
|
||
C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
|
||
|
||
C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
|
||
successful or not.
|
||
|
||
=cut
|
||
|
||
sub modbiblio {
|
||
my ($biblio) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
my $biblionumber = _koha_modify_biblio( $dbh, $biblio );
|
||
my $record = MARCkoha2marcBiblio( $biblionumber, $biblionumber );
|
||
MARCmodbiblio( $dbh, $biblionumber, $record, "", 0 );
|
||
return ($biblionumber);
|
||
} # sub modbiblio
|
||
|
||
=head2 modbibitem
|
||
|
||
&modbibitem($biblioitem)
|
||
|
||
=cut
|
||
|
||
sub modbibitem {
|
||
my ($biblioitem) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
&_koha_modify_biblio( $dbh, $biblioitem );
|
||
} # sub modbibitem
|
||
|
||
|
||
=head2 newitems
|
||
|
||
$errors = &newitems( $item, @barcodes );
|
||
|
||
=cut
|
||
|
||
sub newitems {
|
||
my ( $item, @barcodes ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
my $errors;
|
||
my $itemnumber;
|
||
my $error;
|
||
foreach my $barcode (@barcodes) {
|
||
( $itemnumber, $error ) = &_koha_new_items( $dbh, $item, uc($barcode) );
|
||
$errors .= $error;
|
||
my $MARCitem =
|
||
&MARCkoha2marcItem( $dbh, $item->{biblionumber}, $itemnumber );
|
||
&MARCadditem( $MARCitem, $item->{biblionumber} );
|
||
}
|
||
return ($errors);
|
||
}
|
||
|
||
=head2 moditem
|
||
|
||
$errors = &moditem( $item, $op );
|
||
|
||
=cut
|
||
|
||
sub moditem {
|
||
my ( $item, $op ) = @_;
|
||
my $dbh = C4::Context->dbh;
|
||
&_koha_modify_item( $dbh, $item, $op );
|
||
|
||
# if we're just setting statuses, just update items table
|
||
# it's faster and zebra and marc will be synched anyway by the cron job
|
||
unless ( $op eq "setstatus" ) {
|
||
my $MARCitem = &MARCkoha2marcItem( $dbh, $item->{'biblionumber'},
|
||
$item->{'itemnum'} );
|
||
&MARCmoditem( $MARCitem, $item->{biblionumber}, $item->{itemnum},
|
||
MARCfind_frameworkcode( $item->{biblionumber} ), 0 );
|
||
}
|
||
}
|
||
|
||
=head2 checkitems
|
||
|
||
$errors = &checkitems( $count, @barcodes );
|
||
|
||
=cut
|
||
|
||
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);
|
||
}
|
||
|
||
=head1 OTHER FUNCTIONS
|
||
|
||
=head2 char_decode
|
||
|
||
my $string = char_decode( $string, $encoding );
|
||
|
||
converts ISO 5426 coded string to UTF-8
|
||
sloppy code : should be improved in next issue
|
||
|
||
=cut
|
||
|
||
sub char_decode {
|
||
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\x41/Ä/gm;
|
||
s/\xc8\x45/Ë/gm;
|
||
s/\xc8\x49/Ï/gm;
|
||
s/\xc8\x61/ä/gm;
|
||
s/\xc8\x65/ë/gm;
|
||
s/\xc8\x69/ï/gm;
|
||
s/\xc8\x6F/ö/gm;
|
||
s/\xc8\x75/ü/gm;
|
||
s/\xc8\x76/ÿ/gm;
|
||
s/\xc9\x41/Ä/gm;
|
||
s/\xc9\x45/Ë/gm;
|
||
s/\xc9\x49/Ï/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" ) {
|
||
##MARC-8 to UTF-8
|
||
|
||
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/\xe6\x41/Ă/gm;
|
||
s/\xe6\x45/Ĕ/gm;
|
||
s/\xe6\x65/ĕ/gm;
|
||
s/\xe6\x61/ă/gm;
|
||
s/\xe8\x45/Ë/gm;
|
||
s/\xe8\x49/Ï/gm;
|
||
s/\xe8\x65/ë/gm;
|
||
s/\xe8\x69/ï/gm;
|
||
s/\xe8\x76/ÿ/gm;
|
||
s/\xe9\x41/A/gm;
|
||
s/\xe9\x4f/O/gm;
|
||
s/\xe9\x55/U/gm;
|
||
s/\xe9\x61/a/gm;
|
||
s/\xe9\x6f/o/gm;
|
||
s/\xe9\x75/u/gm;
|
||
s/\xea\x41/A/gm;
|
||
s/\xea\x61/a/gm;
|
||
|
||
#Additional Turkish characters
|
||
s/\x1b//gm;
|
||
s/\x1e//gm;
|
||
s/(\xf0)s/\xc5\x9f/gm;
|
||
s/(\xf0)S/\xc5\x9e/gm;
|
||
s/(\xf0)c/ç/gm;
|
||
s/(\xf0)C/Ç/gm;
|
||
s/\xe7\x49/\\xc4\xb0/gm;
|
||
s/(\xe6)G/\xc4\x9e/gm;
|
||
s/(\xe6)g/ğ\xc4\x9f/gm;
|
||
s/\xB8/ı/gm;
|
||
s/\xB9/£/gm;
|
||
s/(\xe8|\xc8)o/ö/gm;
|
||
s/(\xe8|\xc8)O/Ö/gm;
|
||
s/(\xe8|\xc8)u/ü/gm;
|
||
s/(\xe8|\xc8)U/Ü/gm;
|
||
s/\xc2\xb8/\xc4\xb1/gm;
|
||
s/¸/\xc4\xb1/gm;
|
||
|
||
# this handles non-sorting blocks (if implementation requires this)
|
||
$string = nsb_clean($_);
|
||
}
|
||
return ($string);
|
||
}
|
||
|
||
=head2 PrepareItemrecordDisplay
|
||
|
||
PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber);
|
||
|
||
Returns a hash with all the fields for Display a given item data in a template
|
||
|
||
=cut
|
||
|
||
sub PrepareItemrecordDisplay {
|
||
|
||
my ( $bibnum, $itemnum ) = @_;
|
||
|
||
my $dbh = C4::Context->dbh;
|
||
my $frameworkcode = &MARCfind_frameworkcode( $bibnum );
|
||
my ( $itemtagfield, $itemtagsubfield ) =
|
||
&MARCfind_marc_from_kohafield( $dbh, "items.itemnumber", $frameworkcode );
|
||
my $tagslib = &MARCgettagslib( $dbh, 1, $frameworkcode );
|
||
my $itemrecord = MARCgetitem( $bibnum, $itemnum) if ($itemnum);
|
||
my @loop_data;
|
||
my $authorised_values_sth =
|
||
$dbh->prepare(
|
||
"select authorised_value,lib from authorised_values where category=? order by lib"
|
||
);
|
||
foreach my $tag ( sort keys %{$tagslib} ) {
|
||
my $previous_tag = '';
|
||
if ( $tag ne '' ) {
|
||
# loop through each subfield
|
||
my $cntsubf;
|
||
foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
|
||
next if ( subfield_is_koha_internal_p($subfield) );
|
||
next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
|
||
my %subfield_data;
|
||
$subfield_data{tag} = $tag;
|
||
$subfield_data{subfield} = $subfield;
|
||
$subfield_data{countsubfield} = $cntsubf++;
|
||
$subfield_data{kohafield} =
|
||
$tagslib->{$tag}->{$subfield}->{'kohafield'};
|
||
|
||
# $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
|
||
$subfield_data{marc_lib} =
|
||
"<span id=\"error\" title=\""
|
||
. $tagslib->{$tag}->{$subfield}->{lib} . "\">"
|
||
. substr( $tagslib->{$tag}->{$subfield}->{lib}, 0, 12 )
|
||
. "</span>";
|
||
$subfield_data{mandatory} =
|
||
$tagslib->{$tag}->{$subfield}->{mandatory};
|
||
$subfield_data{repeatable} =
|
||
$tagslib->{$tag}->{$subfield}->{repeatable};
|
||
$subfield_data{hidden} = "display:none"
|
||
if $tagslib->{$tag}->{$subfield}->{hidden};
|
||
my ( $x, $value );
|
||
( $x, $value ) = _find_value( $tag, $subfield, $itemrecord )
|
||
if ($itemrecord);
|
||
$value =~ s/"/"/g;
|
||
|
||
# search for itemcallnumber if applicable
|
||
if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq
|
||
'items.itemcallnumber'
|
||
&& C4::Context->preference('itemcallnumber') )
|
||
{
|
||
my $CNtag =
|
||
substr( C4::Context->preference('itemcallnumber'), 0, 3 );
|
||
my $CNsubfield =
|
||
substr( C4::Context->preference('itemcallnumber'), 3, 1 );
|
||
my $temp = $itemrecord->field($CNtag) if ($itemrecord);
|
||
if ($temp) {
|
||
$value = $temp->subfield($CNsubfield);
|
||
}
|
||
}
|
||
if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
|
||
my @authorised_values;
|
||
my %authorised_lib;
|
||
|
||
# builds list, depending on authorised value...
|
||
#---- branch
|
||
if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq
|
||
"branches" )
|
||
{
|
||
if ( ( C4::Context->preference("IndependantBranches") )
|
||
&& ( C4::Context->userenv->{flags} != 1 ) )
|
||
{
|
||
my $sth =
|
||
$dbh->prepare(
|
||
"select branchcode,branchname from branches where branchcode = ? order by branchname"
|
||
);
|
||
$sth->execute( C4::Context->userenv->{branch} );
|
||
push @authorised_values, ""
|
||
unless (
|
||
$tagslib->{$tag}->{$subfield}->{mandatory} );
|
||
while ( my ( $branchcode, $branchname ) =
|
||
$sth->fetchrow_array )
|
||
{
|
||
push @authorised_values, $branchcode;
|
||
$authorised_lib{$branchcode} = $branchname;
|
||
}
|
||
}
|
||
else {
|
||
my $sth =
|
||
$dbh->prepare(
|
||
"select branchcode,branchname from branches order by branchname"
|
||
);
|
||
$sth->execute;
|
||
push @authorised_values, ""
|
||
unless (
|
||
$tagslib->{$tag}->{$subfield}->{mandatory} );
|
||
while ( my ( $branchcode, $branchname ) =
|
||
$sth->fetchrow_array )
|
||
{
|
||
push @authorised_values, $branchcode;
|
||
$authorised_lib{$branchcode} = $branchname;
|
||
}
|
||
}
|
||
|
||
#----- itemtypes
|
||
}
|
||
elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq
|
||
"itemtypes" )
|
||
{
|
||
my $sth =
|
||
$dbh->prepare(
|
||
"select itemtype,description from itemtypes order by description"
|
||
);
|
||
$sth->execute;
|
||
push @authorised_values, ""
|
||
unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
|
||
while ( my ( $itemtype, $description ) =
|
||
$sth->fetchrow_array )
|
||
{
|
||
push @authorised_values, $itemtype;
|
||
$authorised_lib{$itemtype} = $description;
|
||
}
|
||
|
||
#---- "true" authorised value
|
||
}
|
||
else {
|
||
$authorised_values_sth->execute(
|
||
$tagslib->{$tag}->{$subfield}->{authorised_value} );
|
||
push @authorised_values, ""
|
||
unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
|
||
while ( my ( $value, $lib ) =
|
||
$authorised_values_sth->fetchrow_array )
|
||
{
|
||
push @authorised_values, $value;
|
||
$authorised_lib{$value} = $lib;
|
||
}
|
||
}
|
||
$subfield_data{marc_value} = CGI::scrolling_list(
|
||
-name => 'field_value',
|
||
-values => \@authorised_values,
|
||
-default => "$value",
|
||
-labels => \%authorised_lib,
|
||
-size => 1,
|
||
-tabindex => '',
|
||
-multiple => 0,
|
||
);
|
||
}
|
||
elsif ( $tagslib->{$tag}->{$subfield}->{thesaurus_category} ) {
|
||
$subfield_data{marc_value} =
|
||
"<input type=\"text\" name=\"field_value\" size=47 maxlength=255> <a href=\"javascript:Dopop('cataloguing/thesaurus_popup.pl?category=$tagslib->{$tag}->{$subfield}->{thesaurus_category}&index=',)\">...</a>";
|
||
|
||
#"
|
||
# COMMENTED OUT because No $i is provided with this API.
|
||
# And thus, no value_builder can be activated.
|
||
# BUT could be thought over.
|
||
# } elsif ($tagslib->{$tag}->{$subfield}->{'value_builder'}) {
|
||
# my $plugin="value_builder/".$tagslib->{$tag}->{$subfield}->{'value_builder'};
|
||
# require $plugin;
|
||
# my $extended_param = plugin_parameters($dbh,$itemrecord,$tagslib,$i,0);
|
||
# my ($function_name,$javascript) = plugin_javascript($dbh,$record,$tagslib,$i,0);
|
||
# $subfield_data{marc_value}="<input type=\"text\" value=\"$value\" name=\"field_value\" size=47 maxlength=255 DISABLE READONLY OnFocus=\"javascript:Focus$function_name()\" OnBlur=\"javascript:Blur$function_name()\"> <a href=\"javascript:Clic$function_name()\">...</a> $javascript";
|
||
}
|
||
else {
|
||
$subfield_data{marc_value} =
|
||
"<input type=\"text\" name=\"field_value\" value=\"$value\" size=50 maxlength=255>";
|
||
}
|
||
push( @loop_data, \%subfield_data );
|
||
}
|
||
}
|
||
}
|
||
my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
|
||
if ( $itemrecord && $itemrecord->field($itemtagfield) );
|
||
return {
|
||
'itemtagfield' => $itemtagfield,
|
||
'itemtagsubfield' => $itemtagsubfield,
|
||
'itemnumber' => $itemnumber,
|
||
'iteminformation' => \@loop_data
|
||
};
|
||
}
|
||
|
||
=head2 nsb_clean
|
||
|
||
my $string = nsb_clean( $string, $encoding );
|
||
|
||
=cut
|
||
|
||
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);
|
||
}
|
||
|
||
=head2 zebraopfiles
|
||
|
||
&zebraopfiles( $dbh, $biblionumber, $record, $folder, $server );
|
||
|
||
=cut
|
||
|
||
sub zebraopfiles {
|
||
|
||
my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
|
||
|
||
my $op;
|
||
my $zebradir =
|
||
C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
|
||
unless ( opendir( DIR, "$zebradir" ) ) {
|
||
warn "$zebradir not found";
|
||
return;
|
||
}
|
||
closedir DIR;
|
||
my $filename = $zebradir . $biblionumber;
|
||
|
||
if ($record) {
|
||
open( OUTPUT, ">", $filename . ".xml" );
|
||
print OUTPUT $record;
|
||
close OUTPUT;
|
||
}
|
||
}
|
||
|
||
=head2 zebraop
|
||
|
||
zebraop( $dbh, $biblionumber, $op, $server );
|
||
|
||
=cut
|
||
|
||
sub zebraop {
|
||
###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
|
||
my ( $dbh, $biblionumber, $op, $server ) = @_;
|
||
|
||
#warn "SERVER:".$server;
|
||
#
|
||
# true zebraop commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
|
||
# at the same time
|
||
# replaced by a zebraqueue table, that is filled with zebraop to run.
|
||
# the table is emptied by misc/cronjobs/zebraqueue_start.pl script
|
||
|
||
my $sth=$dbh->prepare("insert into zebraqueue (biblio_auth_number ,server,operation) values(?,?,?)");
|
||
$sth->execute($biblionumber,$server,$op);
|
||
$sth->finish;
|
||
|
||
#
|
||
# my @Zconnbiblio;
|
||
# my $tried = 0;
|
||
# my $recon = 0;
|
||
# my $reconnect = 0;
|
||
# my $record;
|
||
# my $shadow;
|
||
#
|
||
# reconnect:
|
||
# $Zconnbiblio[0] = C4::Context->Zconn( $server, 0, 1 );
|
||
#
|
||
# if ( $server eq "biblioserver" ) {
|
||
#
|
||
# # it's unclear to me whether this should be in xml or MARC format
|
||
# # but it is clear it should be nabbed from zebra rather than from
|
||
# # the koha tables
|
||
# $record = GetMarcBiblio($biblionumber);
|
||
# $record = $record->as_xml_record() if $record;
|
||
# # warn "RECORD $biblionumber => ".$record;
|
||
# $shadow="biblioservershadow";
|
||
#
|
||
# # warn "RECORD $biblionumber => ".$record;
|
||
# $shadow = "biblioservershadow";
|
||
#
|
||
# }
|
||
# elsif ( $server eq "authorityserver" ) {
|
||
# $record = C4::AuthoritiesMarc::XMLgetauthority( $dbh, $biblionumber );
|
||
# $shadow = "authorityservershadow";
|
||
# } ## Add other servers as necessary
|
||
#
|
||
# my $Zpackage = $Zconnbiblio[0]->package();
|
||
# $Zpackage->option( action => $op );
|
||
# $Zpackage->option( record => $record );
|
||
#
|
||
# retry:
|
||
# $Zpackage->send("update");
|
||
# my $i;
|
||
# my $event;
|
||
#
|
||
# while ( ( $i = ZOOM::event( \@Zconnbiblio ) ) != 0 ) {
|
||
# $event = $Zconnbiblio[0]->last_event();
|
||
# last if $event == ZOOM::Event::ZEND;
|
||
# }
|
||
#
|
||
# my ( $error, $errmsg, $addinfo, $diagset ) = $Zconnbiblio[0]->error_x();
|
||
# if ( $error == 10000 && $reconnect == 0 )
|
||
# { ## This is serious ZEBRA server is not available -reconnect
|
||
# warn "problem with zebra server connection";
|
||
# $reconnect = 1;
|
||
# my $res = system('sc start "Z39.50 Server" >c:/zebraserver/error.log');
|
||
#
|
||
# #warn "Trying to restart ZEBRA Server";
|
||
# #goto "reconnect";
|
||
# }
|
||
# elsif ( $error == 10007 && $tried < 2 )
|
||
# { ## timeout --another 30 looonng seconds for this update
|
||
# $tried = $tried + 1;
|
||
# warn "warn: timeout, trying again";
|
||
# goto "retry";
|
||
# }
|
||
# elsif ( $error == 10004 && $recon == 0 ) { ##Lost connection -reconnect
|
||
# $recon = 1;
|
||
# warn "error: reconnecting to zebra";
|
||
# goto "reconnect";
|
||
#
|
||
# # as a last resort, we save the data to the filesystem to be indexed in batch
|
||
# }
|
||
# elsif ($error) {
|
||
# warn
|
||
# "Error-$server $op $biblionumber /errcode:, $error, /MSG:,$errmsg,$addinfo \n";
|
||
# $Zpackage->destroy();
|
||
# $Zconnbiblio[0]->destroy();
|
||
# zebraopfiles( $dbh, $biblionumber, $record, $op, $server );
|
||
# return;
|
||
# }
|
||
# if ( C4::Context->$shadow ) {
|
||
# $Zpackage->send('commit');
|
||
# while ( ( $i = ZOOM::event( \@Zconnbiblio ) ) != 0 ) {
|
||
#
|
||
# #waiting zebra to finish;
|
||
# }
|
||
# }
|
||
# $Zpackage->destroy();
|
||
}
|
||
|
||
=head2 calculatelc
|
||
|
||
$lc = calculatelc($classification);
|
||
|
||
=cut
|
||
|
||
sub calculatelc {
|
||
my ($classification) = @_;
|
||
$classification =~ s/^\s+|\s+$//g;
|
||
my $i = 0;
|
||
my $lc2;
|
||
my $lc1;
|
||
|
||
for ( $i = 0 ; $i < length($classification) ; $i++ ) {
|
||
my $c = ( substr( $classification, $i, 1 ) );
|
||
if ( $c ge '0' && $c le '9' ) {
|
||
|
||
$lc2 = substr( $classification, $i );
|
||
last;
|
||
}
|
||
else {
|
||
$lc1 .= substr( $classification, $i, 1 );
|
||
|
||
}
|
||
} #while
|
||
|
||
my $other = length($lc1);
|
||
if ( !$lc1 ) {
|
||
$other = 0;
|
||
}
|
||
|
||
my $extras;
|
||
if ( $other < 4 ) {
|
||
for ( 1 .. ( 4 - $other ) ) {
|
||
$extras .= "0";
|
||
}
|
||
}
|
||
$lc1 .= $extras;
|
||
$lc2 =~ s/^ //g;
|
||
|
||
$lc2 =~ s/ //g;
|
||
$extras = "";
|
||
##Find the decimal part of $lc2
|
||
my $pos = index( $lc2, "." );
|
||
if ( $pos < 0 ) { $pos = length($lc2); }
|
||
if ( $pos >= 0 && $pos < 5 ) {
|
||
##Pad lc2 with zeros to create a 5digit decimal needed in marc record to sort as numeric
|
||
|
||
for ( 1 .. ( 5 - $pos ) ) {
|
||
$extras .= "0";
|
||
}
|
||
}
|
||
$lc2 = $extras . $lc2;
|
||
return ( $lc1 . $lc2 );
|
||
}
|
||
|
||
=head2 itemcalculator
|
||
|
||
$cutterextra = itemcalculator( $dbh, $biblioitem, $callnumber );
|
||
|
||
=cut
|
||
|
||
sub itemcalculator {
|
||
my ( $dbh, $biblioitem, $callnumber ) = @_;
|
||
my $sth =
|
||
$dbh->prepare(
|
||
"select classification, subclass from biblioitems where biblioitemnumber=?"
|
||
);
|
||
|
||
$sth->execute($biblioitem);
|
||
my ( $classification, $subclass ) = $sth->fetchrow;
|
||
my $all = $classification . " " . $subclass;
|
||
my $total = length($all);
|
||
my $cutterextra = substr( $callnumber, $total - 1 );
|
||
|
||
return $cutterextra;
|
||
}
|
||
|
||
END { } # module clean-up code here (global destructor)
|
||
|
||
1;
|
||
|
||
__END__
|
||
|
||
=head1 AUTHOR
|
||
|
||
Koha Developement team <info@koha.org>
|
||
|
||
Paul POULAIN paul.poulain@free.fr
|
||
|
||
Joshua Ferraro jmf@liblime.com
|
||
|
||
=cut
|
||
|
||
# $Id$
|
||
# $Log$
|
||
# Revision 1.188 2007/03/09 14:31:47 tipaul
|
||
# rel_3_0 moved to HEAD
|
||
#
|
||
# Revision 1.178.2.59 2007/02/28 10:01:13 toins
|
||
# reporting bug fix from 2.2.7.1 to rel_3_0
|
||
# LOG was :
|
||
# BUGFIX/improvement : limiting MARCsubject to 610 as 676 is dewey, and is somewhere else
|
||
#
|
||
# Revision 1.178.2.58 2007/02/05 16:50:01 toins
|
||
# fix a mod_perl bug:
|
||
# There was a global var modified into an internal function in {MARC|ISBD}detail.pl.
|
||
# Moving this function in Biblio.pm
|
||
#
|
||
# Revision 1.178.2.57 2007/01/25 09:37:58 tipaul
|
||
# removing warn
|
||
#
|
||
# Revision 1.178.2.56 2007/01/24 13:50:26 tipaul
|
||
# Acquisition fix
|
||
# removing newbiblio & newbiblioitems subs.
|
||
# adding Koha2Marc
|
||
#
|
||
# IMHO, all biblio handling is better handled if they are done in a single place, the subs with MARC::Record as parameters.
|
||
# newbiblio & newbiblioitems where koha 1.x subs, that are called when MARC=OFF (which is not working anymore in koha 3.0, unless someone reintroduce it), and in acquisition module.
|
||
# The Koha2Marc sub moves a hash (with biblio/biblioitems subfield as keys) into a MARC::Record, that can be used to call NewBiblio, the standard biblio manager sub.
|
||
#
|
||
# Revision 1.178.2.55 2007/01/17 18:07:17 alaurin
|
||
# bugfixing for zebraqueue_start and biblio.pm :
|
||
#
|
||
# - Zebraqueue_start : restoring function of deletion in zebraqueue DB list
|
||
#
|
||
# -biblio.pm : changing method of default_record_format, now we have :
|
||
# MARC::File::XML->default_record_format(C4::Context->preference('marcflavour'));
|
||
#
|
||
# with this line the encoding in zebra seems to be ok (in unimarc and marc21)
|
||
#
|
||
# Revision 1.178.2.54 2007/01/16 15:00:03 tipaul
|
||
# donc try to delete the biblio in koha, just fill zebraqueue table !
|
||
#
|
||
# Revision 1.178.2.53 2007/01/16 10:24:11 tipaul
|
||
# BUGFIXING :
|
||
# when modifying or deleting an item, the biblio frameworkcode was emptied.
|
||
#
|
||
# Revision 1.178.2.52 2007/01/15 17:20:55 toins
|
||
# *** empty log message ***
|
||
#
|
||
# Revision 1.178.2.51 2007/01/15 15:16:44 hdl
|
||
# Uncommenting zebraop.
|
||
#
|
||
# Revision 1.178.2.50 2007/01/15 14:59:09 hdl
|
||
# Adding creation of an unexpected serial any time.
|
||
# +
|
||
# USING Date::Calc and not Date::Manip.
|
||
# WARNING : There are still some Bugs in next issue date management. (Date::Calc donot wrap easily next year calculation.)
|
||
#
|
||
# Revision 1.178.2.49 2007/01/12 10:12:30 toins
|
||
# writing $record->as_formatted in the log when Modifying an item.
|
||
#
|
||
# Revision 1.178.2.48 2007/01/11 16:33:04 toins
|
||
# write $record->as_formatted into the log.
|
||
#
|
||
# Revision 1.178.2.47 2007/01/10 16:46:27 toins
|
||
# Theses modules need to use C4::Log.
|
||
#
|
||
# Revision 1.178.2.46 2007/01/10 16:31:15 toins
|
||
# new systems preferences :
|
||
# - CataloguingLog (log the update/creation/deletion of a notice if set to 1)
|
||
# - BorrowersLog ( idem for borrowers )
|
||
# - IssueLog (log all issue if set to 1)
|
||
# - ReturnLog (log all return if set to 1)
|
||
# - SusbcriptionLog (log all creation/deletion/update of a subcription)
|
||
#
|
||
# All of theses are in a new tab called 'LOGFeatures' in systempreferences.pl
|
||
#
|
||
# Revision 1.178.2.45 2007/01/09 10:31:09 toins
|
||
# sync with dev_week. ( new function : GetMarcSeries )
|
||
#
|
||
# Revision 1.178.2.44 2007/01/04 17:41:32 tipaul
|
||
# 2 major bugfixes :
|
||
# - deletion of an item deleted the whole biblio because of a wrong API
|
||
# - create an item was bugguy for default framework
|
||
#
|
||
# Revision 1.178.2.43 2006/12/22 15:09:53 toins
|
||
# removing C4::Database;
|
||
#
|
||
# Revision 1.178.2.42 2006/12/20 16:51:00 tipaul
|
||
# ZEBRA update :
|
||
# - adding a new table : when a biblio is added/modified/ deleted, an entry is entered in this table
|
||
# - the zebraqueue_start.pl script read it & does the stuff.
|
||
#
|
||
# code coming from head (tumer). it can be run every minut instead of once every day for dev_week code.
|
||
#
|
||
# I just have commented the previous code (=real time update) in Biblio.pm, we will be able to reactivate it once indexdata fixes zebra update bug !
|
||
#
|
||
# Revision 1.178.2.41 2006/12/20 08:54:44 toins
|
||
# GetXmlBiblio wasn't exported.
|
||
#
|
||
# Revision 1.178.2.40 2006/12/19 16:45:56 alaurin
|
||
# bugfixing, for zebra and authorities
|
||
#
|
||
# Revision 1.178.2.39 2006/12/08 17:55:44 toins
|
||
# GetMarcAuthors now get authors for all subfields
|
||
#
|
||
# Revision 1.178.2.38 2006/12/07 15:42:14 toins
|
||
# synching opac & intranet.
|
||
# fix some broken link & bugs.
|
||
# removing warn compilation.
|
||
#
|
||
# Revision 1.178.2.37 2006/12/07 11:09:39 tipaul
|
||
# MAJOR FIX :
|
||
# the ->destroy() line destroys the zebra connection. When we are running koha as cgi, it's not a problem, as the script dies after each request.
|
||
# BUT for bulkmarcimport & mod_perl, the zebra conn must be persistant.
|
||
#
|
||
# Revision 1.178.2.36 2006/12/06 16:54:21 alaurin
|
||
# restore function zebraop for delete biblios :
|
||
#
|
||
# 1) restore C4::Circulation::Circ2::itemissues, (was missing)
|
||
# 2) restore zebraop value : delete_record
|
||
#
|
||
# Revision 1.178.2.35 2006/12/06 10:02:12 alaurin
|
||
# bugfixing for delete a biblio :
|
||
#
|
||
# restore itemissue fonction .... :
|
||
#
|
||
# other is pointed, zebra error 224... for biblio is not deleted in zebra ..
|
||
# ....
|
||
#
|
||
# Revision 1.178.2.34 2006/12/06 09:14:25 toins
|
||
# Correct the link to the MARC subjects.
|
||
#
|
||
# Revision 1.178.2.33 2006/12/05 11:35:29 toins
|
||
# Biblio.pm cleaned.
|
||
# additionalauthors, bibliosubject, bibliosubtitle tables are now unused.
|
||
# Some functions renamed according to the coding guidelines.
|
||
#
|
||
# Revision 1.178.2.32 2006/12/04 17:39:57 alaurin
|
||
# bugfix :
|
||
#
|
||
# restore zebraop for update zebra
|
||
#
|
||
# Revision 1.178.2.31 2006/12/01 17:00:19 tipaul
|
||
# additem needs $frameworkcode
|
||
#
|
||
# Revision 1.178.2.30 2006/11/30 18:23:51 toins
|
||
# theses scripts don't need to use C4::Search.
|
||
#
|
||
# Revision 1.178.2.29 2006/11/30 17:17:01 toins
|
||
# following functions moved from Search.p to Biblio.pm :
|
||
# - bibdata
|
||
# - itemsissues
|
||
# - addauthor
|
||
# - getMARCNotes
|
||
# - getMARCsubjects
|
||
#
|
||
# Revision 1.178.2.28 2006/11/28 15:15:03 toins
|
||
# sync with dev_week.
|
||
# (deleteditems table wasn't getting populaated because the execute was commented out. This puts it back
|
||
# -- some table changes are needed as well, I'll commit those separately.)
|
||
#
|
||
# Revision 1.178.2.27 2006/11/20 16:52:05 alaurin
|
||
# minor bugfixing :
|
||
#
|
||
# correcting in _koha_modify_biblioitem : restore the biblionumber line .
|
||
#
|
||
# now the sql update of biblioitems is ok ....
|
||
#
|
||
# Revision 1.178.2.26 2006/11/17 14:57:21 tipaul
|
||
# code cleaning : moving bornum, borrnum, bornumber to a correct "borrowernumber"
|
||
#
|
||
# Revision 1.178.2.25 2006/11/17 13:18:58 tipaul
|
||
# code cleaning : removing use of "bib", and replacing with "biblionumber"
|
||
#
|
||
# WARNING : I tried to do carefully, but there are probably some mistakes.
|
||
# So if you encounter a problem you didn't have before, look for this change !!!
|
||
# anyway, I urge everybody to use only "biblionumber", instead of "bib", "bi", "biblio" or anything else. will be easier to maintain !!!
|
||
#
|
||
# Revision 1.178.2.24 2006/11/17 11:18:47 tipaul
|
||
# * removing useless subs
|
||
# * moving bibid to biblionumber where needed
|
||
#
|
||
# Revision 1.178.2.23 2006/11/17 09:39:04 btoumi
|
||
# bug fix double declaration of variable in same function
|
||
#
|
||
# Revision 1.178.2.22 2006/11/15 15:15:50 hdl
|
||
# Final First Version for New Facility for subscription management.
|
||
#
|
||
# Now
|
||
# use serials-collection.pl for history display
|
||
# and serials-edit.pl for serial edition
|
||
# subscription add and detail adds a new branch information to help IndependantBranches Library to manage different subscriptions for a serial
|
||
#
|
||
# This is aimed at replacing serials-receive and statecollection.
|
||
#
|
||
# Revision 1.178.2.21 2006/11/15 14:49:38 tipaul
|
||
# in some cases, there are invalid utf8 chars in XML (at least in SANOP). this commit remove them on the fly.
|
||
# Not sure it's a good idea to keep them in biblio.pm, let me know your opinion on koha-devel if you think it's a bad idea...
|
||
#
|
||
# Revision 1.178.2.20 2006/10/31 17:20:49 toins
|
||
# * moving bibitemdata from search to here.
|
||
# * using _koha_modify_biblio instead of OLDmodbiblio.
|
||
#
|
||
# Revision 1.178.2.19 2006/10/20 15:26:41 toins
|
||
# sync with dev_week.
|
||
#
|
||
# Revision 1.178.2.18 2006/10/19 11:57:04 btoumi
|
||
# bug fix : wrong syntax in sub call
|
||
#
|
||
# Revision 1.178.2.17 2006/10/17 09:54:42 toins
|
||
# ccode (re)-integration.
|
||
#
|
||
# Revision 1.178.2.16 2006/10/16 16:20:34 toins
|
||
# MARCgetbiblio cleaned up.
|
||
#
|
||
# Revision 1.178.2.15 2006/10/11 14:26:56 tipaul
|
||
# handling of UNIMARC :
|
||
# - better management of field 100 = automatic creation of the field if needed & filling encoding to unicode.
|
||
# - better management of encoding (MARC::File::XML new_from_xml()). This fix works only on my own version of M:F:XML, i think the actual one is buggy & have reported the problem to perl4lib mailing list
|
||
# - fixing a bug on MARCgetitem, that uses biblioitems.marc and not biblioitems.marcxml
|
||
#
|
||
# Revision 1.178.2.14 2006/10/11 07:59:36 tipaul
|
||
# removing hardcoded ccode fiels in biblioitems
|
||
#
|
||
# Revision 1.178.2.13 2006/10/10 14:21:24 toins
|
||
# Biblio.pm now returns a true value.
|
||
#
|
||
# Revision 1.178.2.12 2006/10/09 16:44:23 toins
|
||
# Sync with dev_week.
|
||
#
|
||
# Revision 1.178.2.11 2006/10/06 13:23:49 toins
|
||
# Synch with dev_week.
|
||
#
|
||
# Revision 1.178.2.10 2006/10/02 09:32:02 hdl
|
||
# Adding GetItemStatus and GetItemLocation function in order to make serials-receive.pl work.
|
||
#
|
||
# *************WARNING.***************
|
||
# tested for UNIMARC and using 'marcflavour' system preferences to set defaut_record_format.
|
||
#
|
||
# Revision 1.178.2.9 2006/09/26 07:54:20 hdl
|
||
# Bug FIX: Correct accents for UNIMARC biblio MARC details.
|
||
# (Adding the use of default_record_format in MARCgetbiblio if UNIMARC marcflavour is chosen. This should be widely used as soon as we use xml records)
|
||
#
|
||
# Revision 1.178.2.8 2006/09/25 14:46:22 hdl
|
||
# Now using iso2709 MARC data for MARC.
|
||
# (Works better for accents than XML)
|
||
#
|
||
# Revision 1.178.2.7 2006/09/20 13:44:14 hdl
|
||
# Bug Fixing : Cataloguing was broken for UNIMARC.
|
||
# Please test.
|
||
|