use C4::Log; # logaction
use C4::ClassSource;
use C4::Charset;
+use C4::Linker;
+use C4::OAI::Sets;
use vars qw($VERSION @ISA @EXPORT);
&GetMarcControlnumber
&GetMarcNotes
&GetMarcISBN
+ &GetMarcISSN
&GetMarcSubjects
&GetMarcBiblio
&GetMarcAuthors
# To link headings in a bib record
# to authority records.
push @EXPORT, qw(
+ &BiblioAutoLink
&LinkBibHeadingsToAuthorities
);
&TransformHtmlToMarc
&TransformHtmlToXml
&GetNoZebraIndexes
+ prepare_host_field
);
}
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',
- expire_time => 600
- }; # cache for 10 mins, if you want to cache for different make a different memcached hash
- memoize_memcached( 'GetMarcStructure', memcached => $memcached );
+ memoize_memcached( 'GetMarcStructure',
+ memcached => C4::Context->memcached);
}
};
# now add the record
ModBiblioMarc( $record, $biblionumber, $frameworkcode ) unless $defer_marc_save;
+ # update OAI-PMH sets
+ if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
+ C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
+ }
+
logaction( "CATALOGUING", "ADD", $biblionumber, "biblio" ) if C4::Context->preference("CataloguingLog");
return ( $biblionumber, $biblioitemnumber );
}
# modify the other koha tables
_koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
_koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
+
+ # update OAI-PMH sets
+ if(C4::Context->preference("OAI-PMH:AutoUpdateSets")) {
+ C4::OAI::Sets::UpdateOAISetsBiblio($biblionumber, $record);
+ }
+
return 1;
}
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<MARC::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.
=cut
sub LinkBibHeadingsToAuthorities {
+ my $linker = shift;
+ my $bib = shift;
+ my $frameworkcode = shift;
+ my $allowrelink = shift;
+ my %results;
require C4::Heading;
- my $bib = shift;
+ 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
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();
$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
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
$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
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
$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
my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
$marcflavour ||="MARC21";
+ require C4::Items;
my $hostrecord = GetMarcBiblio($hostbiblionumber);
my $item = C4::Items::GetItem($hostitemnumber);
my $record = MARC::Record->new();
my $i = 0;
my @fields;
+#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;
# > 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);
}
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
return ($holds);
}
+=head2 prepare_host_field
+
+$marcfield = prepare_host_field( $hostbiblioitem, $marcflavour );
+Generate the host item entry for an analytic child entry
+
+=cut
+
+sub prepare_host_field {
+ my ( $hostbiblio, $marcflavour ) = @_;
+ $marcflavour ||= 'MARC21';
+ my $host = GetMarcBiblio($hostbiblio);
+ if ( $marcflavour eq 'MARC21' ) {
+
+ # unfortunately as_string does not 'do the right thing'
+ # if field returns undef
+ my %sfd;
+ my $field;
+ if ( $field = $host->author() ) {
+ $sfd{a} = $field;
+ }
+ if ( $field = $host->title() ) {
+ $sfd{t} = $field;
+ }
+ if ( $field = $host->field('260') ) {
+ my $s = $field->as_string('abc');
+ if ($s) {
+ $sfd{d} = $s;
+ }
+ }
+ if ( $field = $host->field('240') ) {
+ my $s = $field->as_string();
+ if ($s) {
+ $sfd{b} = $s;
+ }
+ }
+ if ( $field = $host->field('022') ) {
+ my $s = $field->as_string('a');
+ if ($s) {
+ $sfd{x} = $s;
+ }
+ }
+ if ( $field = $host->field('020') ) {
+ my $s = $field->as_string('a');
+ if ($s) {
+ $sfd{x} = $s;
+ }
+ }
+ if ( $field = $host->field('001') ) {
+ $sfd{w} = $field->data(),;
+ }
+ my $host_field = MARC::Field->new( 773, '0', ' ', %sfd );
+ return $host_field;
+ }
+ return;
+}
1;
+
__END__
=head1 AUTHOR
projects / koha.git / blobdiff