X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FBiblio.pm;h=2de61b52b809f1a026ed1f2445f5812284a2ce10;hb=6863ca9e9245724ac417f13f91616662093d5d8f;hp=b6791413b1632a87c8d5567b86474aac20541793;hpb=c6068880ab7434cb8bf0ea18ddbe54575a3deb85;p=koha.git diff --git a/C4/Biblio.pm b/C4/Biblio.pm index b6791413b1..2de61b52b8 100755 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -18,21 +18,25 @@ package C4::Biblio; # Suite 330, Boston, MA 02111-1307 USA use strict; +use warnings; # use utf8; use MARC::Record; use MARC::File::USMARC; +# Force MARC::File::XML to use LibXML SAX Parser +#$XML::SAX::ParserPackage = "XML::LibXML::SAX"; use MARC::File::XML; use ZOOM; +use POSIX qw(strftime); -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; +require C4::Heading; +require C4::Serials; -use vars qw($VERSION @ISA @EXPORT); +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); BEGIN { $VERSION = 1.00; @@ -42,6 +46,10 @@ BEGIN { # to add biblios # EXPORTED FUNCTIONS. + push @EXPORT_OK, qw( + &GetRecordValue + ); + push @EXPORT, qw( &AddBiblio ); @@ -54,6 +62,13 @@ BEGIN { &GetBiblioItemInfosOf &GetBiblioItemByBiblioNumber &GetBiblioFromItemNumber + + &GetRecordValue + &GetFieldMapping + &SetFieldMapping + &DeleteFieldMapping + + &GetISBDView &GetMarcNotes &GetMarcSubjects @@ -63,6 +78,7 @@ BEGIN { GetMarcUrls &GetUsedMarcStructure &GetXmlBiblio + &GetCOinSBiblio &GetAuthorisedValueDesc &GetMarcStructure @@ -70,6 +86,8 @@ BEGIN { &GetFrameworkCode &GetPublisherNameFromIsbn &TransformKohaToMarc + + &CountItemsIssued ); # To modify something @@ -107,12 +125,6 @@ BEGIN { ); } -# 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 C4::Biblio - cataloging management functions @@ -237,17 +249,33 @@ sub AddBiblio { _koha_marc_update_biblioitem_cn_sort($record, $olddata, $frameworkcode); # now add the record - $biblionumber = ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save; + ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save; logaction("CATALOGUING", "ADD", $biblionumber, "biblio") if C4::Context->preference("CataloguingLog"); - return ( $biblionumber, $biblioitemnumber ); } =head2 ModBiblio +=over 4 + ModBiblio( $record,$biblionumber,$frameworkcode); - Exported function (core API) to modify a biblio + +=back + +Replace an existing bib record identified by C<$biblionumber> +with one supplied by the MARC::Record object C<$record>. The embedded +item, biblioitem, and biblionumber fields from the previous +version of the bib record replace any such fields of those tags that +are present in C<$record>. Consequently, ModBiblio() is not +to be used to try to modify item records. + +C<$frameworkcode> specifies the MARC framework to use +when storing the modified bib record; among other things, +this controls how MARC fields get mapped to display columns +in the C and C tables, as well as +which fields are used to store embedded item, biblioitem, +and biblionumber data for indexing. =cut @@ -265,25 +293,17 @@ sub ModBiblio { # get the items before and append them to the biblio before updating the record, atm we just have the biblio my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField("items.itemnumber",$frameworkcode); my $oldRecord = GetMarcBiblio( $biblionumber ); - - # parse each item, and, for an unknown reason, re-encode each subfield - # if you don't do that, the record will have encoding mixed - # and the biblio will be re-encoded. - # strange, I (Paul P.) searched more than 1 day to understand what happends - # but could only solve the problem this way... - my @fields = $oldRecord->field( $itemtag ); - foreach my $fielditem ( @fields ){ - my $field; - foreach ($fielditem->subfields()) { - if ($field) { - $field->add_subfields(Encode::encode('utf-8',$_->[0]) => Encode::encode('utf-8',$_->[1])); - } else { - $field = MARC::Field->new("$itemtag",'','',Encode::encode('utf-8',$_->[0]) => Encode::encode('utf-8',$_->[1])); - } - } - $record->append_fields($field); + + # delete any item fields from incoming record to avoid + # duplication or incorrect data - use AddItem() or ModItem() + # to change items + foreach my $field ($record->field($itemtag)) { + $record->delete_field($field); } - + + # once all the items fields are removed, copy the old ones, in order to keep synchronize + $record->append_fields($oldRecord->field( $itemtag )); + # update biblionumber and biblioitemnumber in MARC # FIXME - this is assuming a 1 to 1 relationship between # biblios and biblioitems @@ -356,6 +376,12 @@ sub DelBiblio { return $error if $error; + # We delete attached subscriptions + my $subscriptions = &C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber); + foreach my $subscription (@$subscriptions){ + &C4::Serials::DelSubscription($subscription->{subscriptionid}); + } + # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio # for at least 2 reasons : # - we need to read the biblio if NoZebra is set (to remove it from the indexes @@ -449,6 +475,115 @@ sub LinkBibHeadingsToAuthorities { return $num_headings_changed; } +=head2 GetRecordValue + +=over 4 + +my $values = GetRecordValue($field, $record, $frameworkcode); + +=back + +Get MARC fields from a keyword defined in fieldmapping table. + +=cut + +sub GetRecordValue { + my ($field, $record, $frameworkcode) = @_; + my $dbh = C4::Context->dbh; + + my $sth = $dbh->prepare('SELECT fieldcode, subfieldcode FROM fieldmapping WHERE frameworkcode = ? AND field = ?'); + $sth->execute($frameworkcode, $field); + + my @result = (); + + while(my $row = $sth->fetchrow_hashref){ + foreach my $field ($record->field($row->{fieldcode})){ + if( ($row->{subfieldcode} ne "" && $field->subfield($row->{subfieldcode}))){ + foreach my $subfield ($field->subfield($row->{subfieldcode})){ + push @result, { 'subfield' => $subfield }; + } + + }elsif($row->{subfieldcode} eq "") { + push @result, {'subfield' => $field->as_string()}; + } + } + } + + return \@result; +} + +=head2 SetFieldMapping + +=over 4 + +SetFieldMapping($framework, $field, $fieldcode, $subfieldcode); + +=back + +Set a Field to MARC mapping value, if it already exists we don't add a new one. + +=cut + +sub SetFieldMapping { + my ($framework, $field, $fieldcode, $subfieldcode) = @_; + my $dbh = C4::Context->dbh; + + my $sth = $dbh->prepare('SELECT * FROM fieldmapping WHERE fieldcode = ? AND subfieldcode = ? AND frameworkcode = ? AND field = ?'); + $sth->execute($fieldcode, $subfieldcode, $framework, $field); + if(not $sth->fetchrow_hashref){ + my @args; + $sth = $dbh->prepare('INSERT INTO fieldmapping (fieldcode, subfieldcode, frameworkcode, field) VALUES(?,?,?,?)'); + + $sth->execute($fieldcode, $subfieldcode, $framework, $field); + } +} + +=head2 DeleteFieldMapping + +=over 4 + +DeleteFieldMapping($id); + +=back + +Delete a field mapping from an $id. + +=cut + +sub DeleteFieldMapping{ + my ($id) = @_; + my $dbh = C4::Context->dbh; + + my $sth = $dbh->prepare('DELETE FROM fieldmapping WHERE id = ?'); + $sth->execute($id); +} + +=head2 GetFieldMapping + +=over 4 + +GetFieldMapping($frameworkcode); + +=back + +Get all field mappings for a specified frameworkcode + +=cut + +sub GetFieldMapping { + my ($framework) = @_; + my $dbh = C4::Context->dbh; + + my $sth = $dbh->prepare('SELECT * FROM fieldmapping where frameworkcode = ?'); + $sth->execute($framework); + + my @return; + while(my $row = $sth->fetchrow_hashref){ + push @return, $row; + } + return \@return; +} + =head2 GetBiblioData =over 4 @@ -515,7 +650,7 @@ sub GetBiblioItemData { my ($biblioitemnumber) = @_; my $dbh = C4::Context->dbh; my $query = "SELECT *,biblioitems.notes AS bnotes - FROM biblio LEFT JOIN biblioitems on biblio.biblionumber=biblioitems.biblioitemnumber "; + FROM biblio LEFT JOIN biblioitems on biblio.biblionumber=biblioitems.biblionumber "; unless(C4::Context->preference('item-level_itypes')) { $query .= "LEFT JOIN itemtypes on biblioitems.itemtype=itemtypes.itemtype "; } @@ -594,6 +729,138 @@ sub GetBiblioFromItemNumber { return ($data); } +=head2 GetISBDView + +=over 4 + +$isbd = &GetISBDView($biblionumber); + +Return the ISBD view which can be included in opac and intranet + +=back + +=cut + +sub GetISBDView { + my $biblionumber = shift; + my $record = GetMarcBiblio($biblionumber); + my $itemtype = &GetFrameworkCode($biblionumber); + my ($holdingbrtagf,$holdingbrtagsubf) = &GetMarcFromKohaField("items.holdingbranch",$itemtype); + my $tagslib = &GetMarcStructure( 1, $itemtype ); + + my $ISBD = C4::Context->preference('ISBD'); + my $bloc = $ISBD; + my $res; + my $blocres; + + foreach my $isbdfield ( split (/#/, $bloc) ) { + + # $isbdfield= /(.?.?.?)/; + $isbdfield =~ /(\d\d\d)([^\|])?\|(.*)\|(.*)\|(.*)/; + my $fieldvalue = $1 || 0; + my $subfvalue = $2 || ""; + my $textbefore = $3; + my $analysestring = $4; + my $textafter = $5; + + # warn "==> $1 / $2 / $3 / $4"; + # my $fieldvalue=substr($isbdfield,0,3); + if ( $fieldvalue > 0 ) { + my $hasputtextbefore = 0; + my @fieldslist = $record->field($fieldvalue); + @fieldslist = sort {$a->subfield($holdingbrtagsubf) cmp $b->subfield($holdingbrtagsubf)} @fieldslist if ($fieldvalue eq $holdingbrtagf); + + # warn "ERROR IN ISBD DEFINITION at : $isbdfield" unless $fieldvalue; + # warn "FV : $fieldvalue"; + if ($subfvalue ne ""){ + foreach my $field ( @fieldslist ) { + foreach my $subfield ($field->subfield($subfvalue)){ + my $calculated = $analysestring; + my $tag = $field->tag(); + if ( $tag < 10 ) { + } + else { + my $subfieldvalue = + GetAuthorisedValueDesc( $tag, $subfvalue, + $subfield, '', $tagslib ); + my $tagsubf = $tag . $subfvalue; + $calculated =~ + s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g; + $calculated =~s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; + + # field builded, store the result + if ( $calculated && !$hasputtextbefore ) + { # put textbefore if not done + $blocres .= $textbefore; + $hasputtextbefore = 1; + } + + # remove punctuation at start + $calculated =~ s/^( |;|:|\.|-)*//g; + $blocres .= $calculated; + + } + } + } + $blocres .= $textafter if $hasputtextbefore; + } else { + foreach my $field ( @fieldslist ) { + my $calculated = $analysestring; + my $tag = $field->tag(); + if ( $tag < 10 ) { + } + else { + my @subf = $field->subfields; + for my $i ( 0 .. $#subf ) { + my $valuecode = $subf[$i][1]; + my $subfieldcode = $subf[$i][0]; + my $subfieldvalue = + GetAuthorisedValueDesc( $tag, $subf[$i][0], + $subf[$i][1], '', $tagslib ); + my $tagsubf = $tag . $subfieldcode; + + $calculated =~ s/ # replace all {{}} codes by the value code. + \{\{$tagsubf\}\} # catch the {{actualcode}} + / + $valuecode # replace by the value code + /gx; + + $calculated =~ + s/\{(.?.?.?.?)$tagsubf(.*?)\}/$1$subfieldvalue$2\{$1$tagsubf$2\}/g; + $calculated =~s#/cgi-bin/koha/[^/]+/([^.]*.pl\?.*)$#opac-$1#g; + } + + # field builded, store the result + if ( $calculated && !$hasputtextbefore ) + { # put textbefore if not done + $blocres .= $textbefore; + $hasputtextbefore = 1; + } + + # remove punctuation at start + $calculated =~ s/^( |;|:|\.|-)*//g; + $blocres .= $calculated; + } + } + $blocres .= $textafter if $hasputtextbefore; + } + } + else { + $blocres .= $isbdfield; + } + } + $res .= $blocres; + + $res =~ s/\{(.*?)\}//g; + $res =~ s/\\n/\n/g; + $res =~ s/\n//g; + + # remove empty () + $res =~ s/\(\)//g; + + return $res; +} + =head2 GetBiblio =over 4 @@ -671,23 +938,17 @@ sub GetMarcStructure { return $marc_structure_cache->{$forlibrarian}->{$frameworkcode}; } - my $sth; - my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac'; - - # check that framework exists - $sth = - $dbh->prepare( + my $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( + $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 ); @@ -701,13 +962,12 @@ sub GetMarcStructure { $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 = $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); @@ -726,7 +986,7 @@ sub GetMarcStructure { while ( ( $tag, $subfield, $liblibrarian, - , $libopac, $tab, + $libopac, $tab, $mandatory, $repeatable, $authorised_value, $authtypecode, $value_builder, $kohafield, $seealso, $hidden, $isurl, @@ -758,7 +1018,7 @@ sub GetMarcStructure { =head2 GetUsedMarcStructure - the same function as GetMarcStructure expcet it just take field + the same function as GetMarcStructure except it just takes field in tab 0-9. (used field) my $results = GetUsedMarcStructure($frameworkcode); @@ -772,20 +1032,16 @@ sub GetMarcStructure { sub GetUsedMarcStructure($){ my $frameworkcode = shift || ''; - my $dbh = C4::Context->dbh; my $query = qq/ SELECT * FROM marc_subfield_structure WHERE tab > -1 AND frameworkcode = ? + ORDER BY tagfield, tagsubfield /; - my @results; - my $sth = $dbh->prepare($query); + my $sth = C4::Context->dbh->prepare($query); $sth->execute($frameworkcode); - while (my $row = $sth->fetchrow_hashref){ - push @results,$row; - } - return \@results; + return $sth->fetchall_arrayref({}); } =head2 GetMarcFromKohaField @@ -802,7 +1058,7 @@ for the given frameworkcode sub GetMarcFromKohaField { my ( $kohafield, $frameworkcode ) = @_; - return 0, 0 unless $kohafield; + return 0, 0 unless $kohafield and defined $frameworkcode; my $relations = C4::Context->marcfromkohafield; return ( $relations->{$frameworkcode}->{$kohafield}->[0], @@ -814,11 +1070,14 @@ sub GetMarcFromKohaField { =over 4 -Returns MARC::Record of the biblionumber passed in parameter. -the marc record contains both biblio & item datas +my $record = GetMarcBiblio($biblionumber); =back +Returns MARC::Record representing bib identified by +C<$biblionumber>. If no bib exists, returns undef. +The MARC record contains both biblio & item data. + =cut sub GetMarcBiblio { @@ -864,6 +1123,129 @@ sub GetXmlBiblio { return $marcxml; } +=head2 GetCOinSBiblio + +=over 4 + +my $coins = GetCOinSBiblio($biblionumber); + +Returns the COinS(a span) which can be included in a biblio record + +=back + +=cut + +sub GetCOinSBiblio { + my ( $biblionumber ) = @_; + my $record = GetMarcBiblio($biblionumber); + my $coins_value; + if (defined $record){ + # get the coin format + my $pos7 = substr $record->leader(), 7,1; + my $pos6 = substr $record->leader(), 6,1; + my $mtx; + my $genre; + my ($aulast, $aufirst) = ('',''); + my $oauthors = ''; + my $title = ''; + my $subtitle = ''; + my $pubyear = ''; + my $isbn = ''; + my $issn = ''; + my $publisher = ''; + + if ( C4::Context->preference("marcflavour") eq "UNIMARC" ){ + my $fmts6; + my $fmts7; + %$fmts6 = ( + 'a' => 'book', + 'b' => 'manuscript', + 'c' => 'book', + 'd' => 'manuscript', + 'e' => 'map', + 'f' => 'map', + 'g' => 'film', + 'i' => 'audioRecording', + 'j' => 'audioRecording', + 'k' => 'artwork', + 'l' => 'document', + 'm' => 'computerProgram', + 'r' => 'document', + + ); + %$fmts7 = ( + 'a' => 'journalArticle', + 's' => 'journal', + ); + + $genre = $fmts6->{$pos6} ? $fmts6->{$pos6} : 'book' ; + + if( $genre eq 'book' ){ + $genre = $fmts7->{$pos7} if $fmts7->{$pos7}; + } + + ##### We must transform mtx to a valable mtx and document type #### + if( $genre eq 'book' ){ + $mtx = 'book'; + }elsif( $genre eq 'journal' ){ + $mtx = 'journal'; + }elsif( $genre eq 'journalArticle' ){ + $mtx = 'journal'; + $genre = 'article'; + }else{ + $mtx = 'dc'; + } + + $genre = ($mtx eq 'dc') ? "&rft.type=$genre" : "&rft.genre=$genre"; + + # Setting datas + $aulast = $record->subfield('700','a'); + $aufirst = $record->subfield('700','b'); + $oauthors = "&rft.au=$aufirst $aulast"; + # others authors + if($record->field('200')){ + for my $au ($record->field('200')->subfield('g')){ + $oauthors .= "&rft.au=$au"; + } + } + $title = ( $mtx eq 'dc' ) ? "&rft.title=".$record->subfield('200','a') : + "&rft.title=".$record->subfield('200','a')."&rft.btitle=".$record->subfield('200','a'); + $pubyear = $record->subfield('210','d'); + $publisher = $record->subfield('210','c'); + $isbn = $record->subfield('010','a'); + $issn = $record->subfield('011','a'); + }else{ + # MARC21 need some improve + my $fmts; + $mtx = 'book'; + $genre = "&rft.genre=book"; + + # Setting datas + if ($record->field('100')) { + $oauthors .= "&rft.au=".$record->subfield('100','a'); + } + # others authors + if($record->field('700')){ + for my $au ($record->field('700')->subfield('a')){ + $oauthors .= "&rft.au=$au"; + } + } + $title = "&rft.btitle=".$record->subfield('245','a'); + $subtitle = $record->subfield('245', 'b') || ''; + $title .= $subtitle; + $pubyear = $record->subfield('260', 'c') || ''; + $publisher = $record->subfield('260', 'b') || ''; + $isbn = $record->subfield('020', 'a') || ''; + $issn = $record->subfield('022', 'a') || ''; + + } + $coins_value = "ctx_ver=Z39.88-2004&rft_val_fmt=info%3Aofi%2Ffmt%3Akev%3Amtx%3A$mtx$genre$title&rft.isbn=$isbn&rft.issn=$issn&rft.aulast=$aulast&rft.aufirst=$aufirst$oauthors&rft.pub=$publisher&rft.date=$pubyear"; + $coins_value =~ s/\ /\+/g; + #&rft.au=&rft.btitle=&rft.date=&rft.pages=&rft.isbn=&rft.aucorp=&rft.place=&rft.pub=&rft.edition=&rft.series=&rft.genre=" + } + return $coins_value; +} + =head2 GetAuthorisedValueDesc =over 4 @@ -885,6 +1267,9 @@ sub GetAuthorisedValueDesc { my $dbh = C4::Context->dbh; if (!$category) { + + return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'}; + #---- branch if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) { return C4::Branch::GetBranchName($value); @@ -940,6 +1325,8 @@ sub GetMarcNotes { my $marcnote; foreach my $field ( $record->field($scope) ) { my $value = $field->as_string(); + $value =~ s/\n/
/g ; + if ( $note ne "" ) { $marcnote = { marcnote => $note, }; push @marcnotes, $marcnote; @@ -996,7 +1383,9 @@ sub GetMarcSubjects { 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) ) ); + next if (($marcflavour eq "UNIMARC") and ($subject_subfield->[0] =~ /3|4|5/ ) ); + # don't load MARC21 subfields 2 (FIXME: any more subfields??) + next if (($marcflavour eq "MARC21") and ($subject_subfield->[0] =~ /2/ ) ); my $code = $subject_subfield->[0]; my $value = $subject_subfield->[1]; my $linkvalue = $value; @@ -1036,7 +1425,7 @@ sub GetMarcAuthors { my ( $record, $marcflavour ) = @_; my ( $mintag, $maxtag ); # tagslib useful for UNIMARC author reponsabilities - my $tagslib = &GetMarcStructure( 1, '' ); # FIXME : we don't have the framework available, we take the default framework. May be bugguy on some setups, will be usually correct. + my $tagslib = &GetMarcStructure( 1, '' ); # FIXME : we don't have the framework available, we take the default framework. May be buggy on some setups, will be usually correct. if ( $marcflavour eq "MARC21" ) { $mintag = "700"; $maxtag = "720"; @@ -1060,7 +1449,7 @@ sub GetMarcAuthors { my $subfield9 = $field->subfield('9'); for my $authors_subfield (@subfields) { # don't load unimarc subfields 3, 5 - next if ($marcflavour eq 'UNIMARC' and ($authors_subfield->[0] =~ (3|5) ) ); + next if ($marcflavour eq 'UNIMARC' and ($authors_subfield->[0] =~ /3|5/ ) ); my $subfieldcode = $authors_subfield->[0]; my $value = $authors_subfield->[1]; my $linkvalue = $value; @@ -1068,7 +1457,7 @@ sub GetMarcAuthors { 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" }); + @link_loop = ({'limit' => 'an' ,link => "$subfield9" }); } else { # reset $linkvalue if UNIMARC author responsibility @@ -1080,7 +1469,7 @@ sub GetMarcAuthors { $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 ); + push @subfields_loop, {code => $subfieldcode, value => $value, link_loop => \@this_link_loop, separator => $separator} unless ($authors_subfield->[0] eq '9' ); $count_auth++; } push @marcauthors, { MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop }; @@ -1101,31 +1490,48 @@ Assumes web resources (not uncommon in MARC21 to omit resource type ind) =cut sub GetMarcUrls { - my ($record, $marcflavour) = @_; + my ( $record, $marcflavour ) = @_; + my @marcurls; - my $marcurl; - for my $field ($record->field('856')) { - my $url = $field->subfield('u'); + for my $field ( $record->field('856') ) { + my $marcurl; my @notes; - for my $note ( $field->subfield('z')) { - push @notes , {note => $note}; - } - $marcurl = { MARCURL => $url, - notes => \@notes, - }; - 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; + for my $note ( $field->subfield('z') ) { + push @notes, { note => $note }; + } + my @urls = $field->subfield('u'); + foreach my $url (@urls) { + if ( $marcflavour eq 'MARC21' ) { + my $s3 = $field->subfield('3'); + my $link = $field->subfield('y'); + unless ( $url =~ /^\w+:/ ) { + if ( $field->indicator(1) eq '7' ) { + $url = $field->subfield('2') . "://" . $url; + } elsif ( $field->indicator(1) eq '1' ) { + $url = 'ftp://' . $url; + } else { + # properly, this should be if ind1=4, + # however we will assume http protocol since we're building a link. + $url = 'http://' . $url; + } + } + # TODO handle ind 2 (relationship) + $marcurl = { + MARCURL => $url, + notes => \@notes, + }; + $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url; + $marcurl->{'part'} = $s3 if ($link); + $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^table/i ); + } else { + $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url; + $marcurl->{'MARCURL'} = $url; + } + push @marcurls, $marcurl; } - push @marcurls, $marcurl; } return \@marcurls; -} #end GetMarcUrls +} =head2 GetMarcSeries @@ -1259,18 +1665,15 @@ sub GetPublisherNameFromIsbn($){ =cut sub TransformKohaToMarc { - my ( $hash ) = @_; - my $dbh = C4::Context->dbh; - my $sth = - $dbh->prepare( + my $sth = C4::Context->dbh->prepare( "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?" ); my $record = MARC::Record->new(); + SetMarcUnicodeFlag($record, C4::Context->preference("marcflavour")); foreach (keys %{$hash}) { - &TransformKohaToMarcOneField( $sth, $record, $_, - $hash->{$_}, '' ); - } + &TransformKohaToMarcOneField( $sth, $record, $_, $hash->{$_}, '' ); + } return $record; } @@ -1329,6 +1732,7 @@ $auth_type contains : sub TransformHtmlToXml { my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_; my $xml = MARC::File::XML::header('UTF-8'); + $xml .= "\n"; $auth_type = C4::Context->preference('marcflavour') unless $auth_type; MARC::File::XML->default_record_format($auth_type); # in UNIMARC, field 100 contains the encoding @@ -1340,7 +1744,7 @@ sub TransformHtmlToXml { my $prevtag = -1; my $first = 1; my $j = -1; - for ( my $i = 0 ; $i <= @$tags ; $i++ ) { + for ( my $i = 0 ; $i < @$tags ; $i++ ) { if (C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a") { # if we have a 100 field and it's values are not correct, skip them. # if we don't have any valid 100 field, we will create a default one at the end @@ -1366,19 +1770,17 @@ sub TransformHtmlToXml { if ( ( @$tags[$i] && @$tags[$i] > 10 ) && ( @$values[$i] ne "" ) ) { - my $ind1 = substr( @$indicator[$j], 0, 1 ); + my $ind1 = _default_ind_to_space(substr( @$indicator[$j], 0, 1 )); my $ind2; if ( @$indicator[$j] ) { - $ind2 = substr( @$indicator[$j], 1, 1 ); + $ind2 = _default_ind_to_space(substr( @$indicator[$j], 1, 1 )); } else { warn "Indicator in @$tags[$i] is empty"; $ind2 = " "; } - $xml .= -"\n"; - $xml .= -"@$values[$i]\n"; + $xml .= "\n"; + $xml .= "@$values[$i]\n"; $first = 0; } else { @@ -1396,17 +1798,14 @@ sub TransformHtmlToXml { # rest of the fixed fields } elsif ( @$tags[$i] < 10 ) { - $xml .= -"@$values[$i]\n"; + $xml .= "@$values[$i]\n"; $first = 1; } else { - my $ind1 = substr( @$indicator[$j], 0, 1 ); - my $ind2 = substr( @$indicator[$j], 1, 1 ); - $xml .= -"\n"; - $xml .= -"@$values[$i]\n"; + my $ind1 = _default_ind_to_space( substr( @$indicator[$j], 0, 1 ) ); + my $ind2 = _default_ind_to_space( substr( @$indicator[$j], 1, 1 ) ); + $xml .= "\n"; + $xml .= "@$values[$i]\n"; $first = 0; } } @@ -1417,21 +1816,19 @@ sub TransformHtmlToXml { } else { if ($first) { - my $ind1 = substr( @$indicator[$j], 0, 1 ); - my $ind2 = substr( @$indicator[$j], 1, 1 ); - $xml .= -"\n"; + my $ind1 = _default_ind_to_space( substr( @$indicator[$j], 0, 1 ) ); + my $ind2 = _default_ind_to_space( substr( @$indicator[$j], 1, 1 ) ); + $xml .= "\n"; $first = 0; } - $xml .= -"@$values[$i]\n"; + $xml .= "@$values[$i]\n"; } } $prevtag = @$tags[$i]; } + $xml .= "\n" if @$tags > 0; 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) ); # set 50 to position 26 is biblios, 13 if authorities my $pos=26; @@ -1442,19 +1839,37 @@ sub TransformHtmlToXml { $xml .= "$string\n"; $xml .= "\n"; } + $xml .= "\n"; $xml .= MARC::File::XML::footer(); return $xml; } +=head2 _default_ind_to_space + +Passed what should be an indicator returns a space +if its undefined or zero length + +=cut + +sub _default_ind_to_space { + my $s = shift; + if (!defined $s || $s eq q{}) { + return ' '; + } + return $s; +} + =head2 TransformHtmlToMarc L<$record> = TransformHtmlToMarc(L<$params>,L<$cgi>) L<$params> is a ref to an array as below: { - 'tag_010_indicator_531951' , + 'tag_010_indicator1_531951' , + 'tag_010_indicator2_531951' , 'tag_010_code_a_531951_145735' , 'tag_010_subfield_a_531951_145735' , - 'tag_200_indicator_873510' , + 'tag_200_indicator1_873510' , + 'tag_200_indicator2_873510' , 'tag_200_code_a_873510_673465' , 'tag_200_subfield_a_873510_673465' , 'tag_200_code_b_873510_704318' , @@ -1472,7 +1887,21 @@ sub TransformHtmlToXml { sub TransformHtmlToMarc { my $params = shift; my $cgi = shift; - + + # explicitly turn on the UTF-8 flag for all + # 'tag_' parameters to avoid incorrect character + # conversion later on + my $cgi_params = $cgi->Vars; + foreach my $param_name (keys %$cgi_params) { + if ($param_name =~ /^tag_/) { + my $param_value = $cgi_params->{$param_name}; + if (utf8::decode($param_value)) { + $cgi_params->{$param_name} = $param_value; + } + # FIXME - need to do something if string is not valid UTF-8 + } + } + # creating a new record my $record = MARC::Record->new(); my $i=0; @@ -1499,20 +1928,20 @@ sub TransformHtmlToMarc { } push @fields,$newfield if($newfield); } - elsif ($param =~ /^tag_(\d*)_indicator_/){ # new field start when having 'input name="..._indicator_..." + elsif ($param =~ /^tag_(\d*)_indicator1_/){ # new field start when having 'input name="..._indicator1_..." my $tag = $1; - my $ind1 = substr($cgi->param($param),0,1); - my $ind2 = substr($cgi->param($param),1,1); + my $ind1 = _default_ind_to_space(substr($cgi->param($param), 0, 1)); + my $ind2 = _default_ind_to_space(substr($cgi->param($params->[$i+1]), 0, 1)); $newfield=0; - my $j=$i+1; + my $j=$i+2; if($tag < 10){ # no code for theses fields # in MARC editor, 000 contains the leader. if ($tag eq '000' ) { $record->leader($cgi->param($params->[$j+1])) if length($cgi->param($params->[$j+1]))==24; # between 001 and 009 (included) - } else { + } elsif ($cgi->param($params->[$j+1]) ne '') { $newfield = MARC::Field->new( $tag, $cgi->param($params->[$j+1]), @@ -1520,20 +1949,20 @@ sub TransformHtmlToMarc { } # > 009, deal with subfields } else { - while($params->[$j] =~ /_code_/){ # browse all it's subfield + while(defined $params->[$j] && $params->[$j] =~ /_code_/){ # browse all it's subfield my $inner_param = $params->[$j]; if ($newfield){ - if($cgi->param($params->[$j+1])){ # only if there is a value (code => value) + if($cgi->param($params->[$j+1]) ne ''){ # only if there is a value (code => value) $newfield->add_subfields( $cgi->param($inner_param) => $cgi->param($params->[$j+1]) ); } } else { - if ( $cgi->param($params->[$j+1]) ) { # creating only if there is a value (code => value) + if ( $cgi->param($params->[$j+1]) ne '' ) { # creating only if there is a value (code => value) $newfield = MARC::Field->new( $tag, - ''.$ind1, - ''.$ind2, + $ind1, + $ind2, $cgi->param($inner_param) => $cgi->param($params->[$j+1]), ); } @@ -1569,13 +1998,15 @@ sub TransformMarcToKoha { my ( $dbh, $record, $frameworkcode, $limit_table ) = @_; my $result; - + $limit_table=$limit_table||0; + $frameworkcode = '' unless defined $frameworkcode; + unless (defined $inverted_field_map) { $inverted_field_map = _get_inverted_marc_field_map(); } my %tables = (); - if ($limit_table eq 'items') { + if ( defined $limit_table && $limit_table eq 'items') { $tables{'items'} = 1; } else { $tables{'items'} = 1; @@ -1626,8 +2057,8 @@ sub TransformMarcToKoha { # 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 ) { + $temp =~ m/c(\d\d\d\d)/; + if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first $result->{'copyrightdate'} = $1; } else { # if no cYYYY, get the 1st date. @@ -1639,8 +2070,7 @@ sub TransformMarcToKoha { # 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 ) { + if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first $result->{'publicationyear'} = $1; } else { # if no cYYYY, get the 1st date. @@ -1658,6 +2088,7 @@ sub _get_inverted_marc_field_map { foreach my $frameworkcode (keys %{ $relations }) { foreach my $kohafield (keys %{ $relations->{$frameworkcode} }) { + next unless @{ $relations->{$frameworkcode}->{$kohafield} }; # not all columns are mapped to MARC tag & subfield my $tag = $relations->{$frameworkcode}->{$kohafield}->[0]; my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1]; my ($table, $column) = split /[.]/, $kohafield, 2; @@ -1701,6 +2132,15 @@ more. =cut +sub CountItemsIssued { + my ( $biblionumber ) = @_; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?'); + $sth->execute( $biblionumber ); + my $row = $sth->fetchrow_hashref(); + return $row->{'issuedCount'}; +} + sub _disambiguate { my ($table, $column) = @_; if ($column eq "cn_sort" or $column eq "cn_source") { @@ -1825,9 +2265,10 @@ Returns a hash with all the fields for Display a given item data in a template sub PrepareItemrecordDisplay { - my ( $bibnum, $itemnum ) = @_; + my ( $bibnum, $itemnum, $defaultvalues ) = @_; my $dbh = C4::Context->dbh; + my $today_iso = C4::Dates->today('iso'); my $frameworkcode = &GetFrameworkCode( $bibnum ); my ( $itemtagfield, $itemtagsubfield ) = &GetMarcFromKohaField( "items.itemnumber", $frameworkcode ); @@ -1854,21 +2295,27 @@ sub PrepareItemrecordDisplay { $tagslib->{$tag}->{$subfield}->{'kohafield'}; # $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib}; - $subfield_data{marc_lib} = - "{$tag}->{$subfield}->{lib} . "\">" - . substr( $tagslib->{$tag}->{$subfield}->{lib}, 0, 12 ) - . ""; + $subfield_data{marc_lib} = $tagslib->{$tag}->{$subfield}->{lib}; $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; + my ( $x, $value ); + if ($itemrecord) { + ( $x, $value ) = _find_value( $tag, $subfield, $itemrecord ); + } + unless ($value) { + $value = $tagslib->{$tag}->{$subfield}->{defaultvalue}; + $value ||= $defaultvalues->{$tagslib->{$tag}->{$subfield}->{'kohafield'}}; + # get today date & replace YYYY, MM, DD if provided in the default value + my ( $year, $month, $day ) = split ',', $today_iso; # FIXME: iso dates don't have commas! + $value =~ s/YYYY/$year/g; + $value =~ s/MM/$month/g; + $value =~ s/DD/$day/g; + } + $value =~ s/"/"/g; # search for itemcallnumber if applicable if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq @@ -1884,6 +2331,26 @@ sub PrepareItemrecordDisplay { $value = $temp->subfield($CNsubfield); } } + if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq + 'items.itemcallnumber' + && $defaultvalues->{'callnumber'} ) + { + my $temp = $itemrecord->field($subfield) if ($itemrecord); + unless ($temp) { + $value = $defaultvalues->{'callnumber'}; + } + } + if ( ($tagslib->{$tag}->{$subfield}->{kohafield} eq + 'items.holdingbranch' || + $tagslib->{$tag}->{$subfield}->{kohafield} eq + 'items.homebranch') + && $defaultvalues->{'branchcode'} ) + { + my $temp = $itemrecord->field($subfield) if ($itemrecord); + unless ($temp) { + $value = $defaultvalues->{branchcode}; + } + } if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) { my @authorised_values; my %authorised_lib; @@ -1971,24 +2438,9 @@ sub PrepareItemrecordDisplay { -multiple => 0, ); } - elsif ( $tagslib->{$tag}->{$subfield}->{thesaurus_category} ) { - $subfield_data{marc_value} = -" {$tag}->{$subfield}->{thesaurus_category}&index=',)\">..."; - -#" -# 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}=" ... $javascript"; - } else { $subfield_data{marc_value} = -""; +""; } push( @loop_data, \%subfield_data ); } @@ -2069,8 +2521,8 @@ sub ModZebra { # lock the nozebra table : we will read index lines, update them in Perl process # and write everything in 1 transaction. # lock the table to avoid someone else overwriting what we are doing - $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE'); - my %result; # the result hash that will be builded by deletion / add, and written on mySQL at the end, to improve speed + $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE, auth_subfield_structure READ'); + my %result; # the result hash that will be built by deletion / add, and written on mySQL at the end, to improve speed if ($op eq 'specialUpdate') { # OK, we have to add or update the record # 1st delete (virtually, in indexes), if record actually exists @@ -2092,7 +2544,6 @@ sub ModZebra { } } $dbh->do('UNLOCK TABLES'); - } else { # # we use zebra, just fill zebraqueue table @@ -2123,15 +2574,13 @@ sub ModZebra { =cut sub GetNoZebraIndexes { - my $index = C4::Context->preference('NoZebraIndexes'); + my $no_zebra_indexes = C4::Context->preference('NoZebraIndexes'); my %indexes; - foreach my $line (split /('|"),/,$index) { + INDEX: foreach my $line (split /['"],[\n\r]*/,$no_zebra_indexes) { $line =~ /(.*)=>(.*)/; - my $index = substr($1,1); # get the index, don't forget to remove initial ' or " + my $index = $1; # initial ' or " is removed afterwards my $fields = $2; $index =~ s/'|"|\s//g; - - $fields =~ s/'|"|\s//g; $indexes{$index}=$fields; } @@ -2164,7 +2613,7 @@ sub _DelBiblioNoZebra { if ($server eq 'biblioserver') { %index=GetNoZebraIndexes; # get title of the record (to store the 10 first letters with the index) - my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title'); + my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title',''); $title = lc($record->subfield($titletag,$titlesubfield)); } else { # for authorities, the "title" is the $a mainentry @@ -2204,7 +2653,7 @@ sub _DelBiblioNoZebra { foreach (split / /,$line) { next unless $_; # skip empty values (multiple spaces) # if the entry is already here, do nothing, the biblionumber has already be removed - unless ($result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) { + unless ( defined( $result{$key}->{$_} ) && ( $result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) ) { # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing $sth2->execute($server,$key,$_); my $existing_biblionumbers = $sth2->fetchrow; @@ -2258,7 +2707,7 @@ sub _AddBiblioNoZebra { if ($server eq 'biblioserver') { %index=GetNoZebraIndexes; # get title of the record (to store the 10 first letters with the index) - my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title'); + my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title',''); $title = lc($record->subfield($titletag,$titlesubfield)); } else { # warn "server : $server"; @@ -2280,12 +2729,13 @@ sub _AddBiblioNoZebra { my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?'); foreach my $field ($record->fields()) { #parse each subfield + ###FIXME: impossible to index a 001-009 value with NoZebra next if $field->tag <10; foreach my $subfield ($field->subfields()) { my $tag = $field->tag(); my $subfieldcode = $subfield->[0]; my $indexed=0; - warn "INDEXING :".$subfield->[1]; +# 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) { @@ -2300,9 +2750,9 @@ sub _AddBiblioNoZebra { next unless $_; # skip empty values (multiple spaces) # if the entry is already here, improve weight # warn "managing $_"; - if ($result{$key}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d);/) { - my $weight=$1+1; - $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//; + if ( exists $result{$key}->{$_} && $result{$key}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d+);/) { + my $weight = $1 + 1; + $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g; $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;"; } else { # get the value if it exist in the nozebra table, otherwise, create it @@ -2311,8 +2761,8 @@ sub _AddBiblioNoZebra { # it exists if ($existing_biblionumbers) { $result{$key}->{"$_"} =$existing_biblionumbers; - my $weight=$1+1; - $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//; + my $weight = defined $1 ? $1 + 1 : 1; + $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g; $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;"; # create a new ligne for this entry } else { @@ -2332,9 +2782,10 @@ sub _AddBiblioNoZebra { foreach (split / /,$line) { next unless $_; # skip empty values (multiple spaces) # if the entry is already here, improve weight - if ($result{'__RAW__'}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d);/) { + my $tmpstr = $result{'__RAW__'}->{"$_"} || ""; + if ($tmpstr =~ /$biblionumber,\Q$title\E\-(\d+);/) { my $weight=$1+1; - $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\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 @@ -2343,8 +2794,8 @@ sub _AddBiblioNoZebra { # it exists if ($existing_biblionumbers) { $result{'__RAW__'}->{"$_"} =$existing_biblionumbers; - my $weight=$1+1; - $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//; + my $weight = ($1 ? $1 : 0) + 1; + $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//; $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;"; # create a new ligne for this entry } else { @@ -2934,9 +3385,8 @@ sub ModBiblioMarc { # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode if ( $encoding eq "UNIMARC" ) { - my $string; - if ( length($record->subfield( 100, "a" )) == 35 ) { - $string = $record->subfield( 100, "a" ); + my $string = $record->subfield( 100, "a" ); + if ( ($string) && ( length($record->subfield( 100, "a" )) == 35 ) ) { my $f100 = $record->field(100); $record->delete_field($f100); } @@ -3081,8 +3531,9 @@ sub set_service_options { parameters: biblionumber + MARC::Record of the bib - returns: a hashref malling the authorised value to the value set for this biblionumber + returns: a hashref mapping the authorised value to the value set for this biblionumber $authorised_values = { 'Scent' => 'flowery', @@ -3097,14 +3548,13 @@ sub set_service_options { sub get_biblio_authorised_values { my $biblionumber = shift; + my $record = shift; my $forlibrarian = 1; # are we in staff or opac? my $frameworkcode = GetFrameworkCode( $biblionumber ); my $authorised_values; - my $record = GetMarcBiblio( $biblionumber ) - or return $authorised_values; my $tagslib = GetMarcStructure( $forlibrarian, $frameworkcode ) or return $authorised_values; @@ -3121,7 +3571,7 @@ sub get_biblio_authorised_values { foreach my $subfield ( keys( %{$tagslib->{ $tag }} ) ) { # warn "checking $subfield. type is: " . ref $tagslib->{ $tag }{ $subfield }; if ( 'HASH' eq ref $tagslib->{ $tag }{ $subfield } ) { - if ( exists $tagslib->{ $tag }{ $subfield }{'authorised_value'} && exists $bibliolevel_authorised_values->{ $tagslib->{ $tag }{ $subfield }{'authorised_value'} } ) { + if ( defined $tagslib->{ $tag }{ $subfield }{'authorised_value'} && exists $bibliolevel_authorised_values->{ $tagslib->{ $tag }{ $subfield }{'authorised_value'} } ) { if ( defined $record->field( $tag ) ) { my $this_subfield_value = $record->field( $tag )->subfield( $subfield ); if ( defined $this_subfield_value ) {