X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FBiblio.pm;h=b07073e83a782aa2016429fdc4ccc5a509264158;hb=cf81242caeda06fa925942f109bd0acaf7d0e273;hp=6444c3c56b8a7dbb279020bedc3166a9e78e0c29;hpb=eb52fe26c3fdb5925d326dda2242912899b23609;p=koha.git diff --git a/C4/Biblio.pm b/C4/Biblio.pm index 6444c3c56b..b07073e83a 100755 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -18,108 +18,100 @@ package C4::Biblio; # Suite 330, Boston, MA 02111-1307 USA use strict; - -require Exporter; # use utf8; -use C4::Context; use MARC::Record; use MARC::File::USMARC; use MARC::File::XML; use ZOOM; + +use C4::Context; use C4::Koha; +use C4::Branch; use C4::Dates qw/format_date/; use C4::Log; # logaction use C4::ClassSource; +use C4::Charset; use vars qw($VERSION @ISA @EXPORT); -# TODO: fix version -# $VERSION = ?; +BEGIN { + $VERSION = 1.00; -@ISA = qw( Exporter ); + require Exporter; + @ISA = qw( Exporter ); + # to add biblios # EXPORTED FUNCTIONS. + push @EXPORT, qw( + &AddBiblio + ); -# to add biblios or items -push @EXPORT, qw( &AddBiblio &AddItem ); - -# to get something -push @EXPORT, qw( - &GetBiblio - &GetBiblioData - &GetBiblioItemData - &GetBiblioItemInfosOf - &GetBiblioItemByBiblioNumber - &GetBiblioFromItemNumber - - &GetMarcItem - &GetItem - &GetItemInfosOf - &GetItemStatus - &GetItemLocation - &GetLostItems - &GetItemsForInventory - &GetItemsCount - - &GetMarcNotes - &GetMarcSubjects - &GetMarcBiblio - &GetMarcAuthors - &GetMarcSeries - GetMarcUrls - &GetUsedMarcStructure - - &GetItemsInfo - &GetItemsByBiblioitemnumber - &GetItemnumberFromBarcode - &get_itemnumbers_of - &GetXmlBiblio - - &GetAuthorisedValueDesc - &GetMarcStructure - &GetMarcFromKohaField - &GetFrameworkCode - &GetPublisherNameFromIsbn - &TransformKohaToMarc -); - -# To modify something -push @EXPORT, qw( - &ModBiblio - &ModItem - &ModItemTransfer - &ModBiblioframework - &ModZebra - &ModItemInMarc - &ModItemInMarconefield - &ModDateLastSeen -); - -# To delete something -push @EXPORT, qw( - &DelBiblio - &DelItem -); - -# 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( - &ModBiblioMarc - &AddItemInMarc -); - -# Others functions -push @EXPORT, qw( - &TransformMarcToKoha - &TransformHtmlToMarc2 - &TransformHtmlToMarc - &TransformHtmlToXml - &PrepareItemrecordDisplay - &char_decode - &GetNoZebraIndexes -); + # to get something + push @EXPORT, qw( + &GetBiblio + &GetBiblioData + &GetBiblioItemData + &GetBiblioItemInfosOf + &GetBiblioItemByBiblioNumber + &GetBiblioFromItemNumber + + &GetMarcNotes + &GetMarcSubjects + &GetMarcBiblio + &GetMarcAuthors + &GetMarcSeries + GetMarcUrls + &GetUsedMarcStructure + &GetXmlBiblio + + &GetAuthorisedValueDesc + &GetMarcStructure + &GetMarcFromKohaField + &GetFrameworkCode + &GetPublisherNameFromIsbn + &TransformKohaToMarc + ); + + # To modify something + push @EXPORT, qw( + &ModBiblio + &ModBiblioframework + &ModZebra + ); + # To delete something + push @EXPORT, qw( + &DelBiblio + ); + + # To link headings in a bib record + # to authority records. + push @EXPORT, qw( + &LinkBibHeadingsToAuthorities + ); + + # 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( + &ModBiblioMarc + ); + # Others functions + push @EXPORT, qw( + &TransformMarcToKoha + &TransformHtmlToMarc2 + &TransformHtmlToMarc + &TransformHtmlToXml + &PrepareItemrecordDisplay + &GetNoZebraIndexes + ); +} + +# because of interdependencies between +# C4::Search, C4::Heading, and C4::Biblio, +# 'use C4::Heading' must occur after +# the exports have been defined. +use C4::Heading; =head1 NAME @@ -200,15 +192,38 @@ When modifying a biblio or an item, the behaviour is quite similar. =over 4 ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode); -Exported function (core API) for adding a new biblio to koha. =back +Exported function (core API) for adding a new biblio to koha. + +The first argument is a C object containing the +bib to add, while the second argument is the desired MARC +framework code. + +This function also accepts a third, optional argument: a hashref +to additional options. The only defined option is C, +which if present and mapped to a true value, causes C +to omit the call to save the MARC in C +and C This option is provided B +for the use of scripts such as C that may need +to do some manipulation of the MARC record for item parsing before +saving it and which cannot afford the performance hit of saving +the MARC record twice. Consequently, do not use that option +unless you can guarantee that C will be called. + =cut sub AddBiblio { - my ( $record, $frameworkcode ) = @_; - my ($biblionumber,$biblioitemnumber,$error); + my $record = shift; + my $frameworkcode = shift; + my $options = @_ ? shift : undef; + my $defer_marc_save = 0; + if (defined $options and exists $options->{'defer_marc_save'} and $options->{'defer_marc_save'}) { + $defer_marc_save = 1; + } + + my ($biblionumber,$biblioitemnumber,$error); my $dbh = C4::Context->dbh; # transform the data into koha-table style data my $olddata = TransformMarcToKoha( $dbh, $record, $frameworkcode ); @@ -218,8 +233,11 @@ sub AddBiblio { _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber); + # update MARC subfield that stores biblioitems.cn_sort + _koha_marc_update_biblioitem_cn_sort($record, $olddata, $frameworkcode); + # now add the record - $biblionumber = ModBiblioMarc( $record, $biblionumber, $frameworkcode ); + $biblionumber = ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save; &logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$biblionumber,"biblio") if C4::Context->preference("CataloguingLog"); @@ -227,76 +245,6 @@ sub AddBiblio { return ( $biblionumber, $biblioitemnumber ); } -=head2 AddItem - -=over 2 - - $biblionumber = AddItem( $record, $biblionumber) - Exported function (core API) for adding a new item to Koha - -=back - -=cut - -sub AddItem { - my ( $record, $biblionumber ) = @_; - my $dbh = C4::Context->dbh; - - # add item in old-DB - my $frameworkcode = GetFrameworkCode( $biblionumber ); - my $item = &TransformMarcToKoha( $dbh, $record, $frameworkcode ); - - # needs old biblionumber and biblioitemnumber - $item->{'biblionumber'} = $biblionumber; - my $sth = - $dbh->prepare( - "SELECT biblioitemnumber,itemtype FROM biblioitems WHERE biblionumber=?" - ); - $sth->execute( $item->{'biblionumber'} ); - my $itemtype; - ( $item->{'biblioitemnumber'}, $itemtype ) = $sth->fetchrow; - $sth = - $dbh->prepare( - "SELECT notforloan FROM itemtypes WHERE itemtype=?"); - $sth->execute( C4::Context->preference('item-level_itypes') ? $item->{'itype'} : $itemtype ); - my $notforloan = $sth->fetchrow; - ##Change the notforloan field if $notforloan found - if ( $notforloan > 0 ) { - $item->{'notforloan'} = $notforloan; - &MARCitemchange( $record, "items.notforloan", $notforloan ); - } - if ( !$item->{'dateaccessioned'} || $item->{'dateaccessioned'} eq '' ) { - - # find today's date - my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = - localtime(time); - $year += 1900; - $mon += 1; - my $date = - "$year-" . sprintf( "%0.2d", $mon ) . "-" . sprintf( "%0.2d", $mday ); - $item->{'dateaccessioned'} = $date; - &MARCitemchange( $record, "items.dateaccessioned", $date ); - } - my ( $itemnumber, $error ) = &_koha_new_items( $dbh, $item, $item->{barcode} ); - # add itemnumber to MARC::Record before adding the item. - $sth = $dbh->prepare( -"SELECT tagfield,tagsubfield -FROM marc_subfield_structure -WHERE frameworkcode=? - AND kohafield=?" - ); - &TransformKohaToMarcOneField( $sth, $record, "items.itemnumber", $itemnumber, - $frameworkcode ); - - # add the item - &AddItemInMarc( $record, $item->{'biblionumber'},$frameworkcode ); - - &logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$itemnumber,"item") - if C4::Context->preference("CataloguingLog"); - - return ($item->{biblionumber}, $item->{biblioitemnumber},$itemnumber); -} - =head2 ModBiblio ModBiblio( $record,$biblionumber,$frameworkcode); @@ -346,88 +294,21 @@ sub ModBiblio { $sth->finish(); _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber); - # update the MARC record (that now contains biblio and items) with the new record data - &ModBiblioMarc( $record, $biblionumber, $frameworkcode ); - # load the koha-table data object my $oldbiblio = TransformMarcToKoha( $dbh, $record, $frameworkcode ); + # update MARC subfield that stores biblioitems.cn_sort + _koha_marc_update_biblioitem_cn_sort($record, $oldbiblio, $frameworkcode); + + # update the MARC record (that now contains biblio and items) with the new record data + &ModBiblioMarc( $record, $biblionumber, $frameworkcode ); + # modify the other koha tables _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode ); _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio ); return 1; } -=head2 ModItem - -=over 2 - -Exported function (core API) for modifying an item in Koha. - -=back - -=cut - -sub ModItem { - my ( $record, $biblionumber, $itemnumber, $delete, $new_item_hashref ) - = @_; - - #logging - &logaction(C4::Context->userenv->{'number'},"CATALOGUING","MODIFY",$itemnumber,$record->as_formatted) - if C4::Context->preference("CataloguingLog"); - - my $dbh = C4::Context->dbh; - - # if we have a MARC record, we're coming from cataloging and so - # we do the whole routine: update the MARC and zebra, then update the koha - # tables - if ($record) { - my $frameworkcode = GetFrameworkCode( $biblionumber ); - ModItemInMarc( $record, $biblionumber, $itemnumber, $frameworkcode ); - my $olditem = TransformMarcToKoha( $dbh, $record, $frameworkcode,'items'); - $olditem->{'biblionumber'} = $biblionumber; - my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?"); - $sth->execute($biblionumber); - my ($biblioitemnumber) = $sth->fetchrow; - $sth->finish(); - $olditem->{'biblioitemnumber'} = $biblioitemnumber; - _koha_modify_item( $dbh, $olditem ); - return $biblionumber; - } - - # otherwise, we're just looking to modify something quickly - # (like a status) so we just update the koha tables - elsif ($new_item_hashref) { - _koha_modify_item( $dbh, $new_item_hashref ); - } -} - -sub ModItemTransfer { - my ( $itemnumber, $frombranch, $tobranch ) = @_; - - my $dbh = C4::Context->dbh; - - #new entry in branchtransfers.... - my $sth = $dbh->prepare( - "INSERT INTO branchtransfers (itemnumber, frombranch, datesent, tobranch) - VALUES (?, ?, NOW(), ?)"); - $sth->execute($itemnumber, $frombranch, $tobranch); - #update holdingbranch in items ..... - $sth= $dbh->prepare( - "UPDATE items SET holdingbranch = ? WHERE items.itemnumber = ?"); - $sth->execute($tobranch,$itemnumber); - &ModDateLastSeen($itemnumber); - $sth = $dbh->prepare( - "SELECT biblionumber FROM items WHERE itemnumber=?" - ); - $sth->execute($itemnumber); - while ( my ( $biblionumber ) = $sth->fetchrow ) { - &ModItemInMarconefield( $biblionumber, $itemnumber, - 'items.holdingbranch', $tobranch ); - } - return; -} - =head2 ModBiblioframework ModBiblioframework($biblionumber,$frameworkcode); @@ -445,89 +326,6 @@ sub ModBiblioframework { 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( $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); - my $frameworkcode = GetFrameworkCode( $biblionumber ); - &ModItemInMarc( $record, $biblionumber, $itemnumber, $frameworkcode ); - } - } -} - -=head2 ModItemInMarc - -=over - -&ModItemInMarc( $record, $biblionumber, $itemnumber, $frameworkcode ) - -=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("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",$completeRecord); -} - -=head2 ModDateLastSeen - -&ModDateLastSeen($itemnum) -Mark item as seen. Is called when an item is issued, returned or manually marked during inventory/stocktaking -C<$itemnum> is the item number - -=cut - -sub ModDateLastSeen { - my ($itemnum) = @_; - my $dbh = C4::Context->dbh; - my $sth = - $dbh->prepare( - "UPDATE items SET itemlost=0,datelastseen = NOW() WHERE items.itemnumber = ?" - ); - $sth->execute($itemnum); - return; -} =head2 DelBiblio =over @@ -548,14 +346,14 @@ sub DelBiblio { my ( $biblionumber ) = @_; my $dbh = C4::Context->dbh; my $error; # for error handling - - # First make sure this biblio has no items attached - my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?"); - $sth->execute($biblionumber); - if (my $itemnumber = $sth->fetchrow){ - # Fix this to use a status the template can understand - $error .= "This Biblio has items attached, please delete them first before deleting this biblio "; - } + + # First make sure this biblio has no items attached + my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?"); + $sth->execute($biblionumber); + if (my $itemnumber = $sth->fetchrow){ + # Fix this to use a status the template can understand + $error .= "This Biblio has items attached, please delete them first before deleting this biblio "; + } return $error if $error; @@ -589,46 +387,61 @@ sub DelBiblio { return; } -=head2 DelItem +=head2 LinkBibHeadingsToAuthorities -=over +=over 4 -DelItem( $biblionumber, $itemnumber ); -Exported function (core API) for deleting an item record in Koha. +my $headings_linked = LinkBibHeadingsToAuthorities($marc); =back +Links bib headings to authority records by checking +each authority-controlled field in the C +object C<$marc>, looking for a matching authority record, +and setting the linking subfield $9 to the ID of that +authority record. + +If no matching authority exists, or if multiple +authorities match, no $9 will be added, and any +existing one inthe field will be deleted. + +Returns the number of heading links changed in the +MARC record. + =cut -sub DelItem { - my ( $dbh, $biblionumber, $itemnumber ) = @_; - - # check the item has no current issues - - - &_koha_delete_item( $dbh, $itemnumber ); +sub LinkBibHeadingsToAuthorities { + my $bib = shift; - # get the MARC record - my $record = GetMarcBiblio($biblionumber); - my $frameworkcode = GetFrameworkCode($biblionumber); + my $num_headings_changed = 0; + foreach my $field ($bib->fields()) { + my $heading = C4::Heading->new_from_bib_field($field); + next unless defined $heading; - # backup the record - my $copy2deleted = $dbh->prepare("UPDATE deleteditems SET marc=? WHERE itemnumber=?"); - $copy2deleted->execute( $record->as_usmarc(), $itemnumber ); + # check existing $9 + my $current_link = $field->subfield('9'); - #search item field code - my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField("items.itemnumber",$frameworkcode); - my @fields = $record->field($itemtag); + # look for matching authorities + my $authorities = $heading->authorities(); + + # want only one exact match + if ($#{ $authorities } == 0) { + my $authority = MARC::Record->new_from_usmarc($authorities->[0]); + my $authid = $authority->field('001')->data(); + next if defined $current_link and $current_link eq $authid; - # delete the item specified - foreach my $field (@fields) { - if ( $field->subfield($itemsubfield) eq $itemnumber ) { - $record->delete_field($field); + $field->delete_subfield(code => '9') if defined $current_link; + $field->add_subfields('9', $authid); + $num_headings_changed++; + } else { + if (defined $current_link) { + $field->delete_subfield(code => '9'); + $num_headings_changed++; + } } + } - &ModBiblioMarc( $record, $biblionumber, $frameworkcode ); - &logaction(C4::Context->userenv->{'number'},"CATALOGUING","DELETE",$itemnumber,"item") - if C4::Context->preference("CataloguingLog"); + return $num_headings_changed; } =head2 GetBiblioData @@ -654,20 +467,20 @@ sub GetBiblioData { my $dbh = C4::Context->dbh; # my $query = C4::Context->preference('item-level_itypes') ? - # " SELECT * , biblioitems.notes AS bnotes, biblio.notes - # FROM biblio + # " SELECT * , biblioitems.notes AS bnotes, biblio.notes + # FROM biblio # LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber - # WHERE biblio.biblionumber = ? + # WHERE biblio.biblionumber = ? # AND biblioitems.biblionumber = biblio.biblionumber #"; - - my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes - FROM biblio + + my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes + FROM biblio LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype - WHERE biblio.biblionumber = ? + WHERE biblio.biblionumber = ? AND biblioitems.biblionumber = biblio.biblionumber "; - + my $sth = $dbh->prepare($query); $sth->execute($bibnum); my $data; @@ -677,458 +490,6 @@ sub GetBiblioData { return ($data); } # sub GetBiblioData - -=head2 GetItemsInfo - -=over 4 - - @results = &GetItemsInfo($biblionumber, $type); - -Returns information about books with the given biblionumber. - -C<$type> may be either C or anything else. If it is not set to -C, then the search will exclude lost, very overdue, and -withdrawn items. - -C<&GetItemsInfo> returns a list of references-to-hash. Each element -contains a number of keys. Most of them are table items from the -C, C, C, and C tables in the -Koha database. Other keys include: - -=over 4 - -=item C<$data-E{branchname}> - -The name (not the code) of the branch to which the book belongs. - -=item C<$data-E{datelastseen}> - -This is simply C, except that while the date is -stored in YYYY-MM-DD format in the database, here it is converted to -DD/MM/YYYY format. A NULL date is returned as C. - -=item C<$data-E{datedue}> - -=item C<$data-E{class}> - -This is the concatenation of C, the book's -Dewey code, and C. - -=item C<$data-E{ocount}> - -I think this is the number of copies of the book available. - -=item C<$data-E{order}> - -If this is set, it is set to C. - -=back - -=back - -=cut - -sub GetItemsInfo { - my ( $biblionumber, $type ) = @_; - my $dbh = C4::Context->dbh; - my $query = "SELECT *,items.notforloan as itemnotforloan - FROM items - LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber - LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber"; - $query .= (C4::Context->preference('item-level_itypes')) ? - " LEFT JOIN itemtypes on items.itype = itemtypes.itemtype " - : " LEFT JOIN itemtypes on biblioitems.itemtype = itemtypes.itemtype "; - $query .= "WHERE items.biblionumber = ? ORDER BY items.dateaccessioned desc" ; - my $sth = $dbh->prepare($query); - $sth->execute($biblionumber); - my $i = 0; - my @results; - my ( $date_due, $count_reserves ); - - my $isth = $dbh->prepare( - "SELECT issues.*,borrowers.cardnumber,borrowers.surname,borrowers.firstname,borrowers.branchcode as bcode - FROM issues LEFT JOIN borrowers ON issues.borrowernumber=borrowers.borrowernumber - WHERE itemnumber = ? - AND returndate IS NULL" - ); - while ( my $data = $sth->fetchrow_hashref ) { - my $datedue = ''; - $isth->execute( $data->{'itemnumber'} ); - if ( my $idata = $isth->fetchrow_hashref ) { - $data->{borrowernumber} = $idata->{borrowernumber}; - $data->{cardnumber} = $idata->{cardnumber}; - $data->{surname} = $idata->{surname}; - $data->{firstname} = $idata->{firstname}; - $datedue = format_date( $idata->{'date_due'} ); - if (C4::Context->preference("IndependantBranches")){ - my $userenv = C4::Context->userenv; - if ( ($userenv) && ( $userenv->{flags} != 1 ) ) { - $data->{'NOTSAMEBRANCH'} = 1 if ($idata->{'bcode'} ne $userenv->{branch}); - } - } - } - if ( $datedue eq '' ) { - #$datedue="Available"; - my ( $restype, $reserves ) = - C4::Reserves::CheckReserves( $data->{'itemnumber'} ); - if ($restype) { - #$datedue=$restype; - $count_reserves = $restype; - } - } - $isth->finish; - - #get branch information..... - my $bsth = $dbh->prepare( - "SELECT * FROM branches WHERE branchcode = ? - " - ); - $bsth->execute( $data->{'holdingbranch'} ); - if ( my $bdata = $bsth->fetchrow_hashref ) { - $data->{'branchname'} = $bdata->{'branchname'}; - } - my $date = format_date( $data->{'datelastseen'} ); - $data->{'datelastseen'} = $date; - $data->{'datedue'} = $datedue; - $data->{'count_reserves'} = $count_reserves; - - # get notforloan complete status if applicable - my $sthnflstatus = $dbh->prepare( - 'SELECT authorised_value - FROM marc_subfield_structure - WHERE kohafield="items.notforloan" - ' - ); - - $sthnflstatus->execute; - my ($authorised_valuecode) = $sthnflstatus->fetchrow; - if ($authorised_valuecode) { - $sthnflstatus = $dbh->prepare( - "SELECT lib FROM authorised_values - WHERE category=? - AND authorised_value=?" - ); - $sthnflstatus->execute( $authorised_valuecode, - $data->{itemnotforloan} ); - my ($lib) = $sthnflstatus->fetchrow; - $data->{notforloan} = $lib; - } - - # my stack procedures - my $stackstatus = $dbh->prepare( - 'SELECT authorised_value - FROM marc_subfield_structure - WHERE kohafield="items.stack" - ' - ); - $stackstatus->execute; - - ($authorised_valuecode) = $stackstatus->fetchrow; - if ($authorised_valuecode) { - $stackstatus = $dbh->prepare( - "SELECT lib - FROM authorised_values - WHERE category=? - AND authorised_value=? - " - ); - $stackstatus->execute( $authorised_valuecode, $data->{stack} ); - my ($lib) = $stackstatus->fetchrow; - $data->{stack} = $lib; - } - $results[$i] = $data; - $i++; - } - $sth->finish; - - return (@results); -} - -=head2 getitemstatus - -=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 - -my $itemstatushash = getitemstatus; -my @itemstatusloop; -foreach my $thisstatus (keys %$itemstatushash) { - my %row =(value => $thisstatus, - statusname => $itemstatushash->{$thisstatus}->{'statusname'}, - ); - push @itemstatusloop, \%row; -} -$template->param(statusloop=>\@itemstatusloop); - - -=head3 in TEMPLATE - - - -=cut - -sub GetItemStatus { - - # returns a reference to a hash of references to status... - my ($fwk) = @_; - my %itemstatus; - my $dbh = C4::Context->dbh; - my $sth; - $fwk = '' unless ($fwk); - my ( $tag, $subfield ) = - GetMarcFromKohaField( "items.notforloan", $fwk ); - if ( $tag and $subfield ) { - my $sth = - $dbh->prepare( - "SELECT authorised_value - FROM marc_subfield_structure - WHERE tagfield=? - AND tagsubfield=? - AND frameworkcode=? - " - ); - $sth->execute( $tag, $subfield, $fwk ); - if ( my ($authorisedvaluecat) = $sth->fetchrow ) { - my $authvalsth = - $dbh->prepare( - "SELECT authorised_value,lib - FROM authorised_values - WHERE category=? - ORDER BY lib - " - ); - $authvalsth->execute($authorisedvaluecat); - while ( my ( $authorisedvalue, $lib ) = $authvalsth->fetchrow ) { - $itemstatus{$authorisedvalue} = $lib; - } - $authvalsth->finish; - return \%itemstatus; - exit 1; - } - else { - - #No authvalue list - # build default - } - $sth->finish; - } - - #No authvalue list - #build default - $itemstatus{"1"} = "Not For Loan"; - return \%itemstatus; -} - -=head2 getitemlocation - -=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 - -my $itemlochash = getitemlocation; -my @itemlocloop; -foreach my $thisloc (keys %$itemlochash) { - my $selected = 1 if $thisbranch eq $branch; - my %row =(locval => $thisloc, - selected => $selected, - locname => $itemlochash->{$thisloc}, - ); - push @itemlocloop, \%row; -} -$template->param(itemlocationloop => \@itemlocloop); - -=head3 in TEMPLATE - - - -=back - -=cut - -sub GetItemLocation { - - # returns a reference to a hash of references to location... - my ($fwk) = @_; - my %itemlocation; - my $dbh = C4::Context->dbh; - my $sth; - $fwk = '' unless ($fwk); - my ( $tag, $subfield ) = - GetMarcFromKohaField( "items.location", $fwk ); - if ( $tag and $subfield ) { - my $sth = - $dbh->prepare( - "SELECT authorised_value - FROM marc_subfield_structure - WHERE tagfield=? - AND tagsubfield=? - AND frameworkcode=?" - ); - $sth->execute( $tag, $subfield, $fwk ); - if ( my ($authorisedvaluecat) = $sth->fetchrow ) { - my $authvalsth = - $dbh->prepare( - "SELECT authorised_value,lib - FROM authorised_values - WHERE category=? - ORDER BY lib" - ); - $authvalsth->execute($authorisedvaluecat); - while ( my ( $authorisedvalue, $lib ) = $authvalsth->fetchrow ) { - $itemlocation{$authorisedvalue} = $lib; - } - $authvalsth->finish; - return \%itemlocation; - exit 1; - } - else { - - #No authvalue list - # build default - } - $sth->finish; - } - - #No authvalue list - #build default - $itemlocation{"1"} = "Not For Loan"; - return \%itemlocation; -} - -=head2 GetLostItems - -$items = GetLostItems($where,$orderby); - -This function get the items lost into C<$items>. - -=over 2 - -=item input: -C<$where> is a hashref. it containts a field of the items table as key -and the value to match as value. -C<$orderby> is a field of the items table. - -=item return: -C<$items> is a reference to an array full of hasref which keys are items' table column. - -=item usage in the perl script: - -my %where; -$where{barcode} = 0001548; -my $items = GetLostItems( \%where, "homebranch" ); -$template->param(itemsloop => $items); - -=back - -=cut - -sub GetLostItems { - # Getting input args. - my $where = shift; - my $orderby = shift; - my $dbh = C4::Context->dbh; - - my $query = " - SELECT * - FROM items - WHERE itemlost IS NOT NULL - AND itemlost <> 0 - "; - foreach my $key (keys %$where) { - $query .= " AND " . $key . " LIKE '%" . $where->{$key} . "%'"; - } - $query .= " ORDER BY ".$orderby if defined $orderby; - - my $sth = $dbh->prepare($query); - $sth->execute; - my @items; - while ( my $row = $sth->fetchrow_hashref ){ - push @items, $row; - } - return \@items; -} - -=head2 GetItemsForInventory - -$itemlist = GetItemsForInventory($minlocation,$maxlocation,$datelastseen,$offset,$size) - -Retrieve a list of title/authors/barcode/callnumber, for biblio inventory. - -The sub returns a list of hashes, containing itemnumber, author, title, barcode & item callnumber. -It is ordered by callnumber,title. - -The minlocation & maxlocation parameters are used to specify a range of item callnumbers -the datelastseen can be used to specify that you want to see items not seen since a past date only. -offset & size can be used to retrieve only a part of the whole listing (defaut behaviour) - -=cut - -sub GetItemsForInventory { - my ( $minlocation, $maxlocation,$location, $datelastseen, $branch, $offset, $size ) = @_; - my $dbh = C4::Context->dbh; - my $sth; - if ($datelastseen) { - $datelastseen=format_date_in_iso($datelastseen); - my $query = - "SELECT itemnumber,barcode,itemcallnumber,title,author,biblio.biblionumber,datelastseen - FROM items - LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber - WHERE itemcallnumber>= ? - AND itemcallnumber <=? - AND (datelastseen< ? OR datelastseen IS NULL)"; - $query.= " AND items.location=".$dbh->quote($location) if $location; - $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch; - $query .= " ORDER BY itemcallnumber,title"; - $sth = $dbh->prepare($query); - $sth->execute( $minlocation, $maxlocation, $datelastseen ); - } - else { - my $query =" - SELECT itemnumber,barcode,itemcallnumber,biblio.biblionumber,title,author,datelastseen - FROM items - LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber - WHERE itemcallnumber>= ? - AND itemcallnumber <=?"; - $query.= " AND items.location=".$dbh->quote($location) if $location; - $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch; - $query .= " ORDER BY itemcallnumber,title"; - $sth = $dbh->prepare($query); - $sth->execute( $minlocation, $maxlocation ); - } - my @results; - while ( my $row = $sth->fetchrow_hashref ) { - $offset-- if ($offset); - $row->{datelastseen}=format_date($row->{datelastseen}); - if ( ( !$offset ) && $size ) { - push @results, $row; - $size--; - } - } - return \@results; -} - =head2 &GetBiblioItemData =over 4 @@ -1148,13 +509,12 @@ that C is given as C<$itemdata-E{bnotes}>. sub GetBiblioItemData { my ($biblioitemnumber) = @_; my $dbh = C4::Context->dbh; - my $query = "SELECT *,biblioitems.notes AS bnotes - FROM biblio, biblioitems "; - unless(C4::Context->preference('item-level_itypes')) { - $query .= "LEFT JOIN itemtypes on biblioitems.itemtype=itemtypes.itemtype "; - } - $query .= " WHERE biblio.biblionumber = biblioitems.biblionumber - AND biblioitemnumber = ? "; + my $query = "SELECT *,biblioitems.notes AS bnotes + FROM biblio LEFT JOIN biblioitems on biblio.biblionumber=biblioitems.biblioitemnumber "; + unless(C4::Context->preference('item-level_itypes')) { + $query .= "LEFT JOIN itemtypes on biblioitems.itemtype=itemtypes.itemtype "; + } + $query .= " WHERE biblioitemnumber = ? "; my $sth = $dbh->prepare($query); my $data; $sth->execute($biblioitemnumber); @@ -1163,27 +523,6 @@ sub GetBiblioItemData { return ($data); } # sub &GetBiblioItemData -=head2 GetItemnumberFromBarcode - -=over 4 - -$result = GetItemnumberFromBarcode($barcode); - -=back - -=cut - -sub GetItemnumberFromBarcode { - my ($barcode) = @_; - my $dbh = C4::Context->dbh; - - my $rq = - $dbh->prepare("SELECT itemnumber FROM items WHERE items.barcode=?"); - $rq->execute($barcode); - my ($result) = $rq->fetchrow; - return ($result); -} - =head2 GetBiblioItemByBiblioNumber =over 4 @@ -1233,18 +572,18 @@ sub GetBiblioFromItemNumber { my $dbh = C4::Context->dbh; my $sth; if($itemnumber) { - $sth=$dbh->prepare( "SELECT * FROM items - LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber - LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber - WHERE items.itemnumber = ?") ; - $sth->execute($itemnumber); - } else { - $sth=$dbh->prepare( "SELECT * FROM items - LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber - LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber - WHERE items.barcode = ?") ; - $sth->execute($barcode); - } + $sth=$dbh->prepare( "SELECT * FROM items + LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber + LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber + WHERE items.itemnumber = ?") ; + $sth->execute($itemnumber); + } else { + $sth=$dbh->prepare( "SELECT * FROM items + LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber + LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber + WHERE items.barcode = ?") ; + $sth->execute($barcode); + } my $data = $sth->fetchrow_hashref; $sth->finish; return ($data); @@ -1275,161 +614,6 @@ sub GetBiblio { return ( $count, @results ); } # sub GetBiblio -=head2 GetItem - -=over 4 - -$data = &GetItem($itemnumber,$barcode); - -return Item information, for a given itemnumber or barcode - -=back - -=cut - -sub GetItem { - my ($itemnumber,$barcode) = @_; - my $dbh = C4::Context->dbh; - if ($itemnumber) { - my $sth = $dbh->prepare(" - SELECT * FROM items - WHERE itemnumber = ?"); - $sth->execute($itemnumber); - my $data = $sth->fetchrow_hashref; - return $data; - } else { - my $sth = $dbh->prepare(" - SELECT * FROM items - WHERE barcode = ?" - ); - $sth->execute($barcode); - my $data = $sth->fetchrow_hashref; - return $data; - } -} # sub GetItem - -=head2 get_itemnumbers_of - -=over 4 - -my @itemnumbers_of = get_itemnumbers_of(@biblionumbers); - -Given a list of biblionumbers, return the list of corresponding itemnumbers -for each biblionumber. - -Return a reference on a hash where keys are biblionumbers and values are -references on array of itemnumbers. - -=back - -=cut - -sub get_itemnumbers_of { - my @biblionumbers = @_; - - my $dbh = C4::Context->dbh; - - my $query = ' - SELECT itemnumber, - biblionumber - FROM items - WHERE biblionumber IN (?' . ( ',?' x scalar @biblionumbers - 1 ) . ') - '; - my $sth = $dbh->prepare($query); - $sth->execute(@biblionumbers); - - my %itemnumbers_of; - - while ( my ( $itemnumber, $biblionumber ) = $sth->fetchrow_array ) { - push @{ $itemnumbers_of{$biblionumber} }, $itemnumber; - } - - return \%itemnumbers_of; -} - -=head2 GetItemInfosOf - -=over 4 - -GetItemInfosOf(@itemnumbers); - -=back - -=cut - -sub GetItemInfosOf { - my @itemnumbers = @_; - - my $query = ' - SELECT * - FROM items - WHERE itemnumber IN (' . join( ',', @itemnumbers ) . ') - '; - return get_infos_of( $query, 'itemnumber' ); -} - -=head2 GetItemsByBiblioitemnumber - -=over 4 - -GetItemsByBiblioitemnumber($biblioitemnumber); - -Returns an arrayref of hashrefs suitable for use in a TMPL_LOOP -Called by moredetail.pl - -=back - -=cut - -sub GetItemsByBiblioitemnumber { - my ( $bibitem ) = @_; - my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare("SELECT * FROM items WHERE items.biblioitemnumber = ?") || die $dbh->errstr; - # Get all items attached to a biblioitem - my $i = 0; - my @results; - $sth->execute($bibitem) || die $sth->errstr; - while ( my $data = $sth->fetchrow_hashref ) { - # Foreach item, get circulation information - my $sth2 = $dbh->prepare( "SELECT * FROM issues,borrowers - WHERE itemnumber = ? - AND returndate is NULL - AND issues.borrowernumber = borrowers.borrowernumber" - ); - $sth2->execute( $data->{'itemnumber'} ); - if ( my $data2 = $sth2->fetchrow_hashref ) { - # if item is out, set the due date and who it is out too - $data->{'date_due'} = $data2->{'date_due'}; - $data->{'cardnumber'} = $data2->{'cardnumber'}; - $data->{'borrowernumber'} = $data2->{'borrowernumber'}; - } - else { - # set date_due to blank, so in the template we check itemlost, and wthdrawn - $data->{'date_due'} = ''; - } # else - $sth2->finish; - # Find the last 3 people who borrowed this item. - my $query2 = "SELECT * FROM issues, borrowers WHERE itemnumber = ? - AND issues.borrowernumber = borrowers.borrowernumber - AND returndate is not NULL - ORDER BY returndate desc,timestamp desc LIMIT 3"; - $sth2 = $dbh->prepare($query2) || die $dbh->errstr; - $sth2->execute( $data->{'itemnumber'} ) || die $sth2->errstr; - my $i2 = 0; - while ( my $data2 = $sth2->fetchrow_hashref ) { - $data->{"timestamp$i2"} = $data2->{'timestamp'}; - $data->{"card$i2"} = $data2->{'cardnumber'}; - $data->{"borrower$i2"} = $data2->{'borrowernumber'}; - $i2++; - } - $sth2->finish; - push(@results,$data); - } - $sth->finish; - return (\@results); -} - - =head2 GetBiblioItemInfosOf =over 4 @@ -1469,10 +653,19 @@ $frameworkcode : the framework code to read =cut +# cache for results of GetMarcStructure -- needed +# for batch jobs +our $marc_structure_cache; + sub GetMarcStructure { my ( $forlibrarian, $frameworkcode ) = @_; my $dbh=C4::Context->dbh; $frameworkcode = "" unless $frameworkcode; + + if (defined $marc_structure_cache and exists $marc_structure_cache->{$forlibrarian}->{$frameworkcode}) { + return $marc_structure_cache->{$forlibrarian}->{$frameworkcode}; + } + my $sth; my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac'; @@ -1485,10 +678,10 @@ sub GetMarcStructure { $frameworkcode = "" unless ( $total > 0 ); $sth = $dbh->prepare( - "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable - FROM marc_tag_structure - WHERE frameworkcode=? - ORDER BY tagfield" + "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 ); @@ -1505,11 +698,11 @@ sub GetMarcStructure { $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 - " + "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); @@ -1552,6 +745,9 @@ sub GetMarcStructure { $res->{$tag}->{$subfield}->{'link'} = $link; $res->{$tag}->{$subfield}->{defaultvalue} = $defaultvalue; } + + $marc_structure_cache->{$forlibrarian}->{$frameworkcode} = $res; + return $res; } @@ -1626,18 +822,13 @@ sub GetMarcBiblio { my $sth = $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? "); $sth->execute($biblionumber); - my ($marcxml) = $sth->fetchrow; + my $row = $sth->fetchrow_hashref; + my $marcxml = StripNonXmlChars($row->{'marcxml'}); MARC::File::XML->default_record_format(C4::Context->preference('marcflavour')); - $marcxml =~ s/\x1e//g; - $marcxml =~ s/\x1f//g; - $marcxml =~ s/\x1d//g; - $marcxml =~ s/\x0f//g; - $marcxml =~ s/\x0c//g; -# warn $marcxml; my $record = MARC::Record->new(); if ($marcxml) { $record = eval {MARC::Record::new_from_xml( $marcxml, "utf8", C4::Context->preference('marcflavour'))}; - if ($@) {warn $@;} + if ($@) {warn " problem with :$biblionumber : $@ \n$marcxml";} # $record = MARC::Record::new_from_usmarc( $marc) if $marc; return $record; } else { @@ -1673,34 +864,41 @@ sub GetXmlBiblio { =over 4 my $subfieldvalue =get_authorised_value_desc( - $tag, $subf[$i][0],$subf[$i][1], '', $taglib); + $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category); Retrieve the complete description for a given authorised value. +Now takes $category and $value pair too. +my $auth_value_desc =GetAuthorisedValueDesc( + '','', 'DVD' ,'','','CCODE'); + =back =cut sub GetAuthorisedValueDesc { - my ( $tag, $subfield, $value, $framework, $tagslib ) = @_; + my ( $tag, $subfield, $value, $framework, $tagslib, $category ) = @_; my $dbh = C4::Context->dbh; - - #---- branch - if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) { - return C4::Branch::GetBranchName($value); - } - #---- itemtypes - if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) { - return getitemtypeinfo($value)->{description}; + if (!$category) { +#---- branch + if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) { + return C4::Branch::GetBranchName($value); + } + +#---- itemtypes + if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) { + return getitemtypeinfo($value)->{description}; + } + +#---- "true" authorized value + $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'} } - #---- "true" authorized value - my $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'}; if ( $category ne "" ) { my $sth = - $dbh->prepare( - "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?" - ); + $dbh->prepare( + "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?" + ); $sth->execute( $category, $value ); my $data = $sth->fetchrow_hashref; return $data->{'lib'}; @@ -1710,39 +908,6 @@ sub GetAuthorisedValueDesc { } } -=head2 GetMarcItem - -=over 4 - -Returns MARC::Record of the item passed in parameter. - -=back - -=cut - -sub GetMarcItem { - my ( $biblionumber, $itemnumber ) = @_; - my $dbh = C4::Context->dbh; - my $newrecord = MARC::Record->new(); - my $marcflavour = C4::Context->preference('marcflavour'); - - my $marcxml = GetXmlBiblio($biblionumber); - my $record = MARC::Record->new(); - $record = MARC::Record::new_from_xml( $marcxml, "utf8", $marcflavour ); - # now, find where the itemnumber is stored & extract only the item - my ( $itemnumberfield, $itemnumbersubfield ) = - GetMarcFromKohaField( 'items.itemnumber', '' ); - my @fields = $record->field($itemnumberfield); - foreach my $field (@fields) { - if ( $field->subfield($itemnumbersubfield) eq $itemnumber ) { - $newrecord->insert_fields_ordered($field); - } - } - return $newrecord; -} - - - =head2 GetMarcNotes =over 4 @@ -1810,47 +975,43 @@ sub GetMarcSubjects { $mintag = "600"; $maxtag = "611"; } - + my @marcsubjects; - my $subject = ""; - my $subfield = ""; - my $marcsubject; + my $subject = ""; + my $subfield = ""; + my $marcsubject; foreach my $field ( $record->field('6..' )) { next unless $field->tag() >= $mintag && $field->tag() <= $maxtag; - my @subfields_loop; + my @subfields_loop; my @subfields = $field->subfields(); - my $counter = 0; - my @link_loop; - # if there is an authority link, build the link with an= subfield9 - my $subfield9 = $field->subfield('9'); - for my $subject_subfield (@subfields ) { - # don't load unimarc subfields 3,4,5 - next if (($marcflavour eq "UNIMARC") and ($subject_subfield->[0] =~ (3|4|5) ) ); - my $code = $subject_subfield->[0]; - my $value = $subject_subfield->[1]; - my $linkvalue = $value; - $linkvalue =~ s/(\(|\))//g; - my $operator = " and " unless $counter==0; - if ($subfield9) { + my $counter = 0; + my @link_loop; + # if there is an authority link, build the link with an= subfield9 + my $subfield9 = $field->subfield('9'); + for my $subject_subfield (@subfields ) { + # don't load unimarc subfields 3,4,5 + next if (($marcflavour eq "UNIMARC") and ($subject_subfield->[0] =~ (3|4|5) ) ); + my $code = $subject_subfield->[0]; + my $value = $subject_subfield->[1]; + my $linkvalue = $value; + $linkvalue =~ s/(\(|\))//g; + my $operator = " and " unless $counter==0; + if ($subfield9) { @link_loop = ({'limit' => 'an' ,link => "$subfield9" }); } else { push @link_loop, {'limit' => 'su', link => $linkvalue, operator => $operator }; } - my $separator = C4::Context->preference("authoritysep") unless $counter==0; - # ignore $9 - push @subfields_loop, {code => $code, value => $value, link_loop => \@link_loop, separator => $separator} unless ($subject_subfield->[0] == 9 ); - # this needs to be added back in in a way that the template can expose it properly - #if ( $code == 9 ) { - # $link = "an:".$subject_subfield->[1]; - # $flag = 1; - #} - $counter++; - } + my $separator = C4::Context->preference("authoritysep") unless $counter==0; + # ignore $9 + my @this_link_loop = @link_loop; + push @subfields_loop, {code => $code, value => $value, link_loop => \@this_link_loop, separator => $separator} unless ($subject_subfield->[0] == 9 ); + $counter++; + } - push @marcsubjects, { MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop }; + push @marcsubjects, { MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop }; - } + } return \@marcsubjects; } #end getMARCsubjects @@ -1879,32 +1040,45 @@ sub GetMarcAuthors { $mintag = "700"; $maxtag = "712"; } - else { - return; - } + else { + return; + } my @marcauthors; foreach my $field ( $record->fields ) { next unless $field->tag() >= $mintag && $field->tag() <= $maxtag; - my %hash; + my @subfields_loop; + my @link_loop; my @subfields = $field->subfields(); my $count_auth = 0; + # if there is an authority link, build the link with Koha-Auth-Number: subfield9 + my $subfield9 = $field->subfield('9'); for my $authors_subfield (@subfields) { - #unimarc-specific line - next if ($marcflavour eq 'UNIMARC' and (($authors_subfield->[0] eq '3') or ($authors_subfield->[0] eq '5'))); + # don't load unimarc subfields 3, 5 + next if ($marcflavour eq 'UNIMARC' and ($authors_subfield->[0] =~ (3|5) ) ); my $subfieldcode = $authors_subfield->[0]; - my $value; - # deal with UNIMARC author responsibility - if ( $marcflavour eq 'UNIMARC' and ($authors_subfield->[0] eq '4')) { - $value = "(".GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib ).")"; - } else { - $value = $authors_subfield->[1]; + my $value = $authors_subfield->[1]; + my $linkvalue = $value; + $linkvalue =~ s/(\(|\))//g; + my $operator = " and " unless $count_auth==0; + # if we have an authority link, use that as the link, otherwise use standard searching + if ($subfield9) { + @link_loop = ({'limit' => 'Koha-Auth-Number' ,link => "$subfield9" }); + } + else { + # reset $linkvalue if UNIMARC author responsibility + if ( $marcflavour eq 'UNIMARC' and ($authors_subfield->[0] eq "4")) { + $linkvalue = "(".GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib ).")"; + } + push @link_loop, {'limit' => 'au', link => $linkvalue, operator => $operator }; } - $hash{tag} = $field->tag; - $hash{value} .= $value . " " if ($subfieldcode != 9) ; - $hash{link} .= $value if ($subfieldcode eq 9); + $value = GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib ) if ( $marcflavour eq 'UNIMARC' and ($authors_subfield->[0] =~/4/)); + my @this_link_loop = @link_loop; + my $separator = C4::Context->preference("authoritysep") unless $count_auth==0; + push @subfields_loop, {code => $subfieldcode, value => $value, link_loop => \@this_link_loop, separator => $separator} unless ($authors_subfield->[0] == 9 ); + $count_auth++; } - push @marcauthors, \%hash; + push @marcauthors, { MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop }; } return \@marcauthors; } @@ -1933,18 +1107,18 @@ sub GetMarcUrls { } $marcurl = { MARCURL => $url, notes => \@notes, - }; - if($marcflavour eq 'MARC21') { - my $s3 = $field->subfield('3'); - my $link = $field->subfield('y'); + }; + if($marcflavour eq 'MARC21') { + my $s3 = $field->subfield('3'); + my $link = $field->subfield('y'); $marcurl->{'linktext'} = $link || $s3 || $url ;; $marcurl->{'part'} = $s3 if($link); $marcurl->{'toc'} = 1 if($s3 =~ /^[Tt]able/) ; - } else { - $marcurl->{'linktext'} = $url; - } + } else { + $marcurl->{'linktext'} = $url; + } push @marcurls, $marcurl; - } + } return \@marcurls; } #end GetMarcUrls @@ -1985,12 +1159,12 @@ sub GetMarcSeries { my $counter = 0; my @link_loop; for my $series_subfield (@subfields) { - my $volume_number; - undef $volume_number; - # see if this is an instance of a volume - if ($series_subfield->[0] eq 'v') { - $volume_number=1; - } + my $volume_number; + undef $volume_number; + # see if this is an instance of a volume + if ($series_subfield->[0] eq 'v') { + $volume_number=1; + } my $code = $series_subfield->[0]; my $value = $series_subfield->[1]; @@ -1999,12 +1173,12 @@ sub GetMarcSeries { my $operator = " and " unless $counter==0; push @link_loop, {link => $linkvalue, operator => $operator }; my $separator = C4::Context->preference("authoritysep") unless $counter==0; - if ($volume_number) { - push @subfields_loop, {volumenum => $value}; - } - else { + if ($volume_number) { + push @subfields_loop, {volumenum => $value}; + } + else { push @subfields_loop, {code => $code, value => $value, link_loop => \@link_loop, separator => $separator, volumenum => $volume_number}; - } + } $counter++; } push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop }; @@ -2250,7 +1424,7 @@ sub TransformHtmlToXml { } $prevtag = @$tags[$i]; } - if (C4::Context->preference('marcflavour') and !$unimarc_and_100_exist) { + if (C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist) { # warn "SETTING 100 for $auth_type"; use POSIX qw(strftime); my $string = strftime( "%Y%m%d", localtime(time) ); @@ -2371,57 +1545,81 @@ sub TransformHtmlToMarc { return $record; } +# cache inverted MARC field map +our $inverted_field_map; + =head2 TransformMarcToKoha =over 4 - $result = TransformMarcToKoha( $dbh, $record, $frameworkcode ) + $result = TransformMarcToKoha( $dbh, $record, $frameworkcode ) =back -=cut +Extract data from a MARC bib record into a hashref representing +Koha biblio, biblioitems, and items fields. +=cut sub TransformMarcToKoha { - my ( $dbh, $record, $frameworkcode, $table ) = @_; + my ( $dbh, $record, $frameworkcode, $limit_table ) = @_; my $result; - # sometimes we only want to return the items data - if ($table eq 'items') { - my $sth = $dbh->prepare("SHOW COLUMNS FROM items"); - $sth->execute(); - while ( (my $field) = $sth->fetchrow ) { - my $value = get_koha_field_from_marc($table,$field,$record,$frameworkcode); - my $key = _disambiguate($table, $field); - if ($result->{$key}) { - $result->{$key} .= " | " . $value; - } else { - $result->{$key} = $value; - } - } - return $result; + unless (defined $inverted_field_map) { + $inverted_field_map = _get_inverted_marc_field_map(); + } + + my %tables = (); + if ($limit_table eq 'items') { + $tables{'items'} = 1; } else { - my @tables = ('biblio','biblioitems','items'); - foreach my $table (@tables){ - my $sth2 = $dbh->prepare("SHOW COLUMNS from $table"); - $sth2->execute; - while (my ($field) = $sth2->fetchrow){ - # FIXME use of _disambiguate is a temporary hack - # $result->{_disambiguate($table, $field)} = get_koha_field_from_marc($table,$field,$record,$frameworkcode); - my $value = get_koha_field_from_marc($table,$field,$record,$frameworkcode); - my $key = _disambiguate($table, $field); + $tables{'items'} = 1; + $tables{'biblio'} = 1; + $tables{'biblioitems'} = 1; + } + + # traverse through record + MARCFIELD: foreach my $field ($record->fields()) { + my $tag = $field->tag(); + next MARCFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag}; + if ($field->is_control_field()) { + my $kohafields = $inverted_field_map->{$frameworkcode}->{$tag}->{list}; + ENTRY: foreach my $entry (@{ $kohafields }) { + my ($subfield, $table, $column) = @{ $entry }; + next ENTRY unless exists $tables{$table}; + my $key = _disambiguate($table, $column); if ($result->{$key}) { - # FIXME - hack to not bring in duplicates of the same value - unless (($key eq "biblionumber" or $key eq "biblioitemnumber") and ($value eq "")) { - $result->{$key} .= " | " . $value; + unless (($key eq "biblionumber" or $key eq "biblioitemnumber") and ($field->data() eq "")) { + $result->{$key} .= " | " . $field->data(); } } else { - $result->{$key} = $value; + $result->{$key} = $field->data(); + } + } + } else { + # deal with subfields + MARCSUBFIELD: foreach my $sf ($field->subfields()) { + my $code = $sf->[0]; + next MARCSUBFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code}; + my $value = $sf->[1]; + SFENTRY: foreach my $entry (@{ $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code} }) { + my ($table, $column) = @{ $entry }; + next SFENTRY unless exists $tables{$table}; + my $key = _disambiguate($table, $column); + if ($result->{$key}) { + unless (($key eq "biblionumber" or $key eq "biblioitemnumber") and ($value eq "")) { + $result->{$key} .= " | " . $value; + } + } else { + $result->{$key} = $value; + } } } - $sth2->finish(); } - # modify copyrightdate to keep only the 1st year found + } + + # modify copyrightdate to keep only the 1st year found + if (exists $result->{'copyrightdate'}) { my $temp = $result->{'copyrightdate'}; $temp =~ m/c(\d\d\d\d)/; # search cYYYY first if ( $1 > 0 ) { @@ -2431,9 +1629,11 @@ sub TransformMarcToKoha { $temp =~ m/(\d\d\d\d)/; $result->{'copyrightdate'} = $1; } - - # modify publicationyear to keep only the 1st year found - $temp = $result->{'publicationyear'}; + } + + # modify publicationyear to keep only the 1st year found + if (exists $result->{'publicationyear'}) { + my $temp = $result->{'publicationyear'}; $temp =~ m/c(\d\d\d\d)/; # search cYYYY first if ( $1 > 0 ) { $result->{'publicationyear'} = $1; @@ -2442,10 +1642,26 @@ sub TransformMarcToKoha { $temp =~ m/(\d\d\d\d)/; $result->{'publicationyear'} = $1; } - return $result; } + + return $result; } +sub _get_inverted_marc_field_map { + my $field_map = {}; + my $relations = C4::Context->marcfromkohafield; + + foreach my $frameworkcode (keys %{ $relations }) { + foreach my $kohafield (keys %{ $relations->{$frameworkcode} }) { + my $tag = $relations->{$frameworkcode}->{$kohafield}->[0]; + my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1]; + my ($table, $column) = split /[.]/, $kohafield, 2; + push @{ $field_map->{$frameworkcode}->{$tag}->{list} }, [ $subfield, $table, $column ]; + push @{ $field_map->{$frameworkcode}->{$tag}->{sfs}->{$subfield} }, [ $table, $column ]; + } + } + return $field_map; +} =head2 _disambiguate @@ -2589,202 +1805,6 @@ sub TransformMarcToKohaOneField { =head1 OTHER FUNCTIONS -=head2 char_decode - -=over 4 - -my $string = char_decode( $string, $encoding ); - -converts ISO 5426 coded string to UTF-8 -sloppy code : should be improved in next issue - -=back - -=cut - -sub char_decode { - my ( $string, $encoding ) = @_; - $_ = $string; - - $encoding = C4::Context->preference("marcflavour") unless $encoding; - if ( $encoding eq "UNIMARC" ) { - - # s/\xe1/Æ/gm; - s/\xe2/Ğ/gm; - s/\xe9/Ø/gm; - s/\xec/ş/gm; - s/\xf1/æ/gm; - s/\xf3/ğ/gm; - s/\xf9/ø/gm; - s/\xfb/ß/gm; - s/\xc1\x61/à/gm; - s/\xc1\x65/è/gm; - s/\xc1\x69/ì/gm; - s/\xc1\x6f/ò/gm; - s/\xc1\x75/ù/gm; - s/\xc1\x41/À/gm; - s/\xc1\x45/È/gm; - s/\xc1\x49/Ì/gm; - s/\xc1\x4f/Ò/gm; - s/\xc1\x55/Ù/gm; - s/\xc2\x41/Á/gm; - s/\xc2\x45/É/gm; - s/\xc2\x49/Í/gm; - s/\xc2\x4f/Ó/gm; - s/\xc2\x55/Ú/gm; - s/\xc2\x59/İ/gm; - s/\xc2\x61/á/gm; - s/\xc2\x65/é/gm; - s/\xc2\x69/í/gm; - s/\xc2\x6f/ó/gm; - s/\xc2\x75/ú/gm; - s/\xc2\x79/ı/gm; - s/\xc3\x41/Â/gm; - s/\xc3\x45/Ê/gm; - s/\xc3\x49/Î/gm; - s/\xc3\x4f/Ô/gm; - s/\xc3\x55/Û/gm; - s/\xc3\x61/â/gm; - s/\xc3\x65/ê/gm; - s/\xc3\x69/î/gm; - s/\xc3\x6f/ô/gm; - s/\xc3\x75/û/gm; - s/\xc4\x41/Ã/gm; - s/\xc4\x4e/Ñ/gm; - s/\xc4\x4f/Õ/gm; - s/\xc4\x61/ã/gm; - s/\xc4\x6e/ñ/gm; - s/\xc4\x6f/õ/gm; - s/\xc8\x41/Ä/gm; - s/\xc8\x45/Ë/gm; - s/\xc8\x49/Ï/gm; - s/\xc8\x61/ä/gm; - s/\xc8\x65/ë/gm; - s/\xc8\x69/ï/gm; - s/\xc8\x6F/ö/gm; - s/\xc8\x75/ü/gm; - s/\xc8\x76/ÿ/gm; - s/\xc9\x41/Ä/gm; - s/\xc9\x45/Ë/gm; - s/\xc9\x49/Ï/gm; - s/\xc9\x4f/Ö/gm; - s/\xc9\x55/Ü/gm; - s/\xc9\x61/ä/gm; - s/\xc9\x6f/ö/gm; - s/\xc9\x75/ü/gm; - s/\xca\x41/Å/gm; - s/\xca\x61/å/gm; - s/\xd0\x43/Ç/gm; - s/\xd0\x63/ç/gm; - - # this handles non-sorting blocks (if implementation requires this) - $string = nsb_clean($_); - } - elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) { - ##MARC-8 to UTF-8 - - s/\xe1\x61/à/gm; - s/\xe1\x65/è/gm; - s/\xe1\x69/ì/gm; - s/\xe1\x6f/ò/gm; - s/\xe1\x75/ù/gm; - s/\xe1\x41/À/gm; - s/\xe1\x45/È/gm; - s/\xe1\x49/Ì/gm; - s/\xe1\x4f/Ò/gm; - s/\xe1\x55/Ù/gm; - s/\xe2\x41/Á/gm; - s/\xe2\x45/É/gm; - s/\xe2\x49/Í/gm; - s/\xe2\x4f/Ó/gm; - s/\xe2\x55/Ú/gm; - s/\xe2\x59/İ/gm; - s/\xe2\x61/á/gm; - s/\xe2\x65/é/gm; - s/\xe2\x69/í/gm; - s/\xe2\x6f/ó/gm; - s/\xe2\x75/ú/gm; - s/\xe2\x79/ı/gm; - s/\xe3\x41/Â/gm; - s/\xe3\x45/Ê/gm; - s/\xe3\x49/Î/gm; - s/\xe3\x4f/Ô/gm; - s/\xe3\x55/Û/gm; - s/\xe3\x61/â/gm; - s/\xe3\x65/ê/gm; - s/\xe3\x69/î/gm; - s/\xe3\x6f/ô/gm; - s/\xe3\x75/û/gm; - s/\xe4\x41/Ã/gm; - s/\xe4\x4e/Ñ/gm; - s/\xe4\x4f/Õ/gm; - s/\xe4\x61/ã/gm; - s/\xe4\x6e/ñ/gm; - s/\xe4\x6f/õ/gm; - s/\xe6\x41/Ă/gm; - s/\xe6\x45/Ĕ/gm; - s/\xe6\x65/ĕ/gm; - s/\xe6\x61/ă/gm; - s/\xe8\x45/Ë/gm; - s/\xe8\x49/Ï/gm; - s/\xe8\x65/ë/gm; - s/\xe8\x69/ï/gm; - s/\xe8\x76/ÿ/gm; - s/\xe9\x41/A/gm; - s/\xe9\x4f/O/gm; - s/\xe9\x55/U/gm; - s/\xe9\x61/a/gm; - s/\xe9\x6f/o/gm; - s/\xe9\x75/u/gm; - s/\xea\x41/A/gm; - s/\xea\x61/a/gm; - - #Additional Turkish characters - s/\x1b//gm; - s/\x1e//gm; - s/(\xf0)s/\xc5\x9f/gm; - s/(\xf0)S/\xc5\x9e/gm; - s/(\xf0)c/ç/gm; - s/(\xf0)C/Ç/gm; - s/\xe7\x49/\\xc4\xb0/gm; - s/(\xe6)G/\xc4\x9e/gm; - s/(\xe6)g/ğ\xc4\x9f/gm; - s/\xB8/ı/gm; - s/\xB9/£/gm; - s/(\xe8|\xc8)o/ö/gm; - s/(\xe8|\xc8)O/Ö/gm; - s/(\xe8|\xc8)u/ü/gm; - s/(\xe8|\xc8)U/Ü/gm; - s/\xc2\xb8/\xc4\xb1/gm; - s/¸/\xc4\xb1/gm; - - # this handles non-sorting blocks (if implementation requires this) - $string = nsb_clean($_); - } - return ($string); -} - -=head2 nsb_clean - -=over 4 - -my $string = nsb_clean( $string, $encoding ); - -=back - -=cut - -sub nsb_clean { - my $NSB = '\x88'; # NSB : begin Non Sorting Block - my $NSE = '\x89'; # NSE : Non Sorting Block end - # handles non sorting blocks - my ($string) = @_; - $_ = $string; - s/$NSB/(/gm; - s/[ ]{0,1}$NSE/) /gm; - $string = $_; - return ($string); -} =head2 PrepareItemrecordDisplay @@ -2807,7 +1827,7 @@ sub PrepareItemrecordDisplay { my ( $itemtagfield, $itemtagsubfield ) = &GetMarcFromKohaField( "items.itemnumber", $frameworkcode ); my $tagslib = &GetMarcStructure( 1, $frameworkcode ); - my $itemrecord = GetMarcItem( $bibnum, $itemnum) if ($itemnum); + my $itemrecord = C4::Items::GetMarcItem( $bibnum, $itemnum) if ($itemnum); my @loop_data; my $authorised_values_sth = $dbh->prepare( @@ -2873,7 +1893,7 @@ sub PrepareItemrecordDisplay { { my $sth = $dbh->prepare( - "SELECT branchcode,branchname FROM branches WHERE branchcode = ? ORDER BY branchname" + "SELECT branchcode,branchname FROM branches WHERE branchcode = ? ORDER BY branchname" ); $sth->execute( C4::Context->userenv->{branch} ); push @authorised_values, "" @@ -2889,7 +1909,7 @@ sub PrepareItemrecordDisplay { else { my $sth = $dbh->prepare( - "SELECT branchcode,branchname FROM branches ORDER BY branchname" + "SELECT branchcode,branchname FROM branches ORDER BY branchname" ); $sth->execute; push @authorised_values, "" @@ -2910,7 +1930,7 @@ sub PrepareItemrecordDisplay { { my $sth = $dbh->prepare( - "SELECT itemtype,description FROM itemtypes ORDER BY description" + "SELECT itemtype,description FROM itemtypes ORDER BY description" ); $sth->execute; push @authorised_values, "" @@ -3051,8 +2071,10 @@ sub ModZebra { } if ($op eq 'specialUpdate') { # OK, we have to add or update the record - # 1st delete (virtually, in indexes) ... - %result = _DelBiblioNoZebra($biblionumber,$record,$server); + # 1st delete (virtually, in indexes), if record actually exists + if ($record) { + %result = _DelBiblioNoZebra($biblionumber,$record,$server); + } # ... add the record %result=_AddBiblioNoZebra($biblionumber,$newRecord, $server, %result); } else { @@ -3073,9 +2095,20 @@ sub ModZebra { # # we use zebra, just fill zebraqueue table # - my $sth=$dbh->prepare("INSERT INTO zebraqueue (biblio_auth_number,server,operation) VALUES(?,?,?)"); - $sth->execute($biblionumber,$server,$op); - $sth->finish; + my $check_sql = "SELECT COUNT(*) FROM zebraqueue + WHERE server = ? + AND biblio_auth_number = ? + AND operation = ? + AND done = 0"; + my $check_sth = $dbh->prepare_cached($check_sql); + $check_sth->execute($server, $biblionumber, $op); + my ($count) = $check_sth->fetchrow_array; + $check_sth->finish(); + if ($count == 0) { + my $sth=$dbh->prepare("INSERT INTO zebraqueue (biblio_auth_number,server,operation) VALUES(?,?,?)"); + $sth->execute($biblionumber,$server,$op); + $sth->finish; + } } } @@ -3092,7 +2125,6 @@ sub GetNoZebraIndexes { my %indexes; foreach my $line (split /('|"),/,$index) { $line =~ /(.*)=>(.*)/; -warn $line; my $index = substr($1,1); # get the index, don't forget to remove initial ' or " my $fields = $2; $index =~ s/'|"|\s//g; @@ -3237,7 +2269,7 @@ sub _AddBiblioNoZebra { } # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values - $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g; + $title =~ s/ |\.|,|;|\[|\]|\(|\)|\*|-|'|:|=|\r|\n//g; # limit to 10 char, should be enough, and limit the DB size $title = substr($title,0,10); #parse each field @@ -3249,6 +2281,7 @@ sub _AddBiblioNoZebra { my $tag = $field->tag(); my $subfieldcode = $subfield->[0]; my $indexed=0; + warn "INDEXING :".$subfield->[1]; # check each index to see if the subfield is stored somewhere # otherwise, store it in __RAW__ index foreach my $key (keys %index) { @@ -3257,15 +2290,15 @@ sub _AddBiblioNoZebra { $indexed=1; my $line= lc $subfield->[1]; # remove meaningless value in the field... - $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g; + $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g; # ... and split in words foreach (split / /,$line) { next unless $_; # skip empty values (multiple spaces) # if the entry is already here, improve weight # warn "managing $_"; - if ($result{$key}->{"$_"} =~ /$biblionumber,$title\-(\d);/) { + if ($result{$key}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d);/) { my $weight=$1+1; - $result{$key}->{"$_"} =~ s/$biblionumber,$title\-(\d);//; + $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//; $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;"; } else { # get the value if it exist in the nozebra table, otherwise, create it @@ -3275,7 +2308,7 @@ sub _AddBiblioNoZebra { if ($existing_biblionumbers) { $result{$key}->{"$_"} =$existing_biblionumbers; my $weight=$1+1; - $result{$key}->{"$_"} =~ s/$biblionumber,$title\-(\d);//; + $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//; $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;"; # create a new ligne for this entry } else { @@ -3290,14 +2323,14 @@ sub _AddBiblioNoZebra { # the subfield is not indexed, store it in __RAW__ index anyway unless ($indexed) { my $line= lc $subfield->[1]; - $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g; + $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g; # ... and split in words foreach (split / /,$line) { next unless $_; # skip empty values (multiple spaces) # if the entry is already here, improve weight - if ($result{'__RAW__'}->{"$_"} =~ /$biblionumber,$title\-(\d);/) { + if ($result{'__RAW__'}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d);/) { my $weight=$1+1; - $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,$title\-(\d);//; + $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//; $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;"; } else { # get the value if it exist in the nozebra table, otherwise, create it @@ -3307,7 +2340,7 @@ sub _AddBiblioNoZebra { if ($existing_biblionumbers) { $result{'__RAW__'}->{"$_"} =$existing_biblionumbers; my $weight=$1+1; - $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,$title\-(\d);//; + $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//; $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;"; # create a new ligne for this entry } else { @@ -3323,36 +2356,6 @@ sub _AddBiblioNoZebra { } -=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( $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 _find_value =over 4 @@ -3467,6 +2470,44 @@ sub _koha_marc_update_bib_ids { } } +=head2 _koha_marc_update_biblioitem_cn_sort + +=over 4 + +_koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode); + +=back + +Given a MARC bib record and the biblioitem hash, update the +subfield that contains a copy of the value of biblioitems.cn_sort. + +=cut + +sub _koha_marc_update_biblioitem_cn_sort { + my $marc = shift; + my $biblioitem = shift; + my $frameworkcode= shift; + + my ($biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField("biblioitems.cn_sort",$frameworkcode); + return unless $biblioitem_tag; + + my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} ); + + if (my $field = $marc->field($biblioitem_tag)) { + $field->delete_subfield(code => $biblioitem_subfield); + if ($cn_sort ne '') { + $field->add_subfields($biblioitem_subfield => $cn_sort); + } + } else { + # if we get here, no biblioitem tag is present in the MARC record, so + # we'll create it if $cn_sort is not empty -- this would be + # an odd combination of events, however + if ($cn_sort) { + $marc->insert_grouped_field(MARC::Field->new($biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort)); + } + } +} + =head2 _koha_add_biblio =over 4 @@ -3482,46 +2523,46 @@ Internal function to add a biblio ($biblio is a hash with the values) sub _koha_add_biblio { my ( $dbh, $biblio, $frameworkcode ) = @_; - my $error; + my $error; - # set the series flag + # set the series flag my $serial = 0; if ( $biblio->{'seriestitle'} ) { $serial = 1 }; - my $query = + my $query = "INSERT INTO biblio - SET frameworkcode = ?, - author = ?, - title = ?, - unititle =?, - notes = ?, - serial = ?, - seriestitle = ?, - copyrightdate = ?, - datecreated=NOW(), - abstract = ? - "; + SET frameworkcode = ?, + author = ?, + title = ?, + unititle =?, + notes = ?, + serial = ?, + seriestitle = ?, + copyrightdate = ?, + datecreated=NOW(), + abstract = ? + "; my $sth = $dbh->prepare($query); $sth->execute( - $frameworkcode, + $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, - $biblio->{'unititle'}, + $biblio->{'unititle'}, $biblio->{'notes'}, - $serial, + $serial, $biblio->{'seriestitle'}, - $biblio->{'copyrightdate'}, + $biblio->{'copyrightdate'}, $biblio->{'abstract'} ); my $biblionumber = $dbh->{'mysql_insertid'}; - if ( $dbh->errstr ) { - $error.="ERROR in _koha_add_biblio $query".$dbh->errstr; + if ( $dbh->errstr ) { + $error.="ERROR in _koha_add_biblio $query".$dbh->errstr; warn $error; } $sth->finish(); - #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n"; + #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n"; return ($biblionumber,$error); } @@ -3539,26 +2580,26 @@ Internal function for updating the biblio table sub _koha_modify_biblio { my ( $dbh, $biblio, $frameworkcode ) = @_; - my $error; + my $error; my $query = " UPDATE biblio SET frameworkcode = ?, - author = ?, - title = ?, - unititle = ?, - notes = ?, - serial = ?, - seriestitle = ?, - copyrightdate = ?, + author = ?, + title = ?, + unititle = ?, + notes = ?, + serial = ?, + seriestitle = ?, + copyrightdate = ?, abstract = ? WHERE biblionumber = ? - " - ; + " + ; my $sth = $dbh->prepare($query); $sth->execute( - $frameworkcode, + $frameworkcode, $biblio->{'author'}, $biblio->{'title'}, $biblio->{'unititle'}, @@ -3566,12 +2607,12 @@ sub _koha_modify_biblio { $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, - $biblio->{'abstract'}, + $biblio->{'abstract'}, $biblio->{'biblionumber'} ) if $biblio->{'biblionumber'}; if ( $dbh->errstr || !$biblio->{'biblionumber'} ) { - $error.="ERROR in _koha_modify_biblio $query".$dbh->errstr; + $error.="ERROR in _koha_modify_biblio $query".$dbh->errstr; warn $error; } return ( $biblio->{'biblionumber'},$error ); @@ -3592,80 +2633,80 @@ via ModBiblioMarc sub _koha_modify_biblioitem_nonmarc { my ( $dbh, $biblioitem ) = @_; - my $error; + my $error; - # re-calculate the cn_sort, it may have changed - my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} ); + # re-calculate the cn_sort, it may have changed + my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} ); - my $query = - "UPDATE biblioitems - SET biblionumber = ?, - volume = ?, - number = ?, + my $query = + "UPDATE biblioitems + SET biblionumber = ?, + volume = ?, + number = ?, itemtype = ?, isbn = ?, issn = ?, - publicationyear = ?, + publicationyear = ?, publishercode = ?, - volumedate = ?, - volumedesc = ?, - collectiontitle = ?, - collectionissn = ?, - collectionvolume= ?, - editionstatement= ?, - editionresponsibility = ?, - illus = ?, - pages = ?, - notes = ?, - size = ?, - place = ?, - lccn = ?, - url = ?, - cn_source = ?, + volumedate = ?, + volumedesc = ?, + collectiontitle = ?, + collectionissn = ?, + collectionvolume= ?, + editionstatement= ?, + editionresponsibility = ?, + illus = ?, + pages = ?, + notes = ?, + size = ?, + place = ?, + lccn = ?, + url = ?, + cn_source = ?, cn_class = ?, - cn_item = ?, - cn_suffix = ?, - cn_sort = ?, - totalissues = ? + cn_item = ?, + cn_suffix = ?, + cn_sort = ?, + totalissues = ? where biblioitemnumber = ? - "; - my $sth = $dbh->prepare($query); - $sth->execute( - $biblioitem->{'biblionumber'}, - $biblioitem->{'volume'}, - $biblioitem->{'number'}, - $biblioitem->{'itemtype'}, - $biblioitem->{'isbn'}, - $biblioitem->{'issn'}, - $biblioitem->{'publicationyear'}, - $biblioitem->{'publishercode'}, - $biblioitem->{'volumedate'}, - $biblioitem->{'volumedesc'}, - $biblioitem->{'collectiontitle'}, - $biblioitem->{'collectionissn'}, - $biblioitem->{'collectionvolume'}, - $biblioitem->{'editionstatement'}, - $biblioitem->{'editionresponsibility'}, - $biblioitem->{'illus'}, - $biblioitem->{'pages'}, - $biblioitem->{'bnotes'}, - $biblioitem->{'size'}, - $biblioitem->{'place'}, - $biblioitem->{'lccn'}, - $biblioitem->{'url'}, - $biblioitem->{'biblioitems.cn_source'}, - $biblioitem->{'cn_class'}, - $biblioitem->{'cn_item'}, - $biblioitem->{'cn_suffix'}, - $cn_sort, - $biblioitem->{'totalissues'}, - $biblioitem->{'biblioitemnumber'} - ); + "; + my $sth = $dbh->prepare($query); + $sth->execute( + $biblioitem->{'biblionumber'}, + $biblioitem->{'volume'}, + $biblioitem->{'number'}, + $biblioitem->{'itemtype'}, + $biblioitem->{'isbn'}, + $biblioitem->{'issn'}, + $biblioitem->{'publicationyear'}, + $biblioitem->{'publishercode'}, + $biblioitem->{'volumedate'}, + $biblioitem->{'volumedesc'}, + $biblioitem->{'collectiontitle'}, + $biblioitem->{'collectionissn'}, + $biblioitem->{'collectionvolume'}, + $biblioitem->{'editionstatement'}, + $biblioitem->{'editionresponsibility'}, + $biblioitem->{'illus'}, + $biblioitem->{'pages'}, + $biblioitem->{'bnotes'}, + $biblioitem->{'size'}, + $biblioitem->{'place'}, + $biblioitem->{'lccn'}, + $biblioitem->{'url'}, + $biblioitem->{'biblioitems.cn_source'}, + $biblioitem->{'cn_class'}, + $biblioitem->{'cn_item'}, + $biblioitem->{'cn_suffix'}, + $cn_sort, + $biblioitem->{'totalissues'}, + $biblioitem->{'biblioitemnumber'} + ); if ( $dbh->errstr ) { - $error.="ERROR in _koha_modify_biblioitem_nonmarc $query".$dbh->errstr; + $error.="ERROR in _koha_modify_biblioitem_nonmarc $query".$dbh->errstr; warn $error; } - return ($biblioitem->{'biblioitemnumber'},$error); + return ($biblioitem->{'biblioitemnumber'},$error); } =head2 _koha_add_biblioitem @@ -3682,9 +2723,9 @@ Internal function to add a biblioitem sub _koha_add_biblioitem { my ( $dbh, $biblioitem ) = @_; - my $error; + my $error; - my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} ); + my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} ); my $query = "INSERT INTO biblioitems SET biblionumber = ?, @@ -3717,7 +2758,7 @@ sub _koha_add_biblioitem { cn_sort = ?, totalissues = ? "; - my $sth = $dbh->prepare($query); + my $sth = $dbh->prepare($query); $sth->execute( $biblioitem->{'biblionumber'}, $biblioitem->{'volume'}, @@ -3751,138 +2792,11 @@ sub _koha_add_biblioitem { ); my $bibitemnum = $dbh->{'mysql_insertid'}; if ( $dbh->errstr ) { - $error.="ERROR in _koha_add_biblioitem $query".$dbh->errstr; - warn $error; - } - $sth->finish(); - return ($bibitemnum,$error); -} - -=head2 _koha_new_items - -=over 4 - -my ($itemnumber,$error) = _koha_new_items( $dbh, $item, $barcode ); - -=back - -=cut - -sub _koha_new_items { - my ( $dbh, $item, $barcode ) = @_; - my $error; - - my ($items_cn_sort) = GetClassSort($item->{'items.cn_source'}, $item->{'itemcallnumber'}, ""); - - # if dateaccessioned is provided, use it. Otherwise, set to NOW() - if ( $item->{'dateaccessioned'} eq '' || !$item->{'dateaccessioned'} ) { - my $today = C4::Dates->new(); - $item->{'dateaccessioned'} = $today->output("iso"); #TODO: check time issues - } - my $query = - "INSERT INTO items SET - biblionumber = ?, - biblioitemnumber = ?, - barcode = ?, - dateaccessioned = ?, - booksellerid = ?, - homebranch = ?, - price = ?, - replacementprice = ?, - replacementpricedate = NOW(), - datelastborrowed = ?, - datelastseen = NOW(), - stack = ?, - notforloan = ?, - damaged = ?, - itemlost = ?, - wthdrawn = ?, - itemcallnumber = ?, - restricted = ?, - itemnotes = ?, - holdingbranch = ?, - paidfor = ?, - location = ?, - onloan = ?, - cn_source = ?, - cn_sort = ?, - ccode = ?, - itype = ?, - materials = ?, - uri = ? - "; - my $sth = $dbh->prepare($query); - $sth->execute( - $item->{'biblionumber'}, - $item->{'biblioitemnumber'}, - $barcode, - $item->{'dateaccessioned'}, - $item->{'booksellerid'}, - $item->{'homebranch'}, - $item->{'price'}, - $item->{'replacementprice'}, - $item->{datelastborrowed}, - $item->{stack}, - $item->{'notforloan'}, - $item->{'damaged'}, - $item->{'itemlost'}, - $item->{'wthdrawn'}, - $item->{'itemcallnumber'}, - $item->{'restricted'}, - $item->{'itemnotes'}, - $item->{'holdingbranch'}, - $item->{'paidfor'}, - $item->{'location'}, - $item->{'onloan'}, - $item->{'items.cn_source'}, - $items_cn_sort, - $item->{'ccode'}, - $item->{'itype'}, - $item->{'materials'}, - $item->{'uri'}, - ); - my $itemnumber = $dbh->{'mysql_insertid'}; - if ( defined $sth->errstr ) { - $error.="ERROR in _koha_new_items $query".$sth->errstr; - } - $sth->finish(); - return ( $itemnumber, $error ); -} - -=head2 _koha_modify_item - -=over 4 - -my ($itemnumber,$error) =_koha_modify_item( $dbh, $item, $op ); - -=back - -=cut - -sub _koha_modify_item { - my ( $dbh, $item ) = @_; - my $error; - - # calculate items.cn_sort - $item->{'cn_sort'} = GetClassSort($item->{'items.cn_source'}, $item->{'itemcallnumber'}, ""); - - my $query = "UPDATE items SET "; - my @bind; - for my $key ( keys %$item ) { - $query.="$key=?,"; - push @bind, $item->{$key}; - } - $query =~ s/,$//; - $query .= " WHERE itemnumber=?"; - push @bind, $item->{'itemnumber'}; - my $sth = $dbh->prepare($query); - $sth->execute(@bind); - if ( $dbh->errstr ) { - $error.="ERROR in _koha_modify_item $query".$dbh->errstr; + $error.="ERROR in _koha_add_biblioitem $query".$dbh->errstr; warn $error; } $sth->finish(); - return ($item->{'itemnumber'},$error); + return ($bibitemnum,$error); } =head2 _koha_delete_biblio @@ -3987,44 +2901,6 @@ sub _koha_delete_biblioitems { 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 ) = @_; - - # save the deleted item to deleteditems table - 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 $key ( keys %$data ) { - $query .= "$key = ?,"; - push( @bind, $data->{$key} ); - } - $query =~ s/\,$//; - $sth = $dbh->prepare($query); - $sth->execute(@bind); - $sth->finish(); - - # delete from items table - $sth = $dbh->prepare("DELETE FROM items WHERE itemnumber=?"); - $sth->execute($itemnum); - $sth->finish(); - return undef; -} - =head1 UNEXPORTED FUNCTIONS =head2 ModBiblioMarc @@ -4081,38 +2957,6 @@ sub ModBiblioMarc { return $biblionumber; } -=head2 AddItemInMarc - -=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 AddItemInMarc { - - # 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); - - # create 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 = - &ModBiblioMarc( $newrec, $biblionumber, $frameworkcode ); - return $newbiblionumber; -} - =head2 z3950_extended_services z3950_extended_services($serviceType,$serviceOptions,$record); @@ -4221,27 +3065,6 @@ sub set_service_options { return $serviceOptions; } -=head2 GetItemsCount - -$count = &GetItemsCount( $biblionumber); -this function return count of item with $biblionumber -=cut - -sub GetItemsCount { - my ( $biblionumber ) = @_; - my $dbh = C4::Context->dbh; - my $query = "SELECT count(*) - FROM items - WHERE biblionumber=?"; - my $sth = $dbh->prepare($query); - $sth->execute($biblionumber); - my $count = $sth->fetchrow; - $sth->finish; - return ($count); -} - -END { } # module clean-up code here (global destructor) - 1; __END__