bugfixes on unimarc 100 handling (the field used for encoding)

This commit is contained in:
tipaul 2007-06-25 15:01:45 +00:00
parent 3426caa6d6
commit 014350b476
4 changed files with 46 additions and 36 deletions

View file

@ -227,7 +227,7 @@ sub SearchAuthorities {
}elsif (@$operator[$i] eq "start"){
$attr.=" \@attr 4=1 \@attr 5=1 ";#Phrase, Right truncated
} else {
$attr .=" \@attr 5=1 ";## Word list, right truncated, anywhere
$attr .=" \@attr 5=1 \@attr 4=6 ";## Word list, right truncated, anywhere
}
$and .=" \@and " ;
$attr =$attr."\"".@$value[$i]."\"";
@ -503,7 +503,7 @@ sub AddAuthority {
# warn $record->as_formatted;
$dbh->do("lock tables auth_header WRITE");
$sth=$dbh->prepare("insert into auth_header (authid,datecreated,authtypecode,marc,marcxml) values (?,now(),?,?,?)");
$sth->execute($authid,$authtypecode,$record->as_usmarc,$record->as_xml);
$sth->execute($authid,$authtypecode,$record->as_usmarc,$record->as_xml_record);
$sth->finish;
}else{
$record->add_fields('001',$authid) unless ($record->field('001'));
@ -511,7 +511,7 @@ sub AddAuthority {
$record->add_fields('152','','','b'=>$authtypecode) unless ($record->field('152'));
$dbh->do("lock tables auth_header WRITE");
my $sth=$dbh->prepare("update auth_header set marc=?,marcxml=? where authid=?");
$sth->execute($record->as_usmarc,$record->as_xml,$authid);
$sth->execute($record->as_usmarc,$record->as_xml_record,$authid);
$sth->finish;
}
$dbh->do("unlock tables");
@ -544,15 +544,14 @@ sub DelAuthority {
sub ModAuthority {
my ($authid,$record,$authtypecode,$merge)=@_;
my $dbh=C4::Context->dbh;
my ($oldrecord)=&GetAuthority($authid);
if ($oldrecord eq $record) {
return;
}
my $sth=$dbh->prepare("update auth_header set marc=? where authid=?");
# my ($oldrecord)=&GetAuthority($authid);
# if ($oldrecord eq $record) {
# return;
# }
# my $sth=$dbh->prepare("update auth_header set marc=?,marcxml=? where authid=?");
#Now rewrite the $record to table with an add
$authid=AddAuthority($record,$authid,$authtypecode);
### If a library thinks that updating all biblios is a long process and wishes to leave that to a cron job to use merge_authotities.p
### they should have a system preference "dontmerge=1" otherwise by default biblios will be updated
### the $merge flag is now depreceated and will be removed at code cleaning
@ -568,7 +567,7 @@ sub ModAuthority {
print AUTH $authid;
close AUTH;
} else {
&merge($authid,$record,$authid,$record);
# &merge($authid,$record,$authid,$record);
}
return $authid;
}
@ -588,11 +587,9 @@ sub GetAuthorityXML {
my ( $authid ) = @_;
my $dbh=C4::Context->dbh;
my $sth =
$dbh->prepare("select marc from auth_header where authid=? " );
$dbh->prepare("select marcxml from auth_header where authid=? " );
$sth->execute($authid);
my ($marc)=$sth->fetchrow;
$marc=MARC::File::USMARC::decode($marc);
my $marcxml=$marc->as_xml_record();
my ($marcxml)=$sth->fetchrow;
return $marcxml;
}
@ -608,13 +605,14 @@ Returns MARC::Record of the authority passed in parameter.
=cut
sub GetAuthority {
my ($authid)=@_;
my $dbh=C4::Context->dbh;
my $sth=$dbh->prepare("select marc from auth_header where authid=?");
$sth->execute($authid);
my ($marc) = $sth->fetchrow;
my $record=MARC::File::USMARC::decode($marc);
return ($record);
my ($authid)=@_;
my $dbh=C4::Context->dbh;
my $sth=$dbh->prepare("select marcxml from auth_header where authid=?");
$sth->execute($authid);
my ($marcxml) = $sth->fetchrow;
my $record=MARC::Record->new_from_xml($marcxml,'UTF-8',(C4::Context->preference("marcflavour") eq "UNIMARC"?"UNIMARCAUTH":C4::Context->preference("marcflavour")));
$record->encoding('UTF-8');
return ($record);
}
=head2 GetAuthType
@ -1157,6 +1155,9 @@ Paul POULAIN paul.poulain@free.fr
# $Id$
# $Log$
# Revision 1.48 2007/06/25 15:01:45 tipaul
# bugfixes on unimarc 100 handling (the field used for encoding)
#
# Revision 1.47 2007/06/06 13:08:35 tipaul
# bugfixes (various), handling utf-8 without guessencoding (as suggested by joshua, fixing some zebra config files -for french but should be interesting for other languages-
#

View file

@ -1992,11 +1992,10 @@ $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator, $ind_tag )
=cut
sub TransformHtmlToXml {
my ( $tags, $subfields, $values, $indicator, $ind_tag ) = @_;
my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
my $xml = MARC::File::XML::header('UTF-8');
if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
MARC::File::XML->default_record_format('UNIMARC');
}
$auth_type = C4::Context->preference('marcflavour') unless $auth_type;
MARC::File::XML->default_record_format($auth_type);
# in UNIMARC, field 100 contains the encoding
# check that there is one, otherwise the
# MARC::Record->new_from_xml will fail (and Koha will die)
@ -2006,6 +2005,16 @@ sub TransformHtmlToXml {
my $first = 1;
my $j = -1;
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
my $enc = substr( @$values[$i], 26, 2 );
if ($enc eq '01' or $enc eq '50' or $enc eq '03') {
$unimarc_and_100_exist=1;
} else {
next;
}
}
@$values[$i] =~ s/&/&amp;/g;
@$values[$i] =~ s/</&lt;/g;
@$values[$i] =~ s/>/&gt;/g;
@ -2014,7 +2023,6 @@ sub TransformHtmlToXml {
if ( !utf8::is_utf8( @$values[$i] ) ) {
utf8::decode( @$values[$i] );
}
$unimarc_and_100_exist=1 if C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a";
if ( ( @$tags[$i] ne $prevtag ) ) {
$j++ unless ( @$tags[$i] eq "" );
if ( !$first ) {
@ -2086,16 +2094,19 @@ sub TransformHtmlToXml {
$prevtag = @$tags[$i];
}
if (C4::Context->preference('marcflavour') 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;
$pos=13 if $auth_type eq 'UNIMARCAUTH';
$string = sprintf( "%-*s", 35, $string );
substr( $string, 22, 6, "frey50" );
substr( $string, $pos , 6, "50" );
$xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
$xml .= "<subfield code=\"a\">$string</subfield>\n";
$xml .= "</datafield>\n";
}
$xml .= MARC::File::XML::footer();
return $xml;
}
@ -3943,6 +3954,9 @@ Joshua Ferraro jmf@liblime.com
# $Id$
# $Log$
# Revision 1.213 2007/06/25 15:01:45 tipaul
# bugfixes on unimarc 100 handling (the field used for encoding)
#
# Revision 1.212 2007/06/15 13:44:44 tipaul
# some fixes (and only fixes)
#

View file

@ -350,7 +350,6 @@ my $authtypecode = $input->param('authtypecode');
my $dbh = C4::Context->dbh;
$authtypecode = &GetAuthTypeCode($authid) if !$authtypecode;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "authorities/authorities.tmpl",
query => $input,
@ -376,7 +375,6 @@ if ($authid) {
#------------------------------------------------------------------------------------------------------------------------------
if ($op eq "add") {
#------------------------------------------------------------------------------------------------------------------------------
# rebuild
my @tags = $input->param('tag');
my @subfields = $input->param('subfield');
@ -384,9 +382,8 @@ if ($op eq "add") {
# build indicator hash.
my @ind_tag = $input->param('ind_tag');
my @indicator = $input->param('indicator');
my $xml = TransformHtmlToXml(\@tags,\@subfields,\@values,\@indicator,\@ind_tag);
my $xml = TransformHtmlToXml(\@tags,\@subfields,\@values,\@indicator,\@ind_tag,'UNIMARCAUTH');
# warn $record->as_formatted;
# warn $xml;
my $record=MARC::Record->new_from_xml($xml,'UTF-8',(C4::Context->preference("marcflavour") eq "UNIMARC"?"UNIMARCAUTH":C4::Context->preference("marcflavour")));
$record->encoding('UTF-8');
#warn $record->as_formatted;
@ -397,7 +394,7 @@ if ($op eq "add") {
if (!$duplicateauthid or $confirm_not_duplicate) {
# warn "noduplicate";
if ($is_a_modif ) {
$authid=ModAuthority($authid,$record,$authtypecode,1);
ModAuthority($authid,$record,$authtypecode,1);
} else {
($authid) = AddAuthority($record,$authid,$authtypecode);
}
@ -405,7 +402,7 @@ if ($op eq "add") {
exit;
} else {
# it may be a duplicate, warn the user and do nothing
build_tabs ($template, $record, $dbh,$encoding);
build_tabs($template, $record, $dbh, $encoding);
build_hidden_data;
$template->param(authid =>$authid,
duplicateauthid => $duplicateauthid,

View file

@ -108,7 +108,6 @@ sub MARCfindbreeding {
# $record->insert_fields_ordered($record->field('010'));
}
}
warn "AVANT : ".$record->as_formatted;
if ($record->subfield(100,'a')) {
my $f100a=$record->subfield(100,'a');
my $f100 = $record->field(100);
@ -121,7 +120,6 @@ sub MARCfindbreeding {
$record->insert_fields_ordered($f100);
}
}
warn "APRES: ".$record->as_formatted;
if (ref($record) eq undef) {
return -1;
} else {