X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FBiblio.pm;h=81da91be74ed85b8f237860f14810526118c8c91;hb=bdd8eb5a814c2c9699f3728f7d32ae33bd6732c2;hp=33908f92805897214df18bee50e9ffbccfc97255;hpb=306dc79217783ebd7896be64deee12491febc4d3;p=koha.git diff --git a/C4/Biblio.pm b/C4/Biblio.pm index 33908f9280..81da91be74 100644 --- a/C4/Biblio.pm +++ b/C4/Biblio.pm @@ -27,7 +27,6 @@ use Carp; use MARC::Record; use MARC::File::USMARC; use MARC::File::XML; -use ZOOM; use POSIX qw(strftime); use C4::Koha; @@ -35,9 +34,7 @@ use C4::Dates qw/format_date/; use C4::Log; # logaction use C4::ClassSource; use C4::Charset; -require C4::Heading; -require C4::Serials; -require C4::Items; +use C4::Linker; use vars qw($VERSION @ISA @EXPORT); @@ -74,10 +71,12 @@ BEGIN { &GetMarcControlnumber &GetMarcNotes &GetMarcISBN + &GetMarcISSN &GetMarcSubjects &GetMarcBiblio &GetMarcAuthors &GetMarcSeries + &GetMarcHosts GetMarcUrls &GetUsedMarcStructure &GetXmlBiblio @@ -90,8 +89,12 @@ BEGIN { &GetMarcFromKohaField &GetFrameworkCode &TransformKohaToMarc + &PrepHostMarcField &CountItemsIssued + &CountBiblioInOrders + &GetSubscriptionsId + &GetHolds ); # To modify something @@ -109,6 +112,7 @@ BEGIN { # To link headings in a bib record # to authority records. push @EXPORT, qw( + &BiblioAutoLink &LinkBibHeadingsToAuthorities ); @@ -126,22 +130,17 @@ BEGIN { &TransformHtmlToMarc2 &TransformHtmlToMarc &TransformHtmlToXml - &PrepareItemrecordDisplay &GetNoZebraIndexes ); } eval { - my $servers = C4::Context->config('memcached_servers'); - if ($servers) { + if (C4::Context->ismemcached) { require Memoize::Memcached; import Memoize::Memcached qw(memoize_memcached); - my $memcached = { - servers => [$servers], - key_prefix => C4::Context->config('memcached_namespace') || 'koha', - }; - memoize_memcached( 'GetMarcStructure', memcached => $memcached, expire_time => 600 ); #cache for 10 minutes + memoize_memcached( 'GetMarcStructure', + memcached => C4::Context->memcached); } }; @@ -315,7 +314,7 @@ sub ModBiblio { SetUTF8Flag($record); my $dbh = C4::Context->dbh; - $frameworkcode = "" unless $frameworkcode; + $frameworkcode = "" if !$frameworkcode || $frameworkcode eq "Default"; # XXX _strip_item_fields($record, $frameworkcode); @@ -384,7 +383,7 @@ sub ModBiblioframework { =head2 DelBiblio - my $error = &DelBiblio($dbh,$biblionumber); + my $error = &DelBiblio($biblionumber); Exported function (core API) for deleting a biblio in koha. Deletes biblio record from Zebra and Koha tables (biblio,biblioitems,items) @@ -412,9 +411,10 @@ sub DelBiblio { return $error if $error; # We delete attached subscriptions - my $subscriptions = &C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber); + require C4::Serials; + my $subscriptions = C4::Serials::GetFullSubscriptionsFromBiblionumber($biblionumber); foreach my $subscription (@$subscriptions) { - &C4::Serials::DelSubscription( $subscription->{subscriptionid} ); + C4::Serials::DelSubscription( $subscription->{subscriptionid} ); } # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio @@ -452,9 +452,42 @@ sub DelBiblio { return; } + +=head2 BiblioAutoLink + + my $headings_linked = BiblioAutoLink($record, $frameworkcode) + +Automatically links headings in a bib record to authorities. + +=cut + +sub BiblioAutoLink { + my $record = shift; + my $frameworkcode = shift; + my ( $num_headings_changed, %results ); + + my $linker_module = + "C4::Linker::" . ( C4::Context->preference("LinkerModule") || 'Default' ); + eval { eval "require $linker_module"; }; + if ($@) { + $linker_module = 'C4::Linker::Default'; + eval "require $linker_module"; + } + if ($@) { + return 0, 0; + } + + my $linker = $linker_module->new( + { 'options' => C4::Context->preference("LinkerOptions") } ); + my ( $headings_changed, undef ) = + LinkBibHeadingsToAuthorities( $linker, $record, $frameworkcode, C4::Context->preference("CatalogModuleRelink") || '' ); + # By default we probably don't want to relink things when cataloging + return $headings_changed; +} + =head2 LinkBibHeadingsToAuthorities - my $headings_linked = LinkBibHeadingsToAuthorities($marc); + my $num_headings_changed, %results = LinkBibHeadingsToAuthorities($linker, $marc, $frameworkcode, [$allowrelink]); Links bib headings to authority records by checking each authority-controlled field in the C @@ -462,9 +495,9 @@ 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. +If $allowrelink is false, existing authids will never be +replaced, regardless of the values of LinkerKeepStale and +LinkerRelink. Returns the number of heading links changed in the MARC record. @@ -472,37 +505,112 @@ MARC record. =cut sub LinkBibHeadingsToAuthorities { - my $bib = shift; + my $linker = shift; + my $bib = shift; + my $frameworkcode = shift; + my $allowrelink = shift; + my %results; + require C4::Heading; + require C4::AuthoritiesMarc; + $allowrelink = 1 unless defined $allowrelink; my $num_headings_changed = 0; foreach my $field ( $bib->fields() ) { - my $heading = C4::Heading->new_from_bib_field($field); + my $heading = C4::Heading->new_from_bib_field( $field, $frameworkcode ); next unless defined $heading; # check existing $9 my $current_link = $field->subfield('9'); - # look for matching authorities - my $authorities = $heading->authorities(); + if ( defined $current_link && (!$allowrelink || !C4::Context->preference('LinkerRelink')) ) + { + $results{'linked'}->{ $heading->display_form() }++; + next; + } - # 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; + my ( $authid, $fuzzy ) = $linker->get_link($heading); + if ($authid) { + $results{ $fuzzy ? 'fuzzy' : 'linked' } + ->{ $heading->display_form() }++; + next if defined $current_link and $current_link == $authid; $field->delete_subfield( code => '9' ) if defined $current_link; $field->add_subfields( '9', $authid ); $num_headings_changed++; - } else { - if ( defined $current_link ) { + } + else { + if ( defined $current_link + && (!$allowrelink || C4::Context->preference('LinkerKeepStale')) ) + { + $results{'fuzzy'}->{ $heading->display_form() }++; + } + elsif ( C4::Context->preference('AutoCreateAuthorities') ) { + my $authtypedata = + C4::AuthoritiesMarc::GetAuthType( $heading->auth_type() ); + my $marcrecordauth = MARC::Record->new(); + if ( C4::Context->preference('marcflavour') eq 'MARC21' ) { + $marcrecordauth->leader(' nz a22 o 4500'); + SetMarcUnicodeFlag( $marcrecordauth, 'MARC21' ); + } + my $authfield = + MARC::Field->new( $authtypedata->{auth_tag_to_report}, + '', '', "a" => "" . $field->subfield('a') ); + map { + $authfield->add_subfields( $_->[0] => $_->[1] ) + if ( $_->[0] =~ /[A-z]/ && $_->[0] ne "a" ) + } $field->subfields(); + $marcrecordauth->insert_fields_ordered($authfield); + +# bug 2317: ensure new authority knows it's using UTF-8; currently +# only need to do this for MARC21, as MARC::Record->as_xml_record() handles +# automatically for UNIMARC (by not transcoding) +# FIXME: AddAuthority() instead should simply explicitly require that the MARC::Record +# use UTF-8, but as of 2008-08-05, did not want to introduce that kind +# of change to a core API just before the 3.0 release. + + if ( C4::Context->preference('marcflavour') eq 'MARC21' ) { + $marcrecordauth->insert_fields_ordered( + MARC::Field->new( + '667', '', '', + 'a' => "Machine generated authority record." + ) + ); + my $cite = + $bib->author() . ", " + . $bib->title_proper() . ", " + . $bib->publication_date() . " "; + $cite =~ s/^[\s\,]*//; + $cite =~ s/[\s\,]*$//; + $cite = + "Work cat.: (" + . C4::Context->preference('MARCOrgCode') . ")" + . $bib->subfield( '999', 'c' ) . ": " + . $cite; + $marcrecordauth->insert_fields_ordered( + MARC::Field->new( '670', '', '', 'a' => $cite ) ); + } + + # warn "AUTH RECORD ADDED : ".$marcrecordauth->as_formatted; + + $authid = + C4::AuthoritiesMarc::AddAuthority( $marcrecordauth, '', + $heading->auth_type() ); + $field->add_subfields( '9', $authid ); + $num_headings_changed++; + $results{'added'}->{ $heading->display_form() }++; + } + elsif ( defined $current_link ) { $field->delete_subfield( code => '9' ); $num_headings_changed++; + $results{'unlinked'}->{ $heading->display_form() }++; + } + else { + $results{'unlinked'}->{ $heading->display_form() }++; } } } - return $num_headings_changed; + return $num_headings_changed, \%results; } =head2 GetRecordValue @@ -1038,9 +1146,12 @@ for the given frameworkcode sub GetMarcFromKohaField { my ( $kohafield, $frameworkcode ) = @_; - return 0, 0 unless $kohafield and defined $frameworkcode; + return (0, undef) unless $kohafield and defined $frameworkcode; my $relations = C4::Context->marcfromkohafield; - return ( $relations->{$frameworkcode}->{$kohafield}->[0], $relations->{$frameworkcode}->{$kohafield}->[1] ); + if ( my $mf = $relations->{$frameworkcode}->{$kohafield} ) { + return @$mf; + } + return (0, undef); } =head2 GetMarcBiblio @@ -1070,9 +1181,9 @@ sub GetMarcBiblio { if ($@) { warn " problem with :$biblionumber : $@ \n$marcxml"; } return unless $record; + C4::Biblio::_koha_marc_update_bib_ids($record, '', $biblionumber, $biblionumber); C4::Biblio::EmbedItemsInMarcBiblio($record, $biblionumber) if ($embeditems); - # $record = MARC::Record::new_from_usmarc( $marc) if $marc; return $record; } else { return undef; @@ -1099,20 +1210,17 @@ sub GetXmlBiblio { =head2 GetCOinSBiblio - my $coins = GetCOinSBiblio($biblionumber); + my $coins = GetCOinSBiblio($record); -Returns the COinS(a span) which can be included in a biblio record +Returns the COinS (a span) which can be included in a biblio record =cut sub GetCOinSBiblio { - my ($biblionumber) = @_; - my $record = GetMarcBiblio($biblionumber); + my $record = shift; # get the coin format if ( ! $record ) { - # can't get a valid MARC::Record object, bail out at this point - warn "We called GetMarcBiblio with a biblionumber that doesn't exist biblionumber=$biblionumber"; return; } my $pos7 = substr $record->leader(), 7, 1; @@ -1180,8 +1288,8 @@ sub GetCOinSBiblio { if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) { # Setting datas - $aulast = $record->subfield( '700', 'a' ); - $aufirst = $record->subfield( '700', 'b' ); + $aulast = $record->subfield( '700', 'a' ) || ''; + $aufirst = $record->subfield( '700', 'b' ) || ''; $oauthors = "&rft.au=$aufirst $aulast"; # others authors @@ -1194,10 +1302,10 @@ sub GetCOinSBiblio { ( $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' ); + $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 @@ -1217,7 +1325,8 @@ sub GetCOinSBiblio { $subtitle = $record->subfield( '245', 'b' ) || ''; $title .= $subtitle; if ($titletype eq 'a') { - $pubyear = substr $record->field('008')->data(), 7, 4; + $pubyear = $record->field('008') || ''; + $pubyear = substr($pubyear->data(), 7, 4) if $pubyear; $isbn = $record->subfield( '773', 'z' ) || ''; $issn = $record->subfield( '773', 'x' ) || ''; if ($mtx eq 'journal') { @@ -1375,9 +1484,9 @@ Get the control number / record Identifier from the MARC record and return it. sub GetMarcControlnumber { my ( $record, $marcflavour ) = @_; my $controlnumber = ""; - # Control number or Record identifier are the same field in MARC21 and UNIMARC + # Control number or Record identifier are the same field in MARC21, UNIMARC and NORMARC # Keep $marcflavour for possible later use - if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC") { + if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC" || $marcflavour eq "NORMARC") { my $controlnumberField = $record->field('001'); if ($controlnumberField) { $controlnumber = $controlnumberField->data(); @@ -1391,7 +1500,7 @@ sub GetMarcControlnumber { $marcisbnsarray = GetMarcISBN( $record, $marcflavour ); Get all ISBNs from the MARC record and returns them in an array. -ISBNs stored in differents places depending on MARC flavour +ISBNs stored in different fields depending on MARC flavour =cut @@ -1426,12 +1535,38 @@ sub GetMarcISBN { return \@marcisbns; } # end GetMarcISBN + +=head2 GetMarcISSN + + $marcissnsarray = GetMarcISSN( $record, $marcflavour ); + +Get all valid ISSNs from the MARC record and returns them in an array. +ISSNs are stored in different fields depending on MARC flavour + +=cut + +sub GetMarcISSN { + my ( $record, $marcflavour ) = @_; + my $scope; + if ( $marcflavour eq "UNIMARC" ) { + $scope = '011'; + } + else { # assume MARC21 or NORMARC + $scope = '022'; + } + my @marcissns; + foreach my $field ( $record->field($scope) ) { + push @marcissns, $field->subfield( 'a' ); + } + return \@marcissns; +} # end GetMarcISSN + =head2 GetMarcNotes $marcnotesarray = GetMarcNotes( $record, $marcflavour ); Get all notes from the MARC record and returns them in an array. -The note are stored in differents places depending on MARC flavour +The note are stored in different fields depending on MARC flavour =cut @@ -1471,7 +1606,7 @@ sub GetMarcNotes { $marcsubjcts = GetMarcSubjects($record,$marcflavour); Get all subjects from the MARC record and returns them in an array. -The subjects are stored in differents places depending on MARC flavour +The subjects are stored in different fields depending on MARC flavour =cut @@ -1546,7 +1681,7 @@ sub GetMarcSubjects { authors = GetMarcAuthors($record,$marcflavour); Get all authors from the MARC record and returns them in an array. -The authors are stored in differents places depending on MARC flavour +The authors are stored in different fields depending on MARC flavour =cut @@ -1609,7 +1744,8 @@ sub GetMarcAuthors { $separator = C4::Context->preference('authoritysep'); } push @subfields_loop, - { code => $subfieldcode, + { tag => $field->tag(), + code => $subfieldcode, value => $value, link_loop => \@this_link_loop, separator => $separator @@ -1682,7 +1818,7 @@ sub GetMarcUrls { $marcseriesarray = GetMarcSeries($record,$marcflavour); Get all series from the MARC record and returns them in an array. -The series are stored in differents places depending on MARC flavour +The series are stored in different fields depending on MARC flavour =cut @@ -1760,6 +1896,48 @@ sub GetMarcSeries { return $marcseriessarray; } #end getMARCseriess +=head2 GetMarcHosts + + $marchostsarray = GetMarcHosts($record,$marcflavour); + +Get all host records (773s MARC21, 461 UNIMARC) from the MARC record and returns them in an array. + +=cut + +sub GetMarcHosts { + my ( $record, $marcflavour ) = @_; + my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf); + $marcflavour ||="MARC21"; + if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) { + $tag = "773"; + $title_subf = "t"; + $bibnumber_subf ="0"; + $itemnumber_subf='9'; + } + elsif ($marcflavour eq "UNIMARC") { + $tag = "461"; + $title_subf = "t"; + $bibnumber_subf ="0"; + $itemnumber_subf='9'; + }; + + my @marchosts; + + foreach my $field ( $record->field($tag)) { + + my @fields_loop; + + my $hostbiblionumber = $field->subfield("$bibnumber_subf"); + my $hosttitle = $field->subfield($title_subf); + my $hostitemnumber=$field->subfield($itemnumber_subf); + push @fields_loop, { hostbiblionumber => $hostbiblionumber, hosttitle => $hosttitle, hostitemnumber => $hostitemnumber}; + push @marchosts, { MARCHOSTS_FIELDS_LOOP => \@fields_loop }; + + } + my $marchostsarray = \@marchosts; + return $marchostsarray; +} + =head2 GetFrameworkCode $frameworkcode = GetFrameworkCode( $biblionumber ) @@ -1782,54 +1960,112 @@ sub GetFrameworkCode { This function builds partial MARC::Record from a hash Hash entries can be from biblio or biblioitems. -This function is called in acquisition module, to create a basic catalogue entry from user entry +This function is called in acquisition module, to create a basic catalogue +entry from user entry =cut + sub TransformKohaToMarc { - my ($hash) = @_; - my $sth = C4::Context->dbh->prepare( "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?" ); + my $hash = shift; my $record = MARC::Record->new(); SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") ); - foreach ( keys %{$hash} ) { - &TransformKohaToMarcOneField( $sth, $record, $_, $hash->{$_}, '' ); + my $db_to_marc = C4::Context->marcfromkohafield; + while ( my ($name, $value) = each %$hash ) { + next unless my $dtm = $db_to_marc->{''}->{$name}; + my ($tag, $letter) = @$dtm; + foreach my $value ( split(/\s?\|\s?/, $value, -1) ) { + if ( my $field = $record->field($tag) ) { + $field->add_subfields( $letter => $value ); + } + else { + $record->insert_fields_ordered( MARC::Field->new( + $tag, " ", " ", $letter => $value ) ); + } + } + } return $record; } -=head2 TransformKohaToMarcOneField +=head2 PrepHostMarcField - $record = TransformKohaToMarcOneField( $sth, $record, $kohafieldname, $value, $frameworkcode ); + $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour ) -=cut +This function returns a host field populated with data from the host record, the field can then be added to an analytical record -sub TransformKohaToMarcOneField { - my ( $sth, $record, $kohafieldname, $value, $frameworkcode ) = @_; - $frameworkcode = '' unless $frameworkcode; - my $tagfield; - my $tagsubfield; +=cut - if ( !defined $sth ) { - my $dbh = C4::Context->dbh; - $sth = $dbh->prepare( "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?" ); - } - $sth->execute( $frameworkcode, $kohafieldname ); - if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) { - my @values = split(/\s?\|\s?/, $value, -1); - - foreach my $itemvalue (@values){ - my $tag = $record->field($tagfield); - if ($tag) { - $tag->add_subfields( $tagsubfield => $itemvalue ); - $record->delete_field($tag); - $record->insert_fields_ordered($tag); - } - else { - $record->add_fields( $tagfield, " ", " ", $tagsubfield => $itemvalue ); +sub PrepHostMarcField { + my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_; + $marcflavour ||="MARC21"; + + require C4::Items; + my $hostrecord = GetMarcBiblio($hostbiblionumber); + my $item = C4::Items::GetItem($hostitemnumber); + + my $hostmarcfield; + if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) { + + #main entry + my $mainentry; + if ($hostrecord->subfield('100','a')){ + $mainentry = $hostrecord->subfield('100','a'); + } elsif ($hostrecord->subfield('110','a')){ + $mainentry = $hostrecord->subfield('110','a'); + } else { + $mainentry = $hostrecord->subfield('111','a'); + } + + # qualification info + my $qualinfo; + if (my $field260 = $hostrecord->field('260')){ + $qualinfo = $field260->as_string( 'abc' ); + } + + + #other fields + my $ed = $hostrecord->subfield('250','a'); + my $barcode = $item->{'barcode'}; + my $title = $hostrecord->subfield('245','a'); + + # record control number, 001 with 003 and prefix + my $recctrlno; + if ($hostrecord->field('001')){ + $recctrlno = $hostrecord->field('001')->data(); + if ($hostrecord->field('003')){ + $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno; } } - } - return $record; + + # issn/isbn + my $issn = $hostrecord->subfield('022','a'); + my $isbn = $hostrecord->subfield('020','a'); + + + $hostmarcfield = MARC::Field->new( + 773, '0', '', + '0' => $hostbiblionumber, + '9' => $hostitemnumber, + 'a' => $mainentry, + 'b' => $ed, + 'd' => $qualinfo, + 'o' => $barcode, + 't' => $title, + 'w' => $recctrlno, + 'x' => $issn, + 'z' => $isbn + ); + } elsif ($marcflavour eq "UNIMARC") { + $hostmarcfield = MARC::Field->new( + 461, '', '', + '0' => $hostbiblionumber, + 't' => $hostrecord->subfield('200','a'), + '9' => $hostitemnumber + ); + }; + + return $hostmarcfield; } =head2 TransformHtmlToXml @@ -1952,7 +2188,7 @@ sub TransformHtmlToXml { } $prevtag = @$tags[$i]; } - $xml .= "\n" if @$tags > 0; + $xml .= "\n" if $xml =~ m/preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) { # warn "SETTING 100 for $auth_type"; @@ -1989,8 +2225,8 @@ sub _default_ind_to_space { =head2 TransformHtmlToMarc - L<$record> = TransformHtmlToMarc(L<$params>,L<$cgi>) - L<$params> is a ref to an array as below: + L<$record> = TransformHtmlToMarc(L<$cgi>) + L<$cgi> is the CGI object which containts the values for subfields { 'tag_010_indicator1_531951' , 'tag_010_indicator2_531951' , @@ -2007,15 +2243,15 @@ sub _default_ind_to_space { 'tag_200_code_f_873510_110730' , 'tag_200_subfield_f_873510_110730' , } - L<$cgi> is the CGI object which containts the value. L<$record> is the MARC::Record object. =cut sub TransformHtmlToMarc { - my $params = shift; my $cgi = shift; + my @params = $cgi->param(); + # explicitly turn on the UTF-8 flag for all # 'tag_' parameters to avoid incorrect character # conversion later on @@ -2035,8 +2271,9 @@ sub TransformHtmlToMarc { my $record = MARC::Record->new(); my $i = 0; my @fields; - while ( $params->[$i] ) { # browse all CGI params - my $param = $params->[$i]; +#FIXME This code assumes that the CGI params will be in the same order as the fields in the template; this is no absolute guarantee! + while ( $params[$i] ) { # browse all CGI params + my $param = $params[$i]; my $newfield = 0; # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields) @@ -2052,7 +2289,7 @@ sub TransformHtmlToMarc { my $tag = $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 ) ); + my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) ); $newfield = 0; my $j = $i + 2; @@ -2062,31 +2299,35 @@ sub TransformHtmlToMarc { # Force a fake leader even if not provided to avoid crashing # during decoding MARC record containing UTF-8 characters $record->leader( - length( $cgi->param($params->[$j+1]) ) == 24 - ? $cgi->param( $params->[ $j + 1 ] ) + length( $cgi->param($params[$j+1]) ) == 24 + ? $cgi->param( $params[ $j + 1 ] ) : ' nam a22 4500' ) ; # between 001 and 009 (included) - } elsif ( $cgi->param( $params->[ $j + 1 ] ) ne '' ) { - $newfield = MARC::Field->new( $tag, $cgi->param( $params->[ $j + 1 ] ), ); + } elsif ( $cgi->param( $params[ $j + 1 ] ) ne '' ) { + $newfield = MARC::Field->new( $tag, $cgi->param( $params[ $j + 1 ] ), ); } # > 009, deal with subfields } else { - 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 ] ) 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 ] ) ne '' ) { # creating only if there is a value (code => value) - $newfield = MARC::Field->new( $tag, $ind1, $ind2, $cgi->param($inner_param) => $cgi->param( $params->[ $j + 1 ] ), ); - } + # browse subfields for this tag (reason for _code_ match) + while(defined $params[$j] && $params[$j] =~ /_code_/) { + last unless defined $params[$j+1]; + #if next param ne subfield, then it was probably empty + #try next param by incrementing j + if($params[$j+1]!~/_subfield_/) {$j++; next; } + my $fval= $cgi->param($params[$j+1]); + #check if subfield value not empty and field exists + if($fval ne '' && $newfield) { + $newfield->add_subfields( $cgi->param($params[$j]) => $fval); + } + elsif($fval ne '') { + $newfield = MARC::Field->new( $tag, $ind1, $ind2, $cgi->param($params[$j]) => $fval ); } $j += 2; - } + } #end-of-while + $i= $j-1; #update i for outer loop accordingly } push @fields, $newfield if ($newfield); } @@ -2338,232 +2579,6 @@ sub TransformMarcToKohaOneField { return $result; } -=head1 OTHER FUNCTIONS - - -=head2 PrepareItemrecordDisplay - - PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber,$frameworkcode); - -Returns a hash with all the fields for Display a given item data in a template - -The $frameworkcode returns the item for the given frameworkcode, ONLY if bibnum is not provided - -=cut - -sub PrepareItemrecordDisplay { - - my ( $bibnum, $itemnum, $defaultvalues, $frameworkcode ) = @_; - - my $dbh = C4::Context->dbh; - $frameworkcode = &GetFrameworkCode($bibnum) if $bibnum; - my ( $itemtagfield, $itemtagsubfield ) = &GetMarcFromKohaField( "items.itemnumber", $frameworkcode ); - my $tagslib = &GetMarcStructure( 1, $frameworkcode ); - - # return nothing if we don't have found an existing framework. - return q{} unless $tagslib; - my $itemrecord; - if ($itemnum) { - $itemrecord = C4::Items::GetMarcItem( $bibnum, $itemnum ); - } - my @loop_data; - my $authorised_values_sth = $dbh->prepare( "SELECT authorised_value,lib FROM authorised_values WHERE category=? ORDER BY lib" ); - foreach my $tag ( sort keys %{$tagslib} ) { - my $previous_tag = ''; - if ( $tag ne '' ) { - - # loop through each subfield - my $cntsubf; - foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) { - next if ( subfield_is_koha_internal_p($subfield) ); - next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" ); - my %subfield_data; - $subfield_data{tag} = $tag; - $subfield_data{subfield} = $subfield; - $subfield_data{countsubfield} = $cntsubf++; - $subfield_data{kohafield} = $tagslib->{$tag}->{$subfield}->{'kohafield'}; - - # $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib}; - $subfield_data{marc_lib} = $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, $defaultvalue ); - if ($itemrecord) { - ( $x, $defaultvalue ) = _find_value( $tag, $subfield, $itemrecord ); - } - $defaultvalue = $tagslib->{$tag}->{$subfield}->{defaultvalue} unless $defaultvalue; - if ( !defined $defaultvalue ) { - $defaultvalue = q||; - } - $defaultvalue =~ s/"/"/g; - - # search for itemcallnumber if applicable - if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.itemcallnumber' - && C4::Context->preference('itemcallnumber') ) { - my $CNtag = substr( C4::Context->preference('itemcallnumber'), 0, 3 ); - my $CNsubfield = substr( C4::Context->preference('itemcallnumber'), 3, 1 ); - if ($itemrecord) { - my $temp = $itemrecord->field($CNtag); - if ($temp) { - $defaultvalue = $temp->subfield($CNsubfield); - } - } - } - if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.itemcallnumber' - && $defaultvalues - && $defaultvalues->{'callnumber'} ) { - my $temp; - if ($itemrecord) { - $temp = $itemrecord->field($subfield); - } - unless ($temp) { - $defaultvalue = $defaultvalues->{'callnumber'} if $defaultvalues; - } - } - if ( ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.holdingbranch' || $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.homebranch' ) - && $defaultvalues - && $defaultvalues->{'branchcode'} ) { - my $temp; - if ($itemrecord) { - $temp = $itemrecord->field($subfield); - } - unless ($temp) { - $defaultvalue = $defaultvalues->{branchcode} if $defaultvalues; - } - } - if ( ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.location' ) - && $defaultvalues - && $defaultvalues->{'location'} ) { - my $temp = $itemrecord->field($subfield) if ($itemrecord); - unless ($temp) { - $defaultvalue = $defaultvalues->{location} if $defaultvalues; - } - } - if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) { - my @authorised_values; - my %authorised_lib; - - # builds list, depending on authorised value... - #---- branch - if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) { - if ( ( C4::Context->preference("IndependantBranches") ) - && ( C4::Context->userenv->{flags} % 2 != 1 ) ) { - my $sth = $dbh->prepare( "SELECT branchcode,branchname FROM branches WHERE branchcode = ? ORDER BY branchname" ); - $sth->execute( C4::Context->userenv->{branch} ); - push @authorised_values, "" - unless ( $tagslib->{$tag}->{$subfield}->{mandatory} ); - while ( my ( $branchcode, $branchname ) = $sth->fetchrow_array ) { - push @authorised_values, $branchcode; - $authorised_lib{$branchcode} = $branchname; - } - } else { - my $sth = $dbh->prepare( "SELECT branchcode,branchname FROM branches ORDER BY branchname" ); - $sth->execute; - push @authorised_values, "" - unless ( $tagslib->{$tag}->{$subfield}->{mandatory} ); - while ( my ( $branchcode, $branchname ) = $sth->fetchrow_array ) { - push @authorised_values, $branchcode; - $authorised_lib{$branchcode} = $branchname; - } - } - - #----- itemtypes - } elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq "itemtypes" ) { - my $sth = $dbh->prepare( "SELECT itemtype,description FROM itemtypes ORDER BY description" ); - $sth->execute; - push @authorised_values, "" - unless ( $tagslib->{$tag}->{$subfield}->{mandatory} ); - while ( my ( $itemtype, $description ) = $sth->fetchrow_array ) { - push @authorised_values, $itemtype; - $authorised_lib{$itemtype} = $description; - } - #---- class_sources - } elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq "cn_source" ) { - push @authorised_values, "" unless ( $tagslib->{$tag}->{$subfield}->{mandatory} ); - - my $class_sources = GetClassSources(); - my $default_source = C4::Context->preference("DefaultClassificationSource"); - - foreach my $class_source (sort keys %$class_sources) { - next unless $class_sources->{$class_source}->{'used'} or - ($class_source eq $default_source); - push @authorised_values, $class_source; - $authorised_lib{$class_source} = $class_sources->{$class_source}->{'description'}; - } - - #---- "true" authorised value - } else { - $authorised_values_sth->execute( $tagslib->{$tag}->{$subfield}->{authorised_value} ); - push @authorised_values, "" - unless ( $tagslib->{$tag}->{$subfield}->{mandatory} ); - while ( my ( $value, $lib ) = $authorised_values_sth->fetchrow_array ) { - push @authorised_values, $value; - $authorised_lib{$value} = $lib; - } - } - $subfield_data{marc_value} = CGI::scrolling_list( - -name => 'field_value', - -values => \@authorised_values, - -default => "$defaultvalue", - -labels => \%authorised_lib, - -size => 1, - -tabindex => '', - -multiple => 0, - ); - } elsif ( $tagslib->{$tag}->{$subfield}->{value_builder} ) { - # opening plugin - my $plugin = C4::Context->intranetdir . "/cataloguing/value_builder/" . $tagslib->{$tag}->{$subfield}->{'value_builder'}; - if (do $plugin) { - my $temp; - my $extended_param = plugin_parameters( $dbh, $temp, $tagslib, $subfield_data{id}, undef ); - my ( $function_name, $javascript ) = plugin_javascript( $dbh, $temp, $tagslib, $subfield_data{id}, undef ); - $subfield_data{random} = int(rand(1000000)); # why do we need 2 different randoms? - my $index_subfield = int(rand(1000000)); - $subfield_data{id} = "tag_".$tag."_subfield_".$subfield."_".$index_subfield; - $subfield_data{marc_value} = qq[ - ... - $javascript]; - } else { - warn "Plugin Failed: $plugin"; - $subfield_data{marc_value} = qq(); # supply default input form - } - } - elsif ( $tag eq '' ) { # it's an hidden field - $subfield_data{marc_value} = qq(); - } - elsif ( $tagslib->{$tag}->{$subfield}->{'hidden'} ) { # FIXME: shouldn't input type be "hidden" ? - $subfield_data{marc_value} = qq(); - } - elsif ( length($defaultvalue) > 100 - or (C4::Context->preference("marcflavour") eq "UNIMARC" and - 300 <= $tag && $tag < 400 && $subfield eq 'a' ) - or (C4::Context->preference("marcflavour") eq "MARC21" and - 500 <= $tag && $tag < 600 ) - ) { - # oversize field (textarea) - $subfield_data{marc_value} = qq(\n"); - } else { - $subfield_data{marc_value} = ""; - } - push( @loop_data, \%subfield_data ); - } - } - } - my $itemnumber; - if ( $itemrecord && $itemrecord->field($itemtagfield) ) { - $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield ); - } - return { - 'itemtagfield' => $itemtagfield, - 'itemtagsubfield' => $itemtagsubfield, - 'itemnumber' => $itemnumber, - 'iteminformation' => \@loop_data - }; -} #" @@ -2727,10 +2742,11 @@ sub EmbedItemsInMarcBiblio { my @item_fields; my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode ); while (my ($itemnumber) = $sth->fetchrow_array) { + require C4::Items; my $item_marc = C4::Items::GetMarcItem($biblionumber, $itemnumber); push @item_fields, $item_marc->field($itemtag); } - $marc->insert_fields_ordered(@item_fields); + $marc->append_fields(@item_fields); } =head1 INTERNAL FUNCTIONS @@ -2997,45 +3013,6 @@ sub _AddBiblioNoZebra { return %result; } -=head2 _find_value - - ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding); - -Find the given $subfield in the given $tag in the given -MARC::Record $record. If the subfield is found, returns -the (indicators, value) pair; otherwise, (undef, undef) is -returned. - -PROPOSITION : -Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities. -I suggest we export it from this module. - -=cut - -sub _find_value { - my ( $tagfield, $insubfield, $record, $encoding ) = @_; - my @result; - my $indicator; - if ( $tagfield < 10 ) { - if ( $record->field($tagfield) ) { - push @result, $record->field($tagfield)->data(); - } else { - push @result, ""; - } - } else { - foreach my $field ( $record->field($tagfield) ) { - my @subfields = $field->subfields(); - foreach my $subfield (@subfields) { - if ( @$subfield[0] eq $insubfield ) { - push @result, @$subfield[1]; - $indicator = $field->indicator(1) . $field->indicator(2); - } - } - } - } - return ( $indicator, @result ); -} - =head2 _koha_marc_update_bib_ids @@ -3054,9 +3031,24 @@ sub _koha_marc_update_bib_ids { # we drop the original field # we add the new builded field. my ( $biblio_tag, $biblio_subfield ) = GetMarcFromKohaField( "biblio.biblionumber", $frameworkcode ); + die qq{No biblionumber tag for framework "$frameworkcode"} unless $biblio_tag; my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode ); + die qq{No biblioitemnumber tag for framework "$frameworkcode"} unless $biblio_tag; + + if ( $biblio_tag == $biblioitem_tag ) { + + # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value) + my $new_field = MARC::Field->new( + $biblio_tag, '', '', + "$biblio_subfield" => $biblionumber, + "$biblioitem_subfield" => $biblioitemnumber + ); - if ( $biblio_tag != $biblioitem_tag ) { + # drop old field and create new one... + my $old_field = $record->field($biblio_tag); + $record->delete_field($old_field) if $old_field; + $record->insert_fields_ordered($new_field); + } else { # biblionumber & biblioitemnumber are in different fields @@ -3071,7 +3063,7 @@ sub _koha_marc_update_bib_ids { # drop old field and create new one... $old_field = $record->field($biblio_tag); $record->delete_field($old_field) if $old_field; - $record->append_fields($new_field); + $record->insert_fields_ordered($new_field); # deal with biblioitemnumber if ( $biblioitem_tag < 10 ) { @@ -3084,20 +3076,6 @@ sub _koha_marc_update_bib_ids { $old_field = $record->field($biblioitem_tag); $record->delete_field($old_field) if $old_field; $record->insert_fields_ordered($new_field); - - } else { - - # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value) - my $new_field = MARC::Field->new( - $biblio_tag, '', '', - "$biblio_subfield" => $biblionumber, - "$biblioitem_subfield" => $biblioitemnumber - ); - - # drop old field and create new one... - my $old_field = $record->field($biblio_tag); - $record->delete_field($old_field) if $old_field; - $record->insert_fields_ordered($new_field); } } @@ -3394,9 +3372,12 @@ sub _koha_delete_biblio { $bkup_sth->finish; # delete the biblio - my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?"); - $del_sth->execute($biblionumber); - $del_sth->finish; + my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?"); + $sth2->execute($biblionumber); + # update the timestamp (Bugzilla 7146) + $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?"); + $sth2->execute($biblionumber); + $sth2->finish; } $sth->finish; return undef; @@ -3440,9 +3421,12 @@ sub _koha_delete_biblioitems { $bkup_sth->finish; # delete the biblioitem - my $del_sth = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?"); - $del_sth->execute($biblioitemnumber); - $del_sth->finish; + my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?"); + $sth2->execute($biblioitemnumber); + # update the timestamp (Bugzilla 7146) + $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?"); + $sth2->execute($biblioitemnumber); + $sth2->finish; } $sth->finish; return undef; @@ -3487,7 +3471,7 @@ sub ModBiblioMarc { } substr( $string, 22, 6, "frey50" ); unless ( $record->subfield( 100, "a" ) ) { - $record->insert_grouped_field( MARC::Field->new( 100, "", "", "a" => $string ) ); + $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) ); } } @@ -3513,112 +3497,6 @@ sub ModBiblioMarc { return $biblionumber; } -=head2 z3950_extended_services - - z3950_extended_services($serviceType,$serviceOptions,$record); - -z3950_extended_services is used to handle all interactions with Zebra's extended serices package, which is employed to perform all management of the MARC data stored in Zebra. - -C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate - -C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain: - - action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate. - -and maybe - - recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number). - syntax => the record syntax (transfer syntax) - databaseName = Database from connection object - -To set serviceOptions, call set_service_options($serviceType) - -C<$record> the record, if one is needed for the service type - -A record should be in XML. You can convert it to XML from MARC by running it through marc2xml(). - -=cut - -sub z3950_extended_services { - my ( $server, $serviceType, $action, $serviceOptions ) = @_; - - # get our connection object - my $Zconn = C4::Context->Zconn( $server, 0, 1 ); - - # create a new package object - my $Zpackage = $Zconn->package(); - - # set our options - $Zpackage->option( action => $action ); - - if ( $serviceOptions->{'databaseName'} ) { - $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} ); - } - if ( $serviceOptions->{'recordIdNumber'} ) { - $Zpackage->option( recordIdNumber => $serviceOptions->{'recordIdNumber'} ); - } - if ( $serviceOptions->{'recordIdOpaque'} ) { - $Zpackage->option( recordIdOpaque => $serviceOptions->{'recordIdOpaque'} ); - } - - # this is an ILL request (Zebra doesn't support it, but Koha could eventually) - #if ($serviceType eq 'itemorder') { - # $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'}); - # $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'}); - # $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'}); - # $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'}); - #} - - if ( $serviceOptions->{record} ) { - $Zpackage->option( record => $serviceOptions->{record} ); - - # can be xml or marc - if ( $serviceOptions->{'syntax'} ) { - $Zpackage->option( syntax => $serviceOptions->{'syntax'} ); - } - } - - # send the request, handle any exception encountered - eval { $Zpackage->send($serviceType) }; - if ( $@ && $@->isa("ZOOM::Exception") ) { - return "error: " . $@->code() . " " . $@->message() . "\n"; - } - - # free up package resources - $Zpackage->destroy(); -} - -=head2 set_service_options - - my $serviceOptions = set_service_options($serviceType); - -C<$serviceType> itemorder,create,drop,commit,update,xmlupdate - -Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it. - -=cut - -sub set_service_options { - my ($serviceType) = @_; - my $serviceOptions; - - # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change - # $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml - - if ( $serviceType eq 'commit' ) { - - # nothing to do - } - if ( $serviceType eq 'create' ) { - - # nothing to do - } - if ( $serviceType eq 'drop' ) { - die "ERROR: 'drop' not currently supported (by Zebra)"; - } - return $serviceOptions; -} - =head2 get_biblio_authorised_values find the types and values for all authorised values assigned to this biblio. @@ -3681,6 +3559,76 @@ sub get_biblio_authorised_values { return $authorised_values; } +=head2 CountBiblioInOrders + +=over 4 +$count = &CountBiblioInOrders( $biblionumber); + +=back + +This function return count of biblios in orders with $biblionumber + +=cut + +sub CountBiblioInOrders { + my ($biblionumber) = @_; + my $dbh = C4::Context->dbh; + my $query = "SELECT count(*) + FROM aqorders + WHERE biblionumber=? AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')"; + my $sth = $dbh->prepare($query); + $sth->execute($biblionumber); + my $count = $sth->fetchrow; + return ($count); +} + +=head2 GetSubscriptionsId + +=over 4 +$subscriptions = &GetSubscriptionsId($biblionumber); + +=back + +This function return an array of subscriptionid with $biblionumber + +=cut + +sub GetSubscriptionsId { + my ($biblionumber) = @_; + my $dbh = C4::Context->dbh; + my $query = "SELECT subscriptionid + FROM subscription + WHERE biblionumber=?"; + my $sth = $dbh->prepare($query); + $sth->execute($biblionumber); + my @subscriptions = $sth->fetchrow_array; + return (@subscriptions); +} + +=head2 GetHolds + +=over 4 +$holds = &GetHolds($biblionumber); + +=back + +This function return the count of holds with $biblionumber + +=cut + +sub GetHolds { + my ($biblionumber) = @_; + my $dbh = C4::Context->dbh; + my $query = "SELECT count(*) + FROM reserves + WHERE biblionumber=?"; + my $sth = $dbh->prepare($query); + $sth->execute($biblionumber); + my $holds = $sth->fetchrow; + return ($holds); +} + + 1; __END__