@ -55,7 +55,8 @@ $VERSION = 0.01;
) ;
sub AUTHfind_marc_from_kohafield {
my ( $ dbh , $ kohafield , $ authtypecode ) = @ _ ;
my ( $ kohafield , $ authtypecode ) = @ _ ;
my $ dbh = C4::Context - > dbh ;
return 0 , 0 unless $ kohafield ;
$ authtypecode = "" unless $ authtypecode ;
my $ marcfromkohafield ;
@ -144,14 +145,12 @@ while (($i = ZOOM::event(\@oAuth)) != 0) {
goto NOLUCK ;
}
my $ nbresults ;
$ nbresults = $ oAResult - > size ( ) ;
my $ nremains = $ nbresults ;
my @ result = ( ) ;
my @ finalresult = ( ) ;
if ( $ nbresults > 0 ) {
##Find authid and linkid fields
@ -207,8 +206,6 @@ if ($nbresults>0){
$ counter + + ;
push @ finalresult , \ % newline ;
} ## while counter
###
for ( my $ z = 0 ; $ z < @ finalresult ; $ z + + ) {
my $ count = AUTHcount_usage ( $ finalresult [ $ z ] { authid } ) ;
@ -226,7 +223,8 @@ NOLUCK:
# Creates the SQL Request
sub create_request {
my ( $ dbh , $ tags , $ and_or , $ operator , $ value ) = @ _ ;
my ( $ tags , $ and_or , $ operator , $ value ) = @ _ ;
my $ dbh = C4::Context - > dbh ;
my $ sql_tables ; # will contain marc_subfield_table as m1,...
my $ sql_where1 ; # will contain the "true" where
@ -234,12 +232,10 @@ sub create_request {
my $ nb_active = 0 ; # will contain the number of "active" entries. and entry is active is a value is provided.
my $ nb_table = 1 ; # will contain the number of table. ++ on each entry EXCEPT when an OR is provided.
for ( my $ i = 0 ; $ i <= @$ value ; $ i + + ) {
if ( @$ value [ $ i ] ) {
$ nb_active + + ;
if ( $ nb_active == 1 ) {
$ sql_tables = "auth_subfield_table as m$nb_table," ;
$ sql_where1 . = "( m$nb_table.subfieldvalue like '@$value[$i]' " ;
if ( @$ tags [ $ i ] ) {
@ -247,12 +243,7 @@ sub create_request {
}
$ sql_where1 . = ")" ;
} else {
$ nb_table + + ;
$ sql_tables . = "auth_subfield_table as m$nb_table," ;
$ sql_where1 . = "@$and_or[$i] (m$nb_table.subfieldvalue like '@$value[$i]' " ;
if ( @$ tags [ $ i ] ) {
@ -260,8 +251,6 @@ sub create_request {
}
$ sql_where1 . = ")" ;
$ sql_where2 . = "m1.authid=m$nb_table.authid and " ;
}
}
}
@ -302,7 +291,8 @@ return ($result);
sub AUTHfind_authtypecode {
my ( $ dbh , $ authid ) = @ _ ;
my ( $ authid ) = @ _ ;
my $ dbh = C4::Context - > dbh ;
my $ sth = $ dbh - > prepare ( "select authtypecode from auth_header where authid=?" ) ;
$ sth - > execute ( $ authid ) ;
my ( $ authtypecode ) = $ sth - > fetchrow ;
@ -311,7 +301,8 @@ sub AUTHfind_authtypecode {
sub AUTHgettagslib {
my ( $ dbh , $ forlibrarian , $ authtypecode ) = @ _ ;
my ( $ forlibrarian , $ authtypecode ) = @ _ ;
my $ dbh = C4::Context - > dbh ;
$ authtypecode = "" unless $ authtypecode ;
my $ sth ;
my $ libfield = ( $ forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac' ;
@ -323,7 +314,10 @@ sub AUTHgettagslib {
my ( $ total ) = $ sth - > fetchrow ;
$ authtypecode = "" unless ( $ total > 0 ) ;
$ sth = $ dbh - > prepare (
"select tagfield,liblibrarian,libopac,mandatory,repeatable from auth_tag_structure where authtypecode=? order by tagfield"
" SELECT tagfield , liblibrarian , libopac , mandatory , repeatable
FROM auth_tag_structure
WHERE authtypecode = ?
ORDER BY tagfield "
) ;
$ sth - > execute ( $ authtypecode ) ;
@ -335,7 +329,11 @@ $sth->execute($authtypecode);
$ res - > { $ tag } - > { mandatory } = $ mandatory ;
$ res - > { $ tag } - > { repeatable } = $ repeatable ;
}
$ sth = $ dbh - > prepare ( "select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl from auth_subfield_structure where authtypecode=? order by tagfield,tagsubfield"
$ sth = $ dbh - > prepare (
" SELECT tagfield , tagsubfield , liblibrarian , libopac , tab , mandatory , repeatable , authorised_value , authtypecode , value_builder , kohafield , seealso , hidden , isurl
FROM auth_subfield_structure
WHERE authtypecode = ?
ORDER BY tagfield , tagsubfield "
) ;
$ sth - > execute ( $ authtypecode ) ;
@ -374,8 +372,8 @@ $sth->execute($authtypecode);
sub AUTHaddauthority {
# pass the MARC::Record to this function, and it will create the records in the authority table
my ( $ dbh , $ record , $ authid , $ authtypecode ) = @ _ ;
my ( $ record , $ authid , $ authtypecode ) = @ _ ;
my $ dbh = C4::Context - > dbh ;
#my $leadercode=AUTHfind_leader($dbh,$authtypecode);
my $ leader = ' a ' ; ##Fixme correct leader as this one just adds utf8 to MARC21
#substr($leader,8,1)=$leadercode;
@ -416,7 +414,7 @@ my $leader=' a ';##Fixme correct leader as this one just ad
$ sth - > finish ;
}
$ dbh - > do ( "unlock tables" ) ;
zebraop ( $ dbh , $ authid , 'specialUpdate' , "authorityserver" ) ;
zebraop ( $ authid , 'specialUpdate' , "authorityserver" ) ;
# if ($record->field($linkidfield)){
# my @fields=$record->field($linkidfield);
@ -433,21 +431,23 @@ my $leader=' a ';##Fixme correct leader as this one just ad
}
sub AUTHaddlink {
my ( $ dbh , $ linkid , $ authid ) = @ _ ;
my $ record = AUTHgetauthority ( $ dbh , $ linkid ) ;
my $ authtypecode = AUTHfind_authtypecode ( $ dbh , $ linkid ) ;
my ( $ linkid , $ authid ) = @ _ ;
my $ dbh = C4::Context - > dbh ;
my $ record = AUTHgetauthority ( $ linkid ) ;
my $ authtypecode = AUTHfind_authtypecode ( $ linkid ) ;
#warn "adding l:$linkid,a:$authid,auth:$authtypecode";
$ record = AUTH2marcOnefieldlink ( $ dbh , $ record , "auth_header.linkid" , $ authid , $ authtypecode ) ;
$ record = AUTH2marcOnefieldlink ( $ record , "auth_header.linkid" , $ authid , $ authtypecode ) ;
$ dbh - > do ( "lock tables auth_header WRITE" ) ;
my $ sth = $ dbh - > prepare ( "update auth_header set marc=? where authid=?" ) ;
$ sth - > execute ( $ record - > as_usmarc , $ linkid ) ;
$ sth - > finish ;
$ dbh - > do ( "unlock tables" ) ;
zebraop ( $ dbh , $ linkid , 'specialUpdate' , "authorityserver" ) ;
zebraop ( $ linkid , 'specialUpdate' , "authorityserver" ) ;
}
sub AUTH2marcOnefieldlink {
my ( $ dbh , $ record , $ kohafieldname , $ newvalue , $ authtypecode ) = @ _ ;
my ( $ record , $ kohafieldname , $ newvalue , $ authtypecode ) = @ _ ;
my $ dbh = C4::Context - > dbh ;
my $ sth = $ dbh - > prepare (
"select tagfield,tagsubfield from auth_subfield_structure where authtypecode=? and kohafield=?"
) ;
@ -460,12 +460,10 @@ my ($tagfield,$tagsubfield)=$sth->fetchrow;
sub XMLgetauthority {
# Returns MARC::XML of the authority passed in parameter.
my ( $ dbh , $ authid ) = @ _ ;
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 ;
$ marc = MARC::File::USMARC:: decode ( $ marc ) ;
@ -477,7 +475,7 @@ $marc=MARC::File::USMARC::decode($marc);
sub AUTHfind_leader {
##Hard coded for NEU auth types
my ( $ dbh , $ authtypecode ) = @ _ ;
my ( $ authtypecode ) = @ _ ;
my $ leadercode ;
if ( $ authtypecode eq "AUTH" ) {
@ -494,7 +492,8 @@ return $leadercode;
sub AUTHgetauthority {
# Returns MARC::Record of the biblio passed in parameter.
my ( $ dbh , $ authid ) = @ _ ;
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 ;
@ -512,14 +511,15 @@ sub AUTHgetauth_type {
}
sub AUTHmodauthority {
my ( $ dbh , $ authid , $ record , $ authtypecode , $ merge ) = @ _ ;
my ( $ oldrecord ) = & AUTHgetauthority ( $ dbh , $ authid ) ;
my ( $ authid , $ record , $ authtypecode , $ merge ) = @ _ ;
my $ dbh = C4::Context - > dbh ;
my ( $ oldrecord ) = & AUTHgetauthority ( $ authid ) ;
if ( $ oldrecord eq $ record ) {
return ;
}
my $ sth = $ dbh - > prepare ( "update auth_header set marc=? where authid=?" ) ;
#warn find if linked records exist and delete them
my ( $ linkidfield , $ linkidsubfield ) = AUTHfind_marc_from_kohafield ( $ dbh , "auth_header.linkid" , $ authtypecode ) ;
my ( $ linkidfield , $ linkidsubfield ) = AUTHfind_marc_from_kohafield ( "auth_header.linkid" , $ authtypecode ) ;
if ( $ oldrecord - > field ( $ linkidfield ) ) {
my @ fields = $ oldrecord - > field ( $ linkidfield ) ;
@ -527,22 +527,22 @@ my @fields=$oldrecord->field($linkidfield);
my $ linkid = $ field - > subfield ( $ linkidsubfield ) ;
if ( $ linkid ) {
##Modify the record of linked
my $ linkrecord = AUTHgetauthority ( $ dbh , $ linkid ) ;
my $ linktypecode = AUTHfind_authtypecode ( $ dbh , $ linkid ) ;
my ( $ linkidfield2 , $ linkidsubfield2 ) = AUTHfind_marc_from_kohafield ( $ dbh , "auth_header.linkid" , $ linktypecode ) ;
my $ linkrecord = AUTHgetauthority ( $ linkid ) ;
my $ linktypecode = AUTHfind_authtypecode ( $ linkid ) ;
my ( $ linkidfield2 , $ linkidsubfield2 ) = AUTHfind_marc_from_kohafield ( "auth_header.linkid" , $ linktypecode ) ;
my @ linkfields = $ linkrecord - > field ( $ linkidfield2 ) ;
foreach my $ linkfield ( @ linkfields ) {
if ( $ linkfield - > subfield ( $ linkidsubfield2 ) eq $ authid ) {
$ linkrecord - > delete_field ( $ linkfield ) ;
$ sth - > execute ( $ linkrecord - > as_usmarc , $ linkid ) ;
zebraop ( $ dbh , $ linkid , 'specialUpdate' , "authorityserver" ) ;
zebraop ( $ linkid , 'specialUpdate' , "authorityserver" ) ;
}
} #foreach linkfield
}
} #foreach linkid
}
#Now rewrite the $record to table with an add
$ authid = AUTHaddauthority ( $ dbh , $ record , $ authid , $ authtypecode ) ;
$ authid = AUTHaddauthority ( $ 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
@ -561,23 +561,25 @@ if (C4::Context->preference('dontmerge') ){
print AUTH $ authid ;
close AUTH ;
} else {
& merge ( $ dbh , $ authid , $ record , $ authid , $ record ) ;
& merge ( $ authid , $ record , $ authid , $ record ) ;
}
return $ authid ;
}
sub AUTHdelauthority {
my ( $ dbh , $ authid , $ keep_biblio ) = @ _ ;
my ( $ authid , $ keep_biblio ) = @ _ ;
my $ dbh = C4::Context - > dbh ;
# if the keep_biblio is set to 1, then authority entries in biblio are preserved.
zebraop ( $ dbh , $ authid , "recordDelete" , "authorityserver" ) ;
zebraop ( $ authid , "recordDelete" , "authorityserver" ) ;
$ dbh - > do ( "delete from auth_header where authid=$authid" ) ;
# FIXME : delete or not in biblio tables (depending on $keep_biblio flag)
}
sub AUTHhtml2marc {
my ( $ dbh , $ rtags , $ rsubfields , $ rvalues , % indicators ) = @ _ ;
my ( $ rtags , $ rsubfields , $ rvalues , % indicators ) = @ _ ;
my $ dbh = C4::Context - > dbh ;
my $ prevtag = - 1 ;
my $ record = MARC::Record - > new ( ) ;
#---- TODO : the leader is missing
@ -773,18 +775,18 @@ sub BuildUnimarcHierarchies{
my @ globalresult ;
my $ dbh = C4::Context - > dbh ;
my $ hierarchies ;
my $ data = AUTHgetheader ( $ dbh , $ authid ) ;
my $ data = AUTHgetheader ( $ authid ) ;
if ( $ data - > { 'authtrees' } and not $ force ) {
return $ data - > { 'authtrees' } ;
} elsif ( $ data - > { 'authtrees' } ) {
$ hierarchies = $ data - > { 'authtrees' } ;
} else {
my $ record = AUTHgetauthority ( $ dbh , $ authid ) ;
my $ record = AUTHgetauthority ( $ authid ) ;
my $ found ;
foreach my $ field ( $ record - > field ( '550' ) ) {
if ( $ field - > subfield ( '5' ) && $ field - > subfield ( '5' ) eq 'g' ) {
my $ parentrecord = AUTHgetauthority ( $ dbh , $ field - > subfield ( '3' ) ) ;
my $ parentrecord = AUTHgetauthority ( $ field - > subfield ( '3' ) ) ;
my $ localresult = $ hierarchies ;
my $ trees ;
$ trees = BuildUnimarcHierarchies ( $ field - > subfield ( '3' ) ) ;
@ -859,9 +861,10 @@ sub AUTHsavetrees{
sub merge {
my ( $ dbh , $ mergefrom , $ MARCfrom , $ mergeto , $ MARCto ) = @ _ ;
my $ authtypecodefrom = AUTHfind_authtypecode ( $ dbh , $ mergefrom ) ;
my $ authtypecodeto = AUTHfind_authtypecode ( $ dbh , $ mergeto ) ;
my ( $ mergefrom , $ MARCfrom , $ mergeto , $ MARCto ) = @ _ ;
my $ dbh = C4::Context - > dbh ;
my $ authtypecodefrom = AUTHfind_authtypecode ( $ mergefrom ) ;
my $ authtypecodeto = AUTHfind_authtypecode ( $ mergeto ) ;
# return if authority does not exist
my @ X = $ MARCfrom - > fields ( ) ;
return if $# X == - 1 ;
@ -950,6 +953,10 @@ Paul POULAIN paul.poulain@free.fr
# $Id$
# $Log$
# Revision 1.40 2007/03/28 10:39:16 hdl
# removing $dbh as a parameter in AuthoritiesMarc functions
# And reporting all differences into the scripts taht relies on those functions.
#
# Revision 1.39 2007/03/16 01:25:08 kados
# Using my precrash CVS copy I did the following:
#
hdl
17 years ago