X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FBiblio.pm;h=2de61b52b809f1a026ed1f2445f5812284a2ce10;hb=6863ca9e9245724ac417f13f91616662093d5d8f;hp=3b2ffd4642955826f007a50c1e08c127c9afeaed;hpb=a4fecfbefab041d924f07db5e49b791388eaa2db;p=koha.git diff --git a/C4/Biblio.pm b/C4/Biblio.pm old mode 100644 new mode 100755 index 3b2ffd4642..2de61b52b8 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -23,17 +23,20 @@ use warnings; use MARC::Record; use MARC::File::USMARC; # Force MARC::File::XML to use LibXML SAX Parser -$XML::SAX::ParserPackage = "XML::LibXML::SAX"; -require MARC::File::XML; +#$XML::SAX::ParserPackage = "XML::LibXML::SAX"; +use MARC::File::XML; use ZOOM; +use POSIX qw(strftime); use C4::Koha; 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; @@ -43,6 +46,10 @@ BEGIN { # to add biblios # EXPORTED FUNCTIONS. + push @EXPORT_OK, qw( + &GetRecordValue + ); + push @EXPORT, qw( &AddBiblio ); @@ -55,6 +62,13 @@ BEGIN { &GetBiblioItemInfosOf &GetBiblioItemByBiblioNumber &GetBiblioFromItemNumber + + &GetRecordValue + &GetFieldMapping + &SetFieldMapping + &DeleteFieldMapping + + &GetISBDView &GetMarcNotes &GetMarcSubjects @@ -64,7 +78,7 @@ BEGIN { GetMarcUrls &GetUsedMarcStructure &GetXmlBiblio - &GetCOinSBiblio + &GetCOinSBiblio &GetAuthorisedValueDesc &GetMarcStructure @@ -72,6 +86,8 @@ BEGIN { &GetFrameworkCode &GetPublisherNameFromIsbn &TransformKohaToMarc + + &CountItemsIssued ); # To modify something @@ -233,10 +249,9 @@ 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 ); } @@ -285,25 +300,10 @@ sub ModBiblio { foreach my $field ($record->field($itemtag)) { $record->delete_field($field); } - - # 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); - } - + + # 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 @@ -376,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 @@ -469,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 @@ -614,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 @@ -691,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 ); @@ -721,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); @@ -746,7 +986,7 @@ sub GetMarcStructure { while ( ( $tag, $subfield, $liblibrarian, - , $libopac, $tab, + $libopac, $tab, $mandatory, $repeatable, $authorised_value, $authtypecode, $value_builder, $kohafield, $seealso, $hidden, $isurl, @@ -778,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); @@ -792,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 @@ -902,19 +1138,21 @@ Returns the COinS(a span) which can be included in a biblio record 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 $pubyear; - my $isbn; - my $issn; - my $publisher; + 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; @@ -983,24 +1221,28 @@ sub GetCOinSBiblio { $genre = "&rft.genre=book"; # Setting datas - $oauthors .= "&rft.au=".$record->subfield('100','a'); + 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'); - $pubyear = $record->subfield('260','c'); - $publisher = $record->subfield('260','b'); - $isbn = $record->subfield('020','a'); - $issn = $record->subfield('022','a'); + $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') || ''; } - my $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 = "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; } @@ -1083,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; @@ -1140,6 +1384,8 @@ sub GetMarcSubjects { 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/ ) ); + # 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; @@ -1179,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"; @@ -1244,44 +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; - for my $field ($record->field('856')) { + for my $field ( $record->field('856') ) { my $marcurl; - my $url = $field->subfield('u'); my @notes; - for my $note ( $field->subfield('z')) { - push @notes , {note => $note}; - } - 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($s3 =~ /^[Tt]able/) ; - } else { - $marcurl->{'linktext'} = $field->subfield('z') || C4::Context->preference('URLLinkText') || $url; - $marcurl->{'MARCURL'} = $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 @@ -1415,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; } @@ -1485,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 @@ -1522,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 { @@ -1552,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; } } @@ -1573,14 +1816,12 @@ 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]; @@ -1588,7 +1829,6 @@ sub TransformHtmlToXml { $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; @@ -1599,10 +1839,26 @@ 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>) @@ -1675,8 +1931,8 @@ sub TransformHtmlToMarc { 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($params->[$i+1]),0,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+2; @@ -1705,8 +1961,8 @@ sub TransformHtmlToMarc { 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]), ); } @@ -1876,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") { @@ -2003,6 +2268,7 @@ sub PrepareItemrecordDisplay { 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 ); @@ -2036,10 +2302,20 @@ sub PrepareItemrecordDisplay { $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 @@ -2162,21 +2438,6 @@ 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} = ""; @@ -2352,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 @@ -2446,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"; @@ -2521,7 +2782,8 @@ 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__'}->{"$_"} .= "$biblionumber,$title-$weight;"; @@ -2532,7 +2794,7 @@ sub _AddBiblioNoZebra { # it exists if ($existing_biblionumbers) { $result{'__RAW__'}->{"$_"} =$existing_biblionumbers; - my $weight=$1+1; + 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 @@ -3123,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); } @@ -3270,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', @@ -3286,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;