[Koha-cvs] koha acqui/addorder.pl acqui/finishreceive.pl C...
paul poulain
paul at koha-fr.org
Thu Mar 29 18:45:54 CEST 2007
CVSROOT: /sources/koha
Module name: koha
Changes by: paul poulain <tipaul> 07/03/29 16:45:54
Modified files:
acqui : addorder.pl finishreceive.pl
C4 : AuthoritiesMarc.pm Biblio.pm Context.pm
C4/Circulation : Circ2.pm
koha-tmpl/intranet-tmpl/prog/en/help/admin: checkmarc.tmpl
misc/migration_tools/22_to_30: missing090field.pl
rebuild_leader.pl
rebuild_unimarc_100.pl
misc : missing090field.pl rebuildnonmarc.pl
opac : opac-review.pl opac-showreviews.pl
Log message:
Code cleaning of Biblio.pm (continued)
All subs have be cleaned :
- removed useless
- merged some
- reordering Biblio.pm completly
- using only naming conventions
Seems to have broken nothing, but it still has to be heavily tested.
Note that Biblio.pm is now much more efficient than previously & probably more reliable as well.
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/acqui/addorder.pl?cvsroot=koha&r1=1.36&r2=1.37
http://cvs.savannah.gnu.org/viewcvs/koha/acqui/finishreceive.pl?cvsroot=koha&r1=1.23&r2=1.24
http://cvs.savannah.gnu.org/viewcvs/koha/C4/AuthoritiesMarc.pm?cvsroot=koha&r1=1.41&r2=1.42
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Biblio.pm?cvsroot=koha&r1=1.192&r2=1.193
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Context.pm?cvsroot=koha&r1=1.53&r2=1.54
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Circulation/Circ2.pm?cvsroot=koha&r1=1.126&r2=1.127
http://cvs.savannah.gnu.org/viewcvs/koha/koha-tmpl/intranet-tmpl/prog/en/help/admin/checkmarc.tmpl?cvsroot=koha&r1=1.4&r2=1.5
http://cvs.savannah.gnu.org/viewcvs/koha/misc/migration_tools/22_to_30/missing090field.pl?cvsroot=koha&r1=1.3&r2=1.4
http://cvs.savannah.gnu.org/viewcvs/koha/misc/migration_tools/22_to_30/rebuild_leader.pl?cvsroot=koha&r1=1.1&r2=1.2
http://cvs.savannah.gnu.org/viewcvs/koha/misc/migration_tools/22_to_30/rebuild_unimarc_100.pl?cvsroot=koha&r1=1.1&r2=1.2
http://cvs.savannah.gnu.org/viewcvs/koha/misc/missing090field.pl?cvsroot=koha&r1=1.3&r2=1.4
http://cvs.savannah.gnu.org/viewcvs/koha/misc/rebuildnonmarc.pl?cvsroot=koha&r1=1.7&r2=1.8
http://cvs.savannah.gnu.org/viewcvs/koha/opac/opac-review.pl?cvsroot=koha&r1=1.3&r2=1.4
http://cvs.savannah.gnu.org/viewcvs/koha/opac/opac-showreviews.pl?cvsroot=koha&r1=1.3&r2=1.4
Patches:
Index: acqui/addorder.pl
===================================================================
RCS file: /sources/koha/koha/acqui/addorder.pl,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -b -r1.36 -r1.37
--- acqui/addorder.pl 9 Mar 2007 14:28:54 -0000 1.36
+++ acqui/addorder.pl 29 Mar 2007 16:45:53 -0000 1.37
@@ -187,7 +187,7 @@
if ( $existing eq 'no' ) {
#if it doesnt create it
- my $record = Koha2Marc(
+ my $record = TransformKohaToMarc(
{
"biblio.title" => "$title",
"biblio.author" => "$author",
Index: acqui/finishreceive.pl
===================================================================
RCS file: /sources/koha/koha/acqui/finishreceive.pl,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -b -r1.23 -r1.24
--- acqui/finishreceive.pl 29 Mar 2007 13:31:01 -0000 1.23
+++ acqui/finishreceive.pl 29 Mar 2007 16:45:53 -0000 1.24
@@ -57,7 +57,7 @@
my @barcodes=split(/\,| |\|/,$barcode);
# foreach barcode provided, build the item MARC::Record and create the item
foreach my $bc (@barcodes) {
- my $itemRecord = Koha2Marc({
+ my $itemRecord = TransformKohaToMarc({
"items.replacementprice" => $replacement,
"items.price" => $cost,
"items.booksellerid" => $supplierid,
Index: C4/AuthoritiesMarc.pm
===================================================================
RCS file: /sources/koha/koha/C4/AuthoritiesMarc.pm,v
retrieving revision 1.41
retrieving revision 1.42
diff -u -b -r1.41 -r1.42
--- C4/AuthoritiesMarc.pm 29 Mar 2007 13:30:31 -0000 1.41
+++ C4/AuthoritiesMarc.pm 29 Mar 2007 16:45:53 -0000 1.42
@@ -951,15 +951,27 @@
=cut
-# $Id: AuthoritiesMarc.pm,v 1.41 2007/03/29 13:30:31 tipaul Exp $
+# $Id: AuthoritiesMarc.pm,v 1.42 2007/03/29 16:45:53 tipaul Exp $
# $Log: AuthoritiesMarc.pm,v $
+# Revision 1.42 2007/03/29 16:45:53 tipaul
+# Code cleaning of Biblio.pm (continued)
+#
+# All subs have be cleaned :
+# - removed useless
+# - merged some
+# - reordering Biblio.pm completly
+# - using only naming conventions
+#
+# Seems to have broken nothing, but it still has to be heavily tested.
+# Note that Biblio.pm is now much more efficient than previously & probably more reliable as well.
+#
# Revision 1.41 2007/03/29 13:30:31 tipaul
# Code cleaning :
# == Biblio.pm cleaning (useless) ==
# * some sub declaration dropped
# * removed modbiblio sub
# * removed moditem sub
-# * removed newitems. It was used only in finishrecieve. Replaced by a Koha2Marc+AddItem, that is better.
+# * removed newitems. It was used only in finishrecieve. Replaced by a TransformKohaToMarc+AddItem, that is better.
# * removed MARCkoha2marcItem
# * removed MARCdelsubfield declaration
# * removed MARCkoha2marcBiblio
Index: C4/Biblio.pm
===================================================================
RCS file: /sources/koha/koha/C4/Biblio.pm,v
retrieving revision 1.192
retrieving revision 1.193
diff -u -b -r1.192 -r1.193
--- C4/Biblio.pm 29 Mar 2007 13:30:31 -0000 1.192
+++ C4/Biblio.pm 29 Mar 2007 16:45:53 -0000 1.193
@@ -33,7 +33,7 @@
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.192 $' =~ /\d+/g; shift(@v).".".join( "_", map { sprintf "%03d", $_ } @v ); };
+$VERSION = do { my @v = '$Revision: 1.193 $' =~ /\d+/g; shift(@v).".".join( "_", map { sprintf "%03d", $_ } @v ); };
@ISA = qw( Exporter );
@@ -71,7 +71,7 @@
&GetMarcStructure
&GetMarcFromKohaField
&GetFrameworkCode
- &Koha2Marc
+ &TransformKohaToMarc
);
# To modify something
@@ -80,6 +80,8 @@
&ModItem
&ModBiblioframework
&ModZebra
+ &ModItemInMarc
+ &ModItemInMarconefield
);
# To delete something
@@ -88,13 +90,15 @@
&DelItem
);
-# Marc related functions
+# Internal functions
+# those functions are exported but should not be used
+# they are usefull is few circumstances, so are exported.
+# but don't use them unless you're a core developer ;-)
push @EXPORT, qw(
- &MARCmoditemonefield
- &MARCaddbiblio
- &MARCadditem
- &MARCmodbiblio
- &MARCmoditem
+ &ModBiblioMarc
+ &AddItemInMarc
+ &calculatelc
+ &itemcalculator
);
# Others functions
@@ -104,13 +108,11 @@
&TransformHtmlToXml
&PrepareItemrecordDisplay
&char_decode
- &itemcalculator
- &calculatelc
);
=head1 NAME
-C4::Biblio - acquisitions and cataloging management functions
+C4::Biblio - cataloging management functions
=head1 DESCRIPTION
@@ -122,13 +124,13 @@
=item 2. as raw MARC in the Zebra index and storage engine
-=item 3. as raw MARC the biblioitems.marc
+=item 3. as raw MARC the biblioitems.marc and biblioitems.marcxml
=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.
+In the 3.0 version of Koha, the authoritative record-level information is in biblioitems.marcxml
-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:
+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. However, if this occur, it can be considered as a bug : The API is (or should be) complete & the only entry point for all biblio/items managements.
=over 4
@@ -146,15 +148,37 @@
=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 3. Marc management function : as the MARC record is stored in biblioitems.marc(xml), some subs dedicated to it's management are in this package. They should be used only internally by Biblio.pm, the only official entry points being AddBiblio, AddItem, ModBiblio, ModItem.
=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 GetMarcFromKohaField which belongs in Search.pm)
+=back
+
+The MARC record (in biblioitems.marcxml) contains the complete marc record, including items. It also contains the biblionumber. That is the reason why it is not stored directly by AddBiblio, with all other fields . To save a biblio, we need to :
+
+=over 4
+
+=item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
+
+=item 2. add the biblionumber and biblioitemnumber into the MARC records
+
+=item 3. save the marc record
+
+=back
+
+When dealing with items, we must :
+
+=over 4
+
+=item 1. save the item in items table, that gives us an itemnumber
+
+=item 2. add the itemnumber to the item MARC field
-In time, as we solidify the new API these older functions will be weeded out.
+=item 3. overwrite the MARC record (with the added item) into biblioitems.marc(xml)
+
+When modifying a biblio or an item, the behaviour is quite similar.
=back
@@ -162,71 +186,64 @@
=head2 AddBiblio
-($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
+=over 4
+($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
Exported function (core API) for adding a new biblio to koha.
+=back
+
=cut
sub AddBiblio {
my ( $record, $frameworkcode ) = @_;
- my $oldbibnum;
- my $oldbibitemnum;
+ my $biblionumber;
+ my $biblioitemnumber;
my $dbh = C4::Context->dbh;
# transform the data into koha-table style data
my $olddata = TransformMarcToKoha( $dbh, $record, $frameworkcode );
- $oldbibnum = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
- $olddata->{'biblionumber'} = $oldbibnum;
- $oldbibitemnum = _koha_add_biblioitem( $dbh, $olddata );
+ $biblionumber = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
+ $olddata->{'biblionumber'} = $biblionumber;
+ $biblioitemnumber = _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 $biblio_tag, my $biblio_subfield ) = GetMarcFromKohaField($dbh,"biblio.biblionumber",$frameworkcode);
+ ( my $biblioitem_tag, my $biblioitem_subfield ) = GetMarcFromKohaField($dbh,"biblioitems.biblioitemnumber",$frameworkcode);
my $newfield;
# biblionumber & biblioitemnumber are in different fields
- if ( $tagfield1 != $tagfield2 ) {
+ if ( $biblio_tag != $biblioitem_tag ) {
# deal with biblionumber
- if ( $tagfield1 < 10 ) {
- $newfield = MARC::Field->new( $tagfield1, $oldbibnum, );
+ if ( $biblio_tag < 10 ) {
+ $newfield = MARC::Field->new( $biblio_tag, $biblionumber );
}
else {
$newfield =
- MARC::Field->new( $tagfield1, '', '',
- "$tagsubfield1" => $oldbibnum, );
+ MARC::Field->new( $biblio_tag, '', '',
+ "$biblio_subfield" => $biblionumber );
}
# drop old field and create new one...
- my $old_field = $record->field($tagfield1);
+ my $old_field = $record->field($biblio_tag);
$record->delete_field($old_field);
$record->append_fields($newfield);
# deal with biblioitemnumber
- if ( $tagfield2 < 10 ) {
- $newfield = MARC::Field->new( $tagfield2, $oldbibitemnum, );
+ if ( $biblioitem_tag < 10 ) {
+ $newfield = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
}
else {
$newfield =
- MARC::Field->new( $tagfield2, '', '',
- "$tagsubfield2" => $oldbibitemnum, );
+ MARC::Field->new( $biblioitem_tag, '', '',
+ "$biblioitem_subfield" => $biblioitemnumber, );
}
# drop old field and create new one...
- $old_field = $record->field($tagfield2);
+ $old_field = $record->field($biblioitem_tag);
$record->delete_field($old_field);
$record->insert_fields_ordered($newfield);
@@ -234,46 +251,36 @@
}
else {
my $newfield = MARC::Field->new(
- $tagfield1, '', '',
- "$tagsubfield1" => $oldbibnum,
- "$tagsubfield2" => $oldbibitemnum
+ $biblio_tag, '', '',
+ "$biblio_subfield" => $biblionumber,
+ "$biblioitem_subfield" => $biblioitemnumber
);
# drop old field and create new one...
- my $old_field = $record->field($tagfield1);
+ my $old_field = $record->field($biblio_tag);
$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 );
+ ModBiblioMarc( $record, $biblionumber, $frameworkcode );
&logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$biblionumber,"biblio")
if C4::Context->preference("CataloguingLog");
- return ( $biblionumber, $oldbibitemnum );
+ return ( $biblionumber, $biblioitemnumber );
}
=head2 AddItem
-$biblionumber = AddItem( $record, $biblionumber)
+=over
+$biblionumber = AddItem( $record, $biblionumber)
Exported function (core API) for adding a new item to Koha
+=back
+
=cut
sub AddItem {
@@ -323,24 +330,11 @@
$dbh->prepare(
"select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
);
- &MARCkoha2marcOnefield( $sth, $record, "items.itemnumber", $itemnumber,
+ &TransformKohaToMarcOneField( $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 );
+ &AddItemInMarc( $record, $item->{'biblionumber'},$frameworkcode );
&logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$itemnumber,"item")
if C4::Context->preference("CataloguingLog");
@@ -350,10 +344,13 @@
=head2 ModBiblio
-ModBiblio( $record,$biblionumber,$frameworkcode);
+=over
+ModBiblio( $record,$biblionumber,$frameworkcode);
Exported function (core API) to modify a biblio
+=back
+
=cut
sub ModBiblio {
@@ -369,13 +366,13 @@
$frameworkcode = "" unless $frameworkcode;
# update the MARC record with the new record data
- &MARCmodbiblio( $dbh, $biblionumber, $record, $frameworkcode, 1 );
+ &ModBiblioMarc($record, $biblionumber, $frameworkcode );
# load the koha-table data object
my $oldbiblio = TransformMarcToKoha( $dbh, $record, $frameworkcode );
# modify the other koha tables
- my $oldbiblionumber = _koha_modify_biblio( $dbh, $oldbiblio );
+ my $biblionumber = _koha_modify_biblio( $dbh, $oldbiblio );
_koha_modify_biblioitem( $dbh, $oldbiblio );
return 1;
@@ -383,8 +380,12 @@
=head2 ModItem
+=over
+
Exported function (core API) for modifying an item in Koha.
+=back
+
=cut
sub ModItem {
@@ -402,7 +403,7 @@
# tables
if ($record) {
my $frameworkcode = GetFrameworkCode( $biblionumber );
- MARCmoditem( $record, $biblionumber, $itemnumber, $frameworkcode, $delete );
+ ModItemInMarc( $record, $biblionumber, $itemnumber, $frameworkcode );
my $olditem = TransformMarcToKoha( $dbh, $record, $frameworkcode );
_koha_modify_item( $dbh, $olditem );
return $biblionumber;
@@ -417,10 +418,13 @@
=head2 ModBiblioframework
-ModBiblioframework($biblionumber,$frameworkcode);
+=over
+ModBiblioframework($biblionumber,$frameworkcode);
Exported function to modify a biblio framework
+=back
+
=cut
sub ModBiblioframework {
@@ -429,27 +433,88 @@
my $sth =
$dbh->prepare(
"UPDATE biblio SET frameworkcode=? WHERE biblionumber=$biblionumber");
-
- warn "IN ModBiblioframework";
$sth->execute($frameworkcode);
return 1;
}
+=head2 ModItemInMarconefield
+
+=over
+
+modify only 1 field in a MARC item (mainly used for holdingbranch, but could also be used for status modif - moving a book to "lost" on a long overdu for example)
+&ModItemInMarconefield( $biblionumber, $itemnumber, $itemfield, $newvalue )
+
+=back
+
+=cut
+
+sub ModItemInMarconefield {
+ my ( $biblionumber, $itemnumber, $itemfield, $newvalue ) = @_;
+ my $dbh = C4::Context->dbh;
+ if ( !defined $newvalue ) {
+ $newvalue = "";
+ }
+
+ my $record = GetMarcItem( $biblionumber, $itemnumber );
+ my ($tagfield, $tagsubfield) = GetMarcFromKohaField($dbh, $itemfield,'');
+ if ($tagfield && $tagsubfield) {
+ 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);
+ &ModItemInMarc( $record, $biblionumber, $itemnumber, 0 );
+ }
+ }
+}
+
+=head2 ModItemInMarc
+
+=over
+
+&ModItemInMarc( $record, $biblionumber, $itemnumber )
+
+=back
+
+=cut
+
+sub ModItemInMarc {
+ my ( $ItemRecord, $biblionumber, $itemnumber, $frameworkcode) = @_;
+ my $dbh = C4::Context->dbh;
+
+ # get complete MARC record & replace the item field by the new one
+ my $completeRecord = GetMarcBiblio($biblionumber);
+ my ($itemtag,$itemsubfield) = GetMarcFromKohaField($dbh,"items.itemnumber",$frameworkcode);
+ my $itemField = $ItemRecord->field($itemtag);
+ my @items = $completeRecord->field($itemtag);
+ foreach (@items) {
+ if ($_->subfield($itemsubfield) eq $itemnumber) {
+# $completeRecord->delete_field($_);
+ $_->replace_with($itemField);
+ }
+ }
+ # save the record
+ my $sth = $dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=?");
+ $sth->execute( $completeRecord->as_usmarc(), $completeRecord->as_xml_record(),$biblionumber );
+ $sth->finish;
+ ModZebra($biblionumber,"specialUpdate","biblioserver");
+}
+
=head2 DelBiblio
-my $error = &DelBiblio($dbh,$biblionumber);
+=over
+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
+=back
+
=cut
sub DelBiblio {
@@ -501,7 +566,7 @@
"SELECT itemnumber FROM items WHERE biblioitemnumber=?");
$items_sth->execute($biblioitemnumber);
while ( my $itemnumber = $items_sth->fetchrow ) {
- $error = &_koha_delete_items( $dbh, $itemnumber );
+ $error = &_koha_delete_item( $dbh, $itemnumber );
return $error if $error;
}
}
@@ -512,45 +577,62 @@
=head2 DelItem
-DelItem( $biblionumber, $itemnumber );
+=over
+DelItem( $biblionumber, $itemnumber );
Exported function (core API) for deleting an item record in Koha.
+=back
+
=cut
sub DelItem {
my ( $biblionumber, $itemnumber ) = @_;
my $dbh = C4::Context->dbh;
&_koha_delete_item( $dbh, $itemnumber );
- my $newrec = &MARCdelitem( $biblionumber, $itemnumber );
- &MARCaddbiblio( $newrec, $biblionumber, GetFrameworkCode($biblionumber) );
+ # get the MARC record
+ my $record = GetMarcBiblio($biblionumber);
+ my $frameworkcode = GetFrameworkCode($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 ( $itemtag, $itemsubfield ) = GetMarcFromKohaField($dbh,"items.itemnumber",$frameworkcode);
+ my @fields = $record->field($itemtag);
+ # delete the item specified
+ foreach my $field (@fields) {
+ if ( $field->subfield($itemsubfield) eq $itemnumber ) {
+ $record->delete_field($field);
+ }
+ }
+ &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
&logaction(C4::Context->userenv->{'number'},"CATALOGUING","DELETE",$itemnumber,"item")
if C4::Context->preference("CataloguingLog");
}
=head2 GetBiblioData
- $data = &GetBiblioData($biblionumber, $type);
+=over 4
+$data = &GetBiblioData($biblionumber);
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.
+=back
+
=cut
-#'
sub GetBiblioData {
- my ( $bibnum, $type ) = @_;
+ my ( $bibnum ) = @_;
my $dbh = C4::Context->dbh;
my $query = "
@@ -573,6 +655,8 @@
=head2 GetItemsInfo
+=over 4
+
@results = &GetItemsInfo($biblionumber, $type);
Returns information about books with the given biblionumber.
@@ -615,9 +699,10 @@
=back
+=back
+
=cut
-#'
sub GetItemsInfo {
my ( $biblionumber, $type ) = @_;
my $dbh = C4::Context->dbh;
@@ -730,12 +815,14 @@
=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
+=over 4
+
+$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
@@ -751,6 +838,7 @@
=head3 in TEMPLATE
+
<select name="statusloop">
<option value="">Default</option>
<!-- TMPL_LOOP name="statusloop" -->
@@ -805,10 +893,12 @@
=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
+=over 4
+
+$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
@@ -825,12 +915,15 @@
$template->param(itemlocationloop => \@itemlocloop);
=head3 in TEMPLATE
- <select name="location">
+
+<select name="location">
<option value="">Default</option>
- <!-- TMPL_LOOP name="itemlocationloop" -->
+<!-- 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>
+<!-- /TMPL_LOOP -->
+</select>
+
+=back
=cut
@@ -879,13 +972,17 @@
=head2 &GetBiblioItemData
- $itemdata = &GetBiblioItemData($biblioitemnumber);
+=over 4
+
+$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}>.
+=back
+
=cut
#'
@@ -908,8 +1005,12 @@
=head2 GetItemFromBarcode
+=over 4
+
$result = GetItemFromBarcode($barcode);
+=back
+
=cut
sub GetItemFromBarcode {
@@ -925,8 +1026,12 @@
=head2 GetBiblioItemByBiblioNumber
+=over 4
+
NOTE : This function has been copy/paste from C4/Biblio.pm from head before zebra integration.
+=back
+
=cut
sub GetBiblioItemByBiblioNumber {
@@ -948,7 +1053,9 @@
=head2 GetBiblioFromItemNumber
- $item = &GetBiblioFromItemNumber($itemnumber);
+=over 4
+
+$item = &GetBiblioFromItemNumber($itemnumber);
Looks up the item with the given itemnumber.
@@ -956,6 +1063,8 @@
from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
database.
+=back
+
=cut
#'
@@ -978,8 +1087,12 @@
=head2 GetBiblio
+=over 4
+
( $count, @results ) = &GetBiblio($biblionumber);
+=back
+
=cut
sub GetBiblio {
@@ -999,7 +1112,9 @@
=head2 get_itemnumbers_of
- my @itemnumbers_of = get_itemnumbers_of(@biblionumbers);
+=over 4
+
+my @itemnumbers_of = get_itemnumbers_of(@biblionumbers);
Given a list of biblionumbers, return the list of corresponding itemnumbers
for each biblionumber.
@@ -1007,6 +1122,8 @@
Return a reference on a hash where keys are biblionumbers and values are
references on array of itemnumbers.
+=back
+
=cut
sub get_itemnumbers_of {
@@ -1032,30 +1149,14 @@
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
+=over 4
+
GetItemInfosOf(@itemnumbers);
+=back
+
=cut
sub GetItemInfosOf {
@@ -1071,8 +1172,12 @@
=head2 GetBiblioItemInfosOf
+=over 4
+
GetBiblioItemInfosOf(@biblioitemnumbers);
+=back
+
=cut
sub GetBiblioItemInfosOf {
@@ -1088,155 +1193,60 @@
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:
+=head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
- action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
+=head2 GetMarcStructure
-and maybe
+=over 4
- recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
- syntax => the record syntax (transfer syntax)
- databaseName = Database from connection object
+$res = GetMarcStructure($dbh,$forlibrarian,$frameworkcode);
- To set serviceOptions, call set_service_options($serviceType)
+Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
+$dbh : DB handler
+$forlibrarian :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
+$frameworkcode : the framework code to read
-C<$record> the record, if one is needed for the service type
+=back
- A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
+=back
=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();
+sub GetMarcStructure {
+ my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
+ $frameworkcode = "" unless $frameworkcode;
+ my $sth;
+ my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
- # set our options
- $Zpackage->option( action => $action );
+ # 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 );
- if ( $serviceOptions->{'databaseName'} ) {
- $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
- }
- if ( $serviceOptions->{'recordIdNumber'} ) {
- $Zpackage->option(
- recordIdNumber => $serviceOptions->{'recordIdNumber'} );
- }
- if ( $serviceOptions->{'recordIdOpaque'} ) {
- $Zpackage->option(
- recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
+ 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;
}
- # 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 GetMarcStructure
-
-=cut
-
-sub GetMarcStructure {
- 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,defaultvalue from marc_subfield_structure where frameworkcode=? order by tagfield,tagsubfield"
- );
- $sth->execute($frameworkcode);
+ $sth =
+ $dbh->prepare(
+"select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue from marc_subfield_structure where frameworkcode=? order by tagfield,tagsubfield"
+ );
+ $sth->execute($frameworkcode);
my $subfield;
my $authorised_value;
@@ -1281,6 +1291,14 @@
=head2 GetMarcFromKohaField
+=over 4
+
+($MARCfield,$MARCsubfield)=GetMarcFromKohaField($dbh,$kohafield,$frameworkcode);
+Returns the MARC fields & subfields mapped to the koha field
+for the given frameworkcode
+
+=back
+
=cut
sub GetMarcFromKohaField {
@@ -1293,87 +1311,14 @@
);
}
-=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;
- ModZebra($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
+=over 4
+
Returns MARC::Record of the biblionumber passed in parameter.
+the marc record contains both biblio & item datas
+
+=back
=cut
@@ -1398,9 +1343,14 @@
=head2 GetXmlBiblio
+=over 4
+
my $marcxml = GetXmlBiblio($biblionumber);
Returns biblioitems.marcxml of the biblionumber passed in parameter.
+The XML contains both biblio & item datas
+
+=back
=cut
@@ -1416,8 +1366,13 @@
=head2 GetAuthorisedValueDesc
+=over 4
+
my $subfieldvalue =get_authorised_value_desc(
$tag, $subf[$i][0],$subf[$i][1], '', $taglib);
+Retrieve the complete description for a given authorised value.
+
+=back
=cut
@@ -1454,8 +1409,12 @@
=head2 GetMarcItem
+=over 4
+
Returns MARC::Record of the item passed in parameter.
+=back
+
=cut
sub GetMarcItem {
@@ -1483,11 +1442,13 @@
=head2 GetMarcNotes
-$marcnotesarray = GetMarcNotes( $record, $marcflavour );
+=over 4
-get a single record in piggyback mode from Zebra and return it in the requested record syntax
+$marcnotesarray = GetMarcNotes( $record, $marcflavour );
+Get all notes from the MARC record and returns them in an array.
+The note are stored in differents places depending on MARC flavour
-default record syntax is XML
+=back
=cut
@@ -1525,7 +1486,13 @@
=head2 GetMarcSubjects
+=over 4
+
$marcsubjcts = GetMarcSubjects($record,$marcflavour);
+Get all subjects from the MARC record and returns them in an array.
+The subjects are stored in differents places depending on MARC flavour
+
+=back
=cut
@@ -1576,7 +1543,13 @@
=head2 GetMarcAuthors
+=over 4
+
authors = GetMarcAuthors($record,$marcflavour);
+Get all authors from the MARC record and returns them in an array.
+The authors are stored in differents places depending on MARC flavour
+
+=back
=cut
@@ -1618,7 +1591,13 @@
=head2 GetMarcSeries
+=over 4
+
$marcseriessarray = GetMarcSeries($record,$marcflavour);
+Get all series from the MARC record and returns them in an array.
+The series are stored in differents places depending on MARC flavour
+
+=back
=cut
@@ -1679,243 +1658,70 @@
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 ) = @_;
+=head2 GetFrameworkCode
- # delete original record but save the items
- my $newrec = &MARCdelbiblio( $biblionumber, $keep_items );
+=over 4
- # recreate it and add the new fields
- my @fields = $record->fields();
- foreach my $field (@fields) {
+$frameworkcode = GetFrameworkCode( $biblionumber )
- # this requires a more recent version of MARC::Record
- # but ensures the fields are in order
- $newrec->insert_fields_ordered($field);
- }
+=back
- # give back our old leader
- $newrec->leader( $record->leader() );
+=cut
- # add the record back with the items info preserved
- &MARCaddbiblio( $newrec, $biblionumber, $frameworkcode );
+sub GetFrameworkCode {
+ 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 MARCdelbiblio
+=head2 TransformKohaToMarc
-&MARCdelbiblio( $biblionumber, $keep_items )
+=over 4
-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.
+$record = TransformKohaToMarc( $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
-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
+=back
=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();
+sub TransformKohaToMarc {
- # now, delete in MARC tables.
- if ( $keep_items eq 1 ) {
- #search item field code
+ my ( $hash ) = @_;
+ my $dbh = C4::Context->dbh;
my $sth =
$dbh->prepare(
-"select tagfield from marc_subfield_structure where kohafield like 'items.%'"
+ "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
);
- $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
+ my $record = MARC::Record->new();
+ foreach (keys %{$hash}) {
+ &TransformKohaToMarcOneField( $sth, $record, $_,
+ $hash->{$_}, '' );
}
return $record;
}
-=head2 MARCdelitem
+=head2 TransformKohaToMarcOneField
+
+=over 4
-MARCdelitem( $biblionumber, $itemnumber )
+$record = TransformKohaToMarcOneField( $sth, $record, $kohafieldname, $value, $frameworkcode );
-delete the item field from the MARC record for the itemnumber specified
+=back
=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 = GetMarcItem( $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 GetFrameworkCode
-
-$frameworkcode = GetFrameworkCode( $biblionumber )
-
-=cut
-
-sub GetFrameworkCode {
- 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 MARCkoha2marcOnefield
-
-$record = MARCkoha2marcOnefield( $sth, $record, $kohafieldname, $value, $frameworkcode );
-
-=cut
-
-sub MARCkoha2marcOnefield {
- my ( $sth, $record, $kohafieldname, $value, $frameworkcode ) = @_;
- $frameworkcode='' unless $frameworkcode;
- my $tagfield;
- my $tagsubfield;
+sub TransformKohaToMarcOneField {
+ my ( $sth, $record, $kohafieldname, $value, $frameworkcode ) = @_;
+ $frameworkcode='' unless $frameworkcode;
+ my $tagfield;
+ my $tagsubfield;
if ( !defined $sth ) {
my $dbh = C4::Context->dbh;
@@ -1941,8 +1747,12 @@
=head2 TransformHtmlToXml
+=over 4
+
$xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator, $ind_tag )
+=back
+
=cut
sub TransformHtmlToXml {
@@ -2048,8 +1858,12 @@
=head2 TransformHtmlToMarc
+=over 4
+
$record = TransformHtmlToMarc( $dbh, $rtags, $rsubfields, $rvalues, %indicators )
+=back
+
=cut
sub TransformHtmlToMarc {
@@ -2126,8 +1940,12 @@
=head2 TransformMarcToKoha
+=over 4
+
$result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
+=back
+
=cut
sub TransformMarcToKoha {
@@ -2188,8 +2006,12 @@
=head2 TransformMarcToKohaOneField
+=over 4
+
$result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
+=back
+
=cut
sub TransformMarcToKohaOneField {
@@ -2230,247 +2052,793 @@
}
return $result;
}
+=head1 OTHER FUNCTIONS
-=head2 MARCitemchange
-
-&MARCitemchange( $record, $itemfield, $newvalue )
+=head2 char_decode
-=cut
+=over 4
-sub MARCitemchange {
- my ( $record, $itemfield, $newvalue ) = @_;
- my $dbh = C4::Context->dbh;
+my $string = char_decode( $string, $encoding );
- my ( $tagfield, $tagsubfield ) =
- GetMarcFromKohaField( $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);
- }
- }
-}
+converts ISO 5426 coded string to UTF-8
+sloppy code : should be improved in next issue
-=head1 INTERNAL FUNCTIONS
+=back
-=head2 _koha_add_biblio
+=cut
-_koha_add_biblio($dbh,$biblioitem);
+sub char_decode {
+ my ( $string, $encoding ) = @_;
+ $_ = $string;
-Internal function to add a biblio ($biblio is a hash with the values)
+ $encoding = C4::Context->preference("marcflavour") unless $encoding;
+ if ( $encoding eq "UNIMARC" ) {
-=cut
+ # 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;
-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;
+ # this handles non-sorting blocks (if implementation requires this)
+ $string = nsb_clean($_);
+ }
+ elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
+ ##MARC-8 to UTF-8
- 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.
+ 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;
-=cut
+ #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;
-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);
- }
- }
- }
+ # this handles non-sorting blocks (if implementation requires this)
+ $string = nsb_clean($_);
}
- return ( $indicator, @result );
+ return ($string);
}
-=head2 _koha_modify_biblio
-
-Internal function for updating the biblio table
-
-=cut
-
-sub _koha_modify_biblio {
- my ( $dbh, $biblio ) = @_;
+=head2 nsb_clean
-# 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'} );
-}
+=over 4
-=head2 _koha_modify_biblioitem
+my $string = nsb_clean( $string, $encoding );
-_koha_modify_biblioitem( $dbh, $biblioitem );
+=back
=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";
- }
+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 _koha_modify_note
-
-_koha_modify_note( $dbh, $bibitemnum, $note );
-
-=cut
-
-sub _koha_modify_note {
- my ( $dbh, $bibitemnum, $note ) = @_;
+=head2 PrepareItemrecordDisplay
- # my $dbh=C4Connect;
- my $query = "update biblioitems set notes='$note' where
- biblioitemnumber='$bibitemnum'";
- my $sth = $dbh->prepare($query);
- $sth->execute;
- $sth->finish;
-}
+=over 4
-=head2 _koha_add_biblioitem
+PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber);
-_koha_add_biblioitem( $dbh, $biblioitem );
+Returns a hash with all the fields for Display a given item data in a template
-Internal function to add a biblioitem
+=back
=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;
+sub PrepareItemrecordDisplay {
- $sth->finish;
+ my ( $bibnum, $itemnum ) = @_;
- $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'};
+ my $dbh = C4::Context->dbh;
+ my $frameworkcode = &GetFrameworkCode( $bibnum );
+ my ( $itemtagfield, $itemtagsubfield ) =
+ &GetMarcFromKohaField( $dbh, "items.itemnumber", $frameworkcode );
+ my $tagslib = &GetMarcStructure( $dbh, 1, $frameworkcode );
+ my $itemrecord = GetMarcItem( $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
+ };
+}
+#"
+
+#
+# true ModZebra 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 ModZebra to run.
+# the table is emptied by misc/cronjobs/zebraqueue_start.pl script
+# =head2 ModZebrafiles
+#
+# &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
+#
+# =cut
+#
+# sub ModZebrafiles {
+#
+# 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 ModZebra
+
+=over 4
+
+ModZebra( $dbh, $biblionumber, $op, $server );
+
+=back
+
+=cut
+
+sub ModZebra {
+###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
+ my ( $biblionumber, $op, $server ) = @_;
+ my $dbh=C4::Context->dbh;
+ #warn "SERVER:".$server;
+#
+# true ModZebra 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 ModZebra 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();
+# ModZebrafiles( $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();
+}
+
+=head1 INTERNAL FUNCTIONS
+
+=head2 MARCitemchange
+
+=over 4
+
+&MARCitemchange( $record, $itemfield, $newvalue )
+
+Function to update a single value in an item field.
+Used twice, could probably be replaced by something else, but works well...
+
+=back
+
+=back
+
+=cut
+
+sub MARCitemchange {
+ my ( $record, $itemfield, $newvalue ) = @_;
+ my $dbh = C4::Context->dbh;
+
+ my ( $tagfield, $tagsubfield ) =
+ GetMarcFromKohaField( $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);
+ }
+ }
+}
+
+=head2 _koha_add_biblio
+
+=over 4
+
+_koha_add_biblio($dbh,$biblioitem);
+
+Internal function to add a biblio ($biblio is a hash with the values)
+
+=back
+
+=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
+
+=over 4
+
+($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.
+
+=back
+
+=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
+
+=over 4
+
+Internal function for updating the biblio table
+
+=back
+
+=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
+
+=over 4
+
+_koha_modify_biblioitem( $dbh, $biblioitem );
+
+=back
+
+=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_add_biblioitem
+
+=over 4
+
+_koha_add_biblioitem( $dbh, $biblioitem );
+
+Internal function to add a biblioitem
+
+=back
+
+=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'},
@@ -2491,8 +2859,12 @@
=head2 _koha_new_items
+=over 4
+
_koha_new_items( $dbh, $item, $barcode );
+=back
+
=cut
sub _koha_new_items {
@@ -2575,856 +2947,523 @@
$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} );
+ $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
+ );
}
-
- # 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;
+ if ( defined $sth->errstr ) {
+ $error .= $sth->errstr;
}
- $sth->finish;
- return undef;
+ return ( $itemnumber, $error );
}
-=head2 _koha_delete_items
+=head2 _koha_modify_item
-$error = _koha_delete_items($dbh,$itemnumber);
+=over 4
-Internal sub for deleting from items table -- also saves to deleteditems
+_koha_modify_item( $dbh, $item, $op );
-C<$dbh> - the database handle
-C<$itemnumber> - the itemnumber of the item to be deleted
+=back
=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;
+sub _koha_modify_item {
+ my ( $dbh, $item, $op ) = @_;
+ $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
- # delete the item
- my $del_sth = $dbh->prepare("DELETE FROM items WHERE itemnumber=?");
- $del_sth->execute($itemnumber);
- $del_sth->finish;
- }
+ # 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;
-}
-
-=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;
+## Now calculate lccalnumber
+ my ($cutterextra) =
+ itemcalculator( $dbh, $item->{'bibitemnum'}, $item->{'itemcallnumber'} );
- #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;
+ my $query = "UPDATE items SET
+barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,homebranch=?,cutterextra=?, onloan=?, binding=?";
- # this handles non-sorting blocks (if implementation requires this)
- $string = nsb_clean($_);
+ 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};
}
- return ($string);
+ 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 PrepareItemrecordDisplay
+=head2 _koha_delete_biblio
-PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber);
+=over 4
-Returns a hash with all the fields for Display a given item data in a template
+$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
+
+=back
=cut
-sub PrepareItemrecordDisplay {
+# FIXME: add error handling
- my ( $bibnum, $itemnum ) = @_;
+sub _koha_delete_biblio {
+ my ( $dbh, $biblionumber ) = @_;
- my $dbh = C4::Context->dbh;
- my $frameworkcode = &GetFrameworkCode( $bibnum );
- my ( $itemtagfield, $itemtagsubfield ) =
- &GetMarcFromKohaField( $dbh, "items.itemnumber", $frameworkcode );
- my $tagslib = &GetMarcStructure( $dbh, 1, $frameworkcode );
- my $itemrecord = GetMarcItem( $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'};
+ # get all the data for this biblio
+ my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
+ $sth->execute($biblionumber);
- # $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;
+ if ( my $data = $sth->fetchrow_hashref ) {
- # 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);
+ # 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;
}
- if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
- my @authorised_values;
- my %authorised_lib;
+ $sth->finish;
+ return undef;
+}
- # 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 ) )
- {
+=head2 _koha_delete_biblioitems
+
+=over 4
+
+$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
+
+=back
+
+=cut
+
+# FIXME: add error handling
+
+sub _koha_delete_biblioitems {
+ my ( $dbh, $biblioitemnumber ) = @_;
+
+ # get all the data for this biblioitem
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;
- }
+ $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} );
}
- 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;
+
+ # 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_item
+
+=over 4
+
+_koha_delete_item( $dbh, $itemnum );
+
+Internal function to delete an item record from the koha tables
+
+=back
+
+=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;
+}
+
+=head1 UNEXPORTED FUNCTIONS
+
+=over 4
+
+=head2 calculatelc
+
+$lc = calculatelc($classification);
+
+=back
+
+=cut
+
+sub calculatelc {
+ my ($classification) = @_;
+ $classification =~ s/^\s+|\s+$//g;
+ my $i = 0;
+ my $lc2;
+ my $lc1;
- #----- 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;
- }
+ for ( $i = 0 ; $i < length($classification) ; $i++ ) {
+ my $c = ( substr( $classification, $i, 1 ) );
+ if ( $c ge '0' && $c le '9' ) {
- #---- "true" authorised value
+ $lc2 = substr( $classification, $i );
+ last;
}
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,
- );
+ $lc1 .= substr( $classification, $i, 1 );
+
}
- 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>";
+ } #while
-#"
-# 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";
+ my $other = length($lc1);
+ if ( !$lc1 ) {
+ $other = 0;
}
- else {
- $subfield_data{marc_value} =
-"<input type=\"text\" name=\"field_value\" value=\"$value\" size=50 maxlength=255>";
+
+ my $extras;
+ if ( $other < 4 ) {
+ for ( 1 .. ( 4 - $other ) ) {
+ $extras .= "0";
}
- push( @loop_data, \%subfield_data );
}
+ $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";
}
}
- my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
- if ( $itemrecord && $itemrecord->field($itemtagfield) );
- return {
- 'itemtagfield' => $itemtagfield,
- 'itemtagsubfield' => $itemtagsubfield,
- 'itemnumber' => $itemnumber,
- 'iteminformation' => \@loop_data
- };
+ $lc2 = $extras . $lc2;
+ return ( $lc1 . $lc2 );
}
-=head2 nsb_clean
+=head2 itemcalculator
-my $string = nsb_clean( $string, $encoding );
+=over 4
-=cut
+$cutterextra = itemcalculator( $dbh, $biblioitem, $callnumber );
-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);
-}
+=back
-=head2 ModZebrafiles
+=cut
-&ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
+sub itemcalculator {
+ my ( $dbh, $biblioitem, $callnumber ) = @_;
+ my $sth =
+ $dbh->prepare(
+"select classification, subclass from biblioitems where biblioitemnumber=?"
+ );
-=cut
+ $sth->execute($biblioitem);
+ my ( $classification, $subclass ) = $sth->fetchrow;
+ my $all = $classification . " " . $subclass;
+ my $total = length($all);
+ my $cutterextra = substr( $callnumber, $total - 1 );
-sub ModZebrafiles {
+ return $cutterextra;
+}
- my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
+=head2 ModBiblioMarc
- 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;
+=over 4
- if ($record) {
- open( OUTPUT, ">", $filename . ".xml" );
- print OUTPUT $record;
- close OUTPUT;
- }
-}
+&ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
-=head2 ModZebra
+Add MARC data for a biblio to koha
-ModZebra( $dbh, $biblionumber, $op, $server );
+Function exported, but should NOT be used, unless you really know what you're doing
+
+=back
=cut
-sub ModZebra {
-###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
- my ( $biblionumber, $op, $server ) = @_;
- my $dbh=C4::Context->dbh;
- #warn "SERVER:".$server;
-#
-# true ModZebra 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 ModZebra to run.
-# the table is emptied by misc/cronjobs/zebraqueue_start.pl script
+sub ModBiblioMarc {
-my $sth=$dbh->prepare("insert into zebraqueue (biblio_auth_number ,server,operation) values(?,?,?)");
-$sth->execute($biblionumber,$server,$op);
-$sth->finish;
+# 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");
-#
-# 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();
-# ModZebrafiles( $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();
+# 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;
+ ModZebra($biblionumber,"specialUpdate","biblioserver");
+ return $biblionumber;
}
-=head2 calculatelc
+=head2 AddItemInMarc
-$lc = calculatelc($classification);
+=over 4
+
+$newbiblionumber = AddItemInMarc( $record, $biblionumber, $frameworkcode );
+
+Add an item in a MARC record and save the MARC record
+
+Function exported, but should NOT be used, unless you really know what you're doing
+
+=back
=cut
-sub calculatelc {
- my ($classification) = @_;
- $classification =~ s/^\s+|\s+$//g;
- my $i = 0;
- my $lc2;
- my $lc1;
+sub AddItemInMarc {
- for ( $i = 0 ; $i < length($classification) ; $i++ ) {
- my $c = ( substr( $classification, $i, 1 ) );
- if ( $c ge '0' && $c le '9' ) {
+# 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);
- $lc2 = substr( $classification, $i );
- last;
+ # create it
+ my @fields = $record->fields();
+ foreach my $field (@fields) {
+ $newrec->append_fields($field);
}
- else {
- $lc1 .= substr( $classification, $i, 1 );
- }
- } #while
+ # FIXME: should we be making sure the biblionumbers are the same?
+ my $newbiblionumber =
+ &ModBiblioMarc( $newrec, $biblionumber, $frameworkcode );
+ return $newbiblionumber;
+}
- my $other = length($lc1);
- if ( !$lc1 ) {
- $other = 0;
- }
+=head2 z3950_extended_services
- my $extras;
- if ( $other < 4 ) {
- for ( 1 .. ( 4 - $other ) ) {
- $extras .= "0";
+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'} );
}
- $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
+ # 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'});
+ #}
- for ( 1 .. ( 5 - $pos ) ) {
- $extras .= "0";
+ if ( $serviceOptions->{record} ) {
+ $Zpackage->option( record => $serviceOptions->{record} );
+
+ # can be xml or marc
+ if ( $serviceOptions->{'syntax'} ) {
+ $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
}
}
- $lc2 = $extras . $lc2;
- return ( $lc1 . $lc2 );
+
+ # 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 itemcalculator
+=head2 set_service_options
-$cutterextra = itemcalculator( $dbh, $biblioitem, $callnumber );
+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 itemcalculator {
- my ( $dbh, $biblioitem, $callnumber ) = @_;
- my $sth =
- $dbh->prepare(
-"select classification, subclass from biblioitems where biblioitemnumber=?"
- );
+sub set_service_options {
+ my ($serviceType) = @_;
+ my $serviceOptions;
- $sth->execute($biblioitem);
- my ( $classification, $subclass ) = $sth->fetchrow;
- my $all = $classification . " " . $subclass;
- my $total = length($all);
- my $cutterextra = substr( $callnumber, $total - 1 );
+# 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
- return $cutterextra;
+ 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;
}
END { } # module clean-up code here (global destructor)
@@ -3443,15 +3482,27 @@
=cut
-# $Id: Biblio.pm,v 1.192 2007/03/29 13:30:31 tipaul Exp $
+# $Id: Biblio.pm,v 1.193 2007/03/29 16:45:53 tipaul Exp $
# $Log: Biblio.pm,v $
+# Revision 1.193 2007/03/29 16:45:53 tipaul
+# Code cleaning of Biblio.pm (continued)
+#
+# All subs have be cleaned :
+# - removed useless
+# - merged some
+# - reordering Biblio.pm completly
+# - using only naming conventions
+#
+# Seems to have broken nothing, but it still has to be heavily tested.
+# Note that Biblio.pm is now much more efficient than previously & probably more reliable as well.
+#
# Revision 1.192 2007/03/29 13:30:31 tipaul
# Code cleaning :
# == Biblio.pm cleaning (useless) ==
# * some sub declaration dropped
# * removed modbiblio sub
# * removed moditem sub
-# * removed newitems. It was used only in finishrecieve. Replaced by a Koha2Marc+AddItem, that is better.
+# * removed newitems. It was used only in finishrecieve. Replaced by a TransformKohaToMarc+AddItem, that is better.
# * removed MARCkoha2marcItem
# * removed MARCdelsubfield declaration
# * removed MARCkoha2marcBiblio
@@ -3479,252 +3530,3 @@
# Revision 1.189 2007/03/28 10:39:16 hdl
# removing $dbh as a parameter in AuthoritiesMarc functions
# And reporting all differences into the scripts taht relies on those functions.
-#
-# 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 ModZebra.
-#
-# 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 ModZebra for delete biblios :
-#
-# 1) restore C4::Circulation::Circ2::itemissues, (was missing)
-# 2) restore ModZebra 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 ModZebra 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 GetMarcItem, 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.
-
Index: C4/Context.pm
===================================================================
RCS file: /sources/koha/koha/C4/Context.pm,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -b -r1.53 -r1.54
--- C4/Context.pm 29 Mar 2007 13:30:31 -0000 1.53
+++ C4/Context.pm 29 Mar 2007 16:45:53 -0000 1.54
@@ -16,7 +16,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Context.pm,v 1.53 2007/03/29 13:30:31 tipaul Exp $
+# $Id: Context.pm,v 1.54 2007/03/29 16:45:53 tipaul Exp $
use strict;
use DBI;
use ZOOM;
@@ -28,7 +28,7 @@
qw($context),
qw(@context_stack);
-$VERSION = do { my @v = '$Revision: 1.53 $' =~ /\d+/g;
+$VERSION = do { my @v = '$Revision: 1.54 $' =~ /\d+/g;
shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
=head1 NAME
@@ -874,13 +874,25 @@
=cut
# $Log: Context.pm,v $
+# Revision 1.54 2007/03/29 16:45:53 tipaul
+# Code cleaning of Biblio.pm (continued)
+#
+# All subs have be cleaned :
+# - removed useless
+# - merged some
+# - reordering Biblio.pm completly
+# - using only naming conventions
+#
+# Seems to have broken nothing, but it still has to be heavily tested.
+# Note that Biblio.pm is now much more efficient than previously & probably more reliable as well.
+#
# Revision 1.53 2007/03/29 13:30:31 tipaul
# Code cleaning :
# == Biblio.pm cleaning (useless) ==
# * some sub declaration dropped
# * removed modbiblio sub
# * removed moditem sub
-# * removed newitems. It was used only in finishrecieve. Replaced by a Koha2Marc+AddItem, that is better.
+# * removed newitems. It was used only in finishrecieve. Replaced by a TransformKohaToMarc+AddItem, that is better.
# * removed MARCkoha2marcItem
# * removed MARCdelsubfield declaration
# * removed MARCkoha2marcBiblio
Index: C4/Circulation/Circ2.pm
===================================================================
RCS file: /sources/koha/koha/C4/Circulation/Circ2.pm,v
retrieving revision 1.126
retrieving revision 1.127
diff -u -b -r1.126 -r1.127
--- C4/Circulation/Circ2.pm 10 Mar 2007 06:28:07 -0000 1.126
+++ C4/Circulation/Circ2.pm 29 Mar 2007 16:45:53 -0000 1.127
@@ -17,7 +17,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Circ2.pm,v 1.126 2007/03/10 06:28:07 kados Exp $
+# $Id: Circ2.pm,v 1.127 2007/03/29 16:45:53 tipaul Exp $
use strict;
require Exporter;
@@ -41,7 +41,7 @@
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.126 $' =~ /\d+/g; shift(@v).".".join( "_", map { sprintf "%03d", $_ } @v ); };
+$VERSION = do { my @v = '$Revision: 1.127 $' =~ /\d+/g; shift(@v).".".join( "_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
@@ -614,8 +614,8 @@
);
$sth->execute();
while ( my ( $biblionumber, $holdingbranch ) = $sth->fetchrow ) {
- &MARCmoditemonefield( $biblionumber, $itemnumber,
- 'items.holdingbranch', $holdingbranch, 0 );
+ &ModItemInMarconefield( $biblionumber, $itemnumber,
+ 'items.holdingbranch', $holdingbranch );
}
return;
}
Index: koha-tmpl/intranet-tmpl/prog/en/help/admin/checkmarc.tmpl
===================================================================
RCS file: /sources/koha/koha/koha-tmpl/intranet-tmpl/prog/en/help/admin/checkmarc.tmpl,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -b -r1.4 -r1.5
--- koha-tmpl/intranet-tmpl/prog/en/help/admin/checkmarc.tmpl 11 Mar 2007 21:08:13 -0000 1.4
+++ koha-tmpl/intranet-tmpl/prog/en/help/admin/checkmarc.tmpl 29 Mar 2007 16:45:53 -0000 1.5
@@ -3,7 +3,7 @@
<!-- TMPL_INCLUDE NAME="doc-head-close.inc" -->
<h1>MARC Check</h1>
-<p>Once you have completed the process of setting up your MARC tag structure (MarcTagstruct) and checked your MARC to Koha mapping (Koha2MarcLinks), click on this link to activate a small program that checks for major errors in your MARC setup.</p>
+<p>Once you have completed the process of setting up your MARC tag structure (MarcTagstruct) and checked your MARC to Koha mapping (TransformKohaToMarcLinks), click on this link to activate a small program that checks for major errors in your MARC setup.</p>
<p>This MARC check does not guarantee that you will like the first results of your efforts to set up your MARC displays, etc. -- it simply checks for major errors. You will probably revise your MARC setup several times before you are completely pleased with it. Be sure to run checkmarc after every revision.</p>
<!-- TMPL_INCLUDE name="intranet-bottom.inc" -->
Index: misc/migration_tools/22_to_30/missing090field.pl
===================================================================
RCS file: /sources/koha/koha/misc/migration_tools/22_to_30/missing090field.pl,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -b -r1.3 -r1.4
--- misc/migration_tools/22_to_30/missing090field.pl 29 Mar 2007 13:30:32 -0000 1.3
+++ misc/migration_tools/22_to_30/missing090field.pl 29 Mar 2007 16:45:54 -0000 1.4
@@ -42,7 +42,7 @@
if ($update){
- &MARCmodbiblio($dbh,$biblionumber,$record,'',0);
+ &ModBiblioMarc($record,'',$biblionumber);
print "\n modified : $biblionumber \n";
}
Index: misc/migration_tools/22_to_30/rebuild_leader.pl
===================================================================
RCS file: /sources/koha/koha/misc/migration_tools/22_to_30/rebuild_leader.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -b -r1.1 -r1.2
--- misc/migration_tools/22_to_30/rebuild_leader.pl 9 Mar 2007 15:44:38 -0000 1.1
+++ misc/migration_tools/22_to_30/rebuild_leader.pl 29 Mar 2007 16:45:54 -0000 1.2
@@ -42,7 +42,7 @@
$record->delete_field($_);
}
if ($update){
- &MARCmodbiblio($dbh,$biblionumber,$record,'',0);
+ &ModBiblioMarc($record,'',$biblionumber);
print "$biblionumber \n";
}
Index: misc/migration_tools/22_to_30/rebuild_unimarc_100.pl
===================================================================
RCS file: /sources/koha/koha/misc/migration_tools/22_to_30/rebuild_unimarc_100.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -b -r1.1 -r1.2
--- misc/migration_tools/22_to_30/rebuild_unimarc_100.pl 9 Mar 2007 15:44:38 -0000 1.1
+++ misc/migration_tools/22_to_30/rebuild_unimarc_100.pl 29 Mar 2007 16:45:54 -0000 1.2
@@ -51,7 +51,7 @@
$record->delete_field($_);
}
if ($update){
- &MARCmodbiblio($dbh,$biblionumber,$record,'',0);
+ &ModBiblioMarc($record,$biblionumber,'');
print "$biblionumber \n";
}
Index: misc/missing090field.pl
===================================================================
RCS file: /sources/koha/koha/misc/missing090field.pl,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -b -r1.3 -r1.4
--- misc/missing090field.pl 29 Mar 2007 13:30:32 -0000 1.3
+++ misc/missing090field.pl 29 Mar 2007 16:45:54 -0000 1.4
@@ -42,7 +42,7 @@
if ($update){
-&MARCmodbiblio($dbh,$biblionumber,$record,'',0);
+&ModBiblioMarc($record,'',$biblionumber);
print "$biblionumber \n";
}
Index: misc/rebuildnonmarc.pl
===================================================================
RCS file: /sources/koha/koha/misc/rebuildnonmarc.pl,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -b -r1.7 -r1.8
--- misc/rebuildnonmarc.pl 29 Mar 2007 13:30:32 -0000 1.7
+++ misc/rebuildnonmarc.pl 29 Mar 2007 16:45:54 -0000 1.8
@@ -88,7 +88,6 @@
sub localNEWmodbiblio {
my ($dbh,$record,$bibid,$frameworkcode) =@_;
$frameworkcode="" unless $frameworkcode;
-# &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,0);
my $oldbiblio = TransformMarcToKoha($dbh,$record,$frameworkcode);
return 1;
Index: opac/opac-review.pl
===================================================================
RCS file: /sources/koha/koha/opac/opac-review.pl,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -b -r1.3 -r1.4
--- opac/opac-review.pl 9 Mar 2007 15:12:54 -0000 1.3
+++ opac/opac-review.pl 29 Mar 2007 16:45:54 -0000 1.4
@@ -40,7 +40,7 @@
}
);
-my $biblio = GetBiblioData( $biblionumber, 'opac' );
+my $biblio = GetBiblioData( $biblionumber);
my $savedreview = getreview( $biblionumber, $borrowernumber );
if ( $type eq 'save' ) {
Index: opac/opac-showreviews.pl
===================================================================
RCS file: /sources/koha/koha/opac/opac-showreviews.pl,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -b -r1.3 -r1.4
--- opac/opac-showreviews.pl 9 Mar 2007 15:12:54 -0000 1.3
+++ opac/opac-showreviews.pl 29 Mar 2007 16:45:54 -0000 1.4
@@ -37,7 +37,7 @@
}
);
-my $biblio = GetBiblioData( $biblionumber,'opac' );
+my $biblio = GetBiblioData( $biblionumber );
my $reviews = getreviews( $biblionumber, 1 );
$template->param(
More information about the Koha-cvs
mailing list