[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Koha-cvs] koha C4/AuthoritiesMarc.pm C4/Biblio.pm authori...
|
From: |
paul poulain |
|
Subject: |
[Koha-cvs] koha C4/AuthoritiesMarc.pm C4/Biblio.pm authori... |
|
Date: |
Mon, 25 Jun 2007 15:01:46 +0000 |
CVSROOT: /sources/koha
Module name: koha
Changes by: paul poulain <tipaul> 07/06/25 15:01:46
Modified files:
C4 : AuthoritiesMarc.pm Biblio.pm
authorities : authorities.pl
cataloguing : addbiblio.pl
Log message:
bugfixes on unimarc 100 handling (the field used for encoding)
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/C4/AuthoritiesMarc.pm?cvsroot=koha&r1=1.47&r2=1.48
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Biblio.pm?cvsroot=koha&r1=1.212&r2=1.213
http://cvs.savannah.gnu.org/viewcvs/koha/authorities/authorities.pl?cvsroot=koha&r1=1.24&r2=1.25
http://cvs.savannah.gnu.org/viewcvs/koha/cataloguing/addbiblio.pl?cvsroot=koha&r1=1.27&r2=1.28
Patches:
Index: C4/AuthoritiesMarc.pm
===================================================================
RCS file: /sources/koha/koha/C4/AuthoritiesMarc.pm,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -b -r1.47 -r1.48
--- C4/AuthoritiesMarc.pm 6 Jun 2007 13:08:35 -0000 1.47
+++ C4/AuthoritiesMarc.pm 25 Jun 2007 15:01:45 -0000 1.48
@@ -227,7 +227,7 @@
}elsif (@$operator[$i] eq "start"){
$attr.=" address@hidden 4=1 address@hidden 5=1 ";#Phrase,
Right truncated
} else {
- $attr .=" address@hidden 5=1 ";## Word list, right
truncated, anywhere
+ $attr .=" address@hidden 5=1 address@hidden 4=6 ";## Word
list, right truncated, anywhere
}
$and .=" address@hidden " ;
$attr =$attr."\""address@hidden"\"";
@@ -503,7 +503,7 @@
# 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 @@
$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 ModAuthority {
my ($authid,$record,$authtypecode,$merge)address@hidden;
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 @@
print AUTH $authid;
close AUTH;
} else {
- &merge($authid,$record,$authid,$record);
+# &merge($authid,$record,$authid,$record);
}
return $authid;
}
@@ -588,11 +587,9 @@
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;
}
@@ -610,10 +607,11 @@
sub GetAuthority {
my ($authid)address@hidden;
my $dbh=C4::Context->dbh;
- my $sth=$dbh->prepare("select marc from auth_header where authid=?");
+ my $sth=$dbh->prepare("select marcxml from auth_header where authid=?");
$sth->execute($authid);
- my ($marc) = $sth->fetchrow;
- my $record=MARC::File::USMARC::decode($marc);
+ 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);
}
@@ -1155,8 +1153,11 @@
=cut
-# $Id: AuthoritiesMarc.pm,v 1.47 2007/06/06 13:08:35 tipaul Exp $
+# $Id: AuthoritiesMarc.pm,v 1.48 2007/06/25 15:01:45 tipaul Exp $
# $Log: AuthoritiesMarc.pm,v $
+# 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-
#
Index: C4/Biblio.pm
===================================================================
RCS file: /sources/koha/koha/C4/Biblio.pm,v
retrieving revision 1.212
retrieving revision 1.213
diff -u -b -r1.212 -r1.213
--- C4/Biblio.pm 15 Jun 2007 13:44:44 -0000 1.212
+++ C4/Biblio.pm 25 Jun 2007 15:01:45 -0000 1.213
@@ -33,7 +33,7 @@
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.212 $' =~ /\d+/g; shift(@v).".".join(
"_", map { sprintf "%03d", $_ } @v ); };
+$VERSION = do { my @v = '$Revision: 1.213 $' =~ /\d+/g; shift(@v).".".join(
"_", map { sprintf "%03d", $_ } @v ); };
@ISA = qw( Exporter );
@@ -1992,11 +1992,10 @@
=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 @@
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/&/&/g;
@$values[$i] =~ s/</</g;
@$values[$i] =~ s/>/>/g;
@@ -2014,7 +2023,6 @@
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 @@
$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;
}
@@ -3941,8 +3952,11 @@
=cut
-# $Id: Biblio.pm,v 1.212 2007/06/15 13:44:44 tipaul Exp $
+# $Id: Biblio.pm,v 1.213 2007/06/25 15:01:45 tipaul Exp $
# $Log: Biblio.pm,v $
+# 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)
#
Index: authorities/authorities.pl
===================================================================
RCS file: /sources/koha/koha/authorities/authorities.pl,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -b -r1.24 -r1.25
--- authorities/authorities.pl 10 May 2007 14:45:15 -0000 1.24
+++ authorities/authorities.pl 25 Jun 2007 15:01:45 -0000 1.25
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: authorities.pl,v 1.24 2007/05/10 14:45:15 tipaul Exp $
+# $Id: authorities.pl,v 1.25 2007/06/25 15:01:45 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -350,7 +350,6 @@
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 ($op eq "add") {
#------------------------------------------------------------------------------------------------------------------------------
-
# rebuild
my @tags = $input->param('tag');
my @subfields = $input->param('subfield');
@@ -384,9 +382,8 @@
# build indicator hash.
my @ind_tag = $input->param('ind_tag');
my @indicator = $input->param('indicator');
- my $xml =
TransformHtmlToXml(address@hidden,address@hidden,address@hidden,address@hidden,address@hidden);
+ my $xml =
TransformHtmlToXml(address@hidden,address@hidden,address@hidden,address@hidden,address@hidden,'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 (!$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 @@
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,
Index: cataloguing/addbiblio.pl
===================================================================
RCS file: /sources/koha/koha/cataloguing/addbiblio.pl,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -b -r1.27 -r1.28
--- cataloguing/addbiblio.pl 15 Jun 2007 13:44:45 -0000 1.27
+++ cataloguing/addbiblio.pl 25 Jun 2007 15:01:46 -0000 1.28
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: addbiblio.pl,v 1.27 2007/06/15 13:44:45 tipaul Exp $
+# $Id: addbiblio.pl,v 1.28 2007/06/25 15:01:46 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -108,7 +108,6 @@
# $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 @@
$record->insert_fields_ordered($f100);
}
}
- warn "APRES: ".$record->as_formatted;
if (ref($record) eq undef) {
return -1;
} else {
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Koha-cvs] koha C4/AuthoritiesMarc.pm C4/Biblio.pm authori...,
paul poulain <=