@ -26,7 +26,7 @@ use C4::Output;
use C4::AuthoritiesMarc ;
use C4::Context ;
use C4::Koha ; # XXX subfield_is_koha_internal_p
use Date::Calc qw( Today ) ;
use MARC::File::USMARC ;
use MARC::File::XML ;
use C4::Biblio ;
@ -35,7 +35,7 @@ use vars qw( $authorised_values_sth);
use vars qw( $is_a_modif ) ;
my $ itemtype ; # created here because it can be used in build_authorized_values_list sub
our ( $ authorised_values_sth , $ is_a_modif , $ usedTagsLib , $ mandatory_z3950 ) ;
= item find_value
( $ indicators , $ value ) = find_value ( $ tag , $ subfield , $ record , $ encoding ) ;
@ -76,234 +76,417 @@ sub find_value {
= cut
sub build_authorized_values_list ($$$$$) {
my ( $ tag , $ subfield , $ value , $ dbh , $ authorised_values_sth ) = @ _ ;
sub build_authorized_values_list ($$$$$$$ ) {
my ( $ tag , $ subfield , $ value , $ dbh , $ authorised_values_sth , $ index_tag , $ index_subfield ) = @ _ ;
my @ authorised_values ;
my % authorised_lib ;
my @ authorised_values ;
my % authorised_lib ;
# builds list, depending on authorised value...
# builds list, depending on authorised value...
#---- branch
if ( $ tagslib - > { $ tag } - > { $ subfield } - > { 'authorised_value' } eq "branches" ) {
my $ sth = $ dbh - > prepare ( "select branchcode,branchname from branches order by branchname" ) ;
$ sth - > execute ;
push @ authorised_values , ""
unless ( $ tagslib - > { $ tag } - > { $ subfield } - > { mandatory } ) ;
#---- branch
if ( $ tagslib - > { $ tag } - > { $ subfield } - > { 'authorised_value' } eq "branches" ) {
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 ;
}
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 ;
}
$ value = $ itemtype unless ( $ value ) ;
#----- 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 } ) ;
my $ itemtype ;
while ( my ( $ itemtype , $ description ) = $ sth - > fetchrow_array ) {
push @ authorised_values , $ itemtype ;
$ authorised_lib { $ itemtype } = $ description ;
}
$ value = $ itemtype unless ( $ value ) ;
#---- "true" authorised value
}
else {
$ authorised_values_sth - > execute (
$ tagslib - > { $ tag } - > { $ subfield } - > { authorised_value } ) ;
#---- "true" authorised value
} else {
$ authorised_values_sth - > execute ( $ tagslib - > { $ tag } - > { $ subfield } - > { authorised_value } ) ;
push @ authorised_values , ""
unless ( $ tagslib - > { $ tag } - > { $ subfield } - > { mandatory } ) ;
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 ;
}
while ( my ( $ value , $ lib ) = $ authorised_values_sth - > fetchrow_array ) {
push @ authorised_values , $ value ;
$ authorised_lib { $ value } = $ lib ;
}
}
return CGI:: scrolling_list ( - name = > 'field_value' ,
- values = > \ @ authorised_values ,
- default = > $ value ,
- labels = > \ % authorised_lib ,
- override = > 1 ,
- size = > 1 ,
- tabindex = > '' ,
- multiple = > 0 ) ;
return CGI:: scrolling_list (
- name = > "tag_" . $ tag . "_subfield_" . $ subfield . "_" . $ index_tag . "_" . $ index_subfield ,
- values = > \ @ authorised_values ,
- default = > $ value ,
- labels = > \ % authorised_lib ,
- override = > 1 ,
- size = > 1 ,
- multiple = > 0 ,
- tabindex = > 1 ,
- id = > "tag_" . $ tag . "_subfield_" . $ subfield . "_" . $ index_tag . "_" . $ index_subfield ,
- class = > "input_marceditor" ,
) ;
}
= item create_input
builds the < input ... > entry for a subfield .
= cut
sub create_input () {
my ( $ tag , $ subfield , $ value , $ i , $ tabloop , $ rec , $ authorised_values_sth ) = @ _ ;
# must be encoded as utf-8 before it reaches the editor
my $ dbh = C4::Context - > dbh ;
$ value =~ s/"/"/g ;
my % subfield_data ;
$ subfield_data { tag } = $ tag ;
$ subfield_data { subfield } = $ subfield ;
$ subfield_data { marc_lib } = "<span id=\"error$i\">" . $ tagslib - > { $ tag } - > { $ subfield } - > { lib } . "</span>" ;
$ subfield_data { marc_lib_plain } = $ tagslib - > { $ tag } - > { $ subfield } - > { lib } ;
$ subfield_data { tag_mandatory } = $ tagslib - > { $ tag } - > { mandatory } ;
$ subfield_data { mandatory } = $ tagslib - > { $ tag } - > { $ subfield } - > { mandatory } ;
$ subfield_data { repeatable } = $ tagslib - > { $ tag } - > { $ subfield } - > { repeatable } ;
$ subfield_data { kohafield } = $ tagslib - > { $ tag } - > { $ subfield } - > { kohafield } ;
$ subfield_data { index } = $ i ;
$ subfield_data { visibility } = "display:none" if ( substr ( $ tagslib - > { $ tag } - > { $ subfield } - > { hidden } , 2 , 1 ) gt "0" ) ; #check parity
# it's an authorised field
if ( $ tagslib - > { $ tag } - > { $ subfield } - > { authorised_value } ) {
$ subfield_data { marc_value } = build_authorized_values_list ( $ tag , $ subfield , $ value , $ dbh , $ authorised_values_sth ) ;
# it's a thesaurus / authority field
} elsif ( $ tagslib - > { $ tag } - > { $ subfield } - > { frameworkcode } ) {
$ subfield_data { marc_value } = "<input type=\"text\" name=\"field_value\" value=\"$value\" size=\"67\" maxlength=\"255\" DISABLE READONLY> <a href=\"javascript:Dopop('../authorities/auth_finder.pl?authtypecode=" . $ tagslib - > { $ tag } - > { $ subfield } - > { frameworkcode } . "&index=$i',$i)\">...</a>" ;
} elsif ( $ tagslib - > { $ tag } - > { $ subfield } - > { link } ) {
$ subfield_data { marc_value } = "<input onblur=\"this.style.backgroundColor='#ffffff';\" onfocus=\"this.style.backgroundColor='#ffffff;'\" tabindex=\"1\" type=\"text\" name=\"field_value\" value=\"$value\" size=\"40\" maxlength=\"255\" DISABLE READONLY> <a style=\"cursor: help;\" href=\"javascript:Dopop('../authorities/auth_linker.pl?index=$i',$i)\">...</a>" ;
# it's a plugin field
} elsif ( $ tagslib - > { $ tag } - > { $ subfield } - > { 'value_builder' } ) {
# opening plugin. Just check wether we are on a developper computer on a production one
# (the cgidir differs)
my $ cgidir = C4::Context - > intranetdir . "/cgi-bin/cataloguing/value_builder" ;
unless ( opendir ( DIR , "$cgidir" ) ) {
$ cgidir = C4::Context - > intranetdir . "/cataloguing/value_builder" ;
}
my $ plugin = $ cgidir . "/" . $ tagslib - > { $ tag } - > { $ subfield } - > { 'value_builder' } ;
require $ plugin ;
my $ extended_param = plugin_parameters ( $ dbh , $ rec , $ tagslib , $ i , $ tabloop ) ;
my ( $ function_name , $ javascript ) = plugin_javascript ( $ dbh , $ rec , $ tagslib , $ i , $ tabloop ) ;
$ subfield_data { marc_value } = "<input tabindex=\"1\" type=\"text\" name=\"field_value\" value=\"$value\" size=\"40\" maxlength=\"255\" OnFocus=\"javascript:Focus$function_name($i)\" OnBlur=\"javascript:Blur$function_name($i); \"> <a style=\"cursor: help;\" href=\"javascript:Clic$function_name($i)\">...</a> $javascript" ;
# it's an hidden field
} elsif ( $ tag eq '' ) {
$ subfield_data { marc_value } = "<input onblur=\"this.style.backgroundColor='#ffffff';\" onfocus=\"this.style.backgroundColor='#ffffff'; \" tabindex=\"1\" type=\"hidden\" name=\"field_value\" value=\"$value\">" ;
} elsif ( substr ( $ tagslib - > { $ tag } - > { $ subfield } - > { 'hidden' } , 2 , 1 ) gt "1" ) {
$ subfield_data { marc_value } = "<input onblur=\"this.style.backgroundColor='#ffffff';\" onfocus=\"this.style.backgroundColor='#ffffff'; \" tabindex=\"1\" type=\"text\" name=\"field_value\" value=\"$value\" size=\"40\" maxlength=\"255\" >" ;
# it's a standard field
} else {
if ( length ( $ value ) > 100 ) {
$ subfield_data { marc_value } = "<textarea tabindex=\"1\" name=\"field_value\" cols=\"40\" rows=\"5\" >$value</textarea>" ;
} else {
$ subfield_data { marc_value } = "<input onblur=\"this.style.backgroundColor='#ffffff';\" onfocus=\"this.style.backgroundColor='#ffffff'; \" tabindex=\"1\" type=\"text\" name=\"field_value\" value=\"$value\" size=\"50\">" ; #"
}
}
return \ % subfield_data ;
sub create_input {
my ( $ tag , $ subfield , $ value , $ index_tag , $ tabloop , $ rec , $ authorised_values_sth , $ cgi ) = @ _ ;
my $ index_subfield = CreateKey ( ) ; # create a specifique key for each subfield
$ value =~ s/"/"/g ;
# if there is no value provided but a default value in parameters, get it
unless ( $ value ) {
$ value = $ tagslib - > { $ tag } - > { $ subfield } - > { defaultvalue } ;
# get today date & replace YYYY, MM, DD if provided in the default value
my ( $ year , $ month , $ day ) = Today ( ) ;
$ month = sprintf ( "%02d" , $ month ) ;
$ day = sprintf ( "%02d" , $ day ) ;
$ value =~ s/YYYY/$year/g ;
$ value =~ s/MM/$month/g ;
$ value =~ s/DD/$day/g ;
}
my $ dbh = C4::Context - > dbh ;
my % subfield_data = (
tag = > $ tag ,
subfield = > $ subfield ,
marc_lib = > substr ( $ tagslib - > { $ tag } - > { $ subfield } - > { lib } , 0 , 22 ) ,
marc_lib_plain = > $ tagslib - > { $ tag } - > { $ subfield } - > { lib } ,
tag_mandatory = > $ tagslib - > { $ tag } - > { mandatory } ,
mandatory = > $ tagslib - > { $ tag } - > { $ subfield } - > { mandatory } ,
repeatable = > $ tagslib - > { $ tag } - > { $ subfield } - > { repeatable } ,
kohafield = > $ tagslib - > { $ tag } - > { $ subfield } - > { kohafield } ,
index = > $ index_tag ,
id = > "tag_" . $ tag . "_subfield_" . $ subfield . "_" . $ index_tag . "_" . $ index_subfield ,
value = > $ value ,
) ;
if ( $ subfield eq '@' ) {
$ subfield_data { id } = "tag_" . $ tag . "_subfield_00_" . $ index_tag . "_" . $ index_subfield ;
} else {
$ subfield_data { id } = "tag_" . $ tag . "_subfield_" . $ subfield . "_" . $ index_tag . "_" . $ index_subfield ;
}
if ( exists $ mandatory_z3950 - > { $ tag . $ subfield } ) {
$ subfield_data { z3950_mandatory } = $ mandatory_z3950 - > { $ tag . $ subfield } ;
}
$ subfield_data { visibility } = "display:none;"
if ( ( $ tagslib - > { $ tag } - > { $ subfield } - > { hidden } % 2 == 1 ) and $ value ne ''
or ( $ value eq '' and ! $ tagslib - > { $ tag } - > { $ subfield } - > { mandatory } )
) ;
# it's an authorised field
if ( $ tagslib - > { $ tag } - > { $ subfield } - > { authorised_value } ) {
$ subfield_data { marc_value } =
build_authorized_values_list ( $ tag , $ subfield , $ value , $ dbh ,
$ authorised_values_sth , $ index_tag , $ index_subfield ) ;
# it's a thesaurus / authority field
}
elsif ( $ tagslib - > { $ tag } - > { $ subfield } - > { authtypecode } ) {
$ subfield_data { marc_value } =
" < input type = \ " text \ "
id = \ "" . $ subfield_data { id } . " \ "
name = \ "" . $ subfield_data { id } . " \ "
value = \ " $ value \ "
class = \ " input_marceditor \ "
tabindex = \ " 1 \ "
DISABLE READONLY \ / >
< span class = \ " buttonDot \ "
onclick = \ "Dopop('/cgi-bin/koha/authorities/auth_finder.pl?authtypecode=" . $ tagslib - > { $ tag } - > { $ subfield } - > { authtypecode } . " & index = $ subfield_data { id } ',' $ subfield_data { id } ' ) \ " > ... </span>
" ;
# it's a plugin field
}
elsif ( $ tagslib - > { $ tag } - > { $ subfield } - > { 'value_builder' } ) {
# opening plugin. Just check wether we are on a developper computer on a production one
# (the cgidir differs)
my $ cgidir = C4::Context - > intranetdir . "/cgi-bin/cataloguing/value_builder" ;
unless ( opendir ( DIR , "$cgidir" ) ) {
$ cgidir = C4::Context - > intranetdir . "/cataloguing/value_builder" ;
}
my $ plugin = $ cgidir . "/" . $ tagslib - > { $ tag } - > { $ subfield } - > { 'value_builder' } ;
do $ plugin || die "Plugin Failed: " . $ plugin ;
my $ extended_param = plugin_parameters ( $ dbh , $ rec , $ tagslib , $ subfield_data { id } , $ tabloop ) ;
my ( $ function_name , $ javascript ) = plugin_javascript ( $ dbh , $ rec , $ tagslib , $ subfield_data { id } , $ tabloop ) ;
# my ( $function_name, $javascript,$extended_param );
$ subfield_data { marc_value } =
" < input tabindex = \ " 1 \ "
type = \ " text \ "
id = ".$subfield_data{id}."
name = ".$subfield_data{id}."
value = \ " $ value \ "
class = \ " input_marceditor \ "
onfocus = \ " javascript:Focus $ function_name ( $ index_tag ) \ "
onblur = \ " javascript:Blur $ function_name ( $ index_tag ) ; \ " \ / >
< span class = \ " buttonDot \ "
onclick = \ " Clic $ function_name ( '$subfield_data{id}' ) \ " > ... </a>
$ javascript " ;
# it's an hidden field
}
elsif ( $ tag eq '' ) {
$ subfield_data { marc_value } =
" < input tabindex = \ " 1 \ "
type = \ " hidden \ "
id = ".$subfield_data{id}."
name = ".$subfield_data{id}."
value = \ " $ value \ " \ / >
" ;
}
elsif ( $ tagslib - > { $ tag } - > { $ subfield } - > { 'hidden' } ) {
$ subfield_data { marc_value } =
" < input type = \ " text \ "
id = ".$subfield_data{id}."
name = ".$subfield_data{id}."
class = \ " input_marceditor \ "
tabindex = \ " 1 \ "
value = \ " $ value \ "
\ / > " ;
# it's a standard field
}
else {
if (
length ( $ value ) > 100
or
( C4::Context - > preference ( "marcflavour" ) eq "UNIMARC" && $ tag >= 300
and $ tag < 400 && $ subfield eq 'a' )
or ( $ tag >= 500
and $ tag < 600
&& C4::Context - > preference ( "marcflavour" ) eq "MARC21" )
)
{
$ subfield_data { marc_value } =
" < textarea cols = \ " 70 \ "
rows = \ " 4 \ "
id = ".$subfield_data{id}."
name = ".$subfield_data{id}."
class = \ " input_marceditor \ "
tabindex = \ " 1 \ "
> $ value </textarea>
" ;
}
else {
$ subfield_data { marc_value } =
" < input type = \ " text \ "
id = ".$subfield_data{id}."
name = ".$subfield_data{id}."
value = \ " $ value \ "
tabindex = \ " 1 \ "
class = \ " input_marceditor \ "
\ / >
" ;
}
}
$ subfield_data { 'index_subfield' } = $ index_subfield ;
return \ % subfield_data ;
}
= item CreateKey
Create a random value to set it into the input name
= cut
sub CreateKey () {
return int ( rand ( 1000000 ) ) ;
}
sub build_tabs ($$$$) {
my ( $ template , $ record , $ dbh , $ encoding ) = @ _ ;
sub build_tabs ($$$$$) {
my ( $ template , $ record , $ dbh , $ encoding , $ input ) = @ _ ;
# fill arrays
my @ loop_data = ( ) ;
my @ loop_data = ( ) ;
my $ tag ;
my $ i = 0 ;
my $ authorised_values_sth = $ dbh - > prepare ( " select authorised_value , lib
from authorised_values
where category = ? order by lib " ) ;
# loop through each tab 0 through 9
for ( my $ tabloop = 0 ; $ tabloop <= 9 ; $ tabloop + + ) {
my @ loop_data = ( ) ;
foreach my $ tag ( sort ( keys ( % { $ tagslib } ) ) ) {
my $ indicator ;
# if MARC::Record is not empty => use it as master loop, then add missing subfields that should be in the tab.
# if MARC::Record is empty => use tab as master loop.
if ( $ record ne - 1 && ( $ record - > field ( $ tag ) || $ tag eq '000' ) ) {
my @ fields ;
if ( $ tag ne '000' ) {
@ fields = $ record - > field ( $ tag ) ;
} else {
push @ fields , $ record - > leader ( ) ;
}
foreach my $ field ( @ fields ) {
my @ subfields_data ;
if ( $ tag < 10 ) {
my ( $ value , $ subfield ) ;
if ( $ tag ne '000' ) {
$ value = $ field - > data ( ) ;
$ subfield = "@" ;
} else {
$ value = $ field ;
$ subfield = '@' ;
}
next if ( $ tagslib - > { $ tag } - > { $ subfield } - > { tab } ne $ tabloop ) ;
# next if ($tagslib->{$tag}->{$subfield}->{kohafield} eq 'auth_header.authid');
push ( @ subfields_data , & create_input ( $ tag , $ subfield , $ value , $ i , $ tabloop , $ record , $ authorised_values_sth ) ) ;
$ i + + ;
} else {
my @ subfields = $ field - > subfields ( ) ;
foreach my $ subfieldcount ( 0 .. $# subfields ) {
my $ subfield = $ subfields [ $ subfieldcount ] [ 0 ] ;
my $ value = $ subfields [ $ subfieldcount ] [ 1 ] ;
next if ( length $ subfield != 1 ) ;
next if ( $ tagslib - > { $ tag } - > { $ subfield } - > { tab } ne $ tabloop ) ;
push ( @ subfields_data , & create_input ( $ tag , $ subfield , $ value , $ i , $ tabloop , $ record , $ authorised_values_sth ) ) ;
$ i + + ;
}
}
# now, loop again to add parameter subfield that are not in the MARC::Record
foreach my $ subfield ( sort ( keys % { $ tagslib - > { $ tag } } ) ) {
next if ( length $ subfield != 1 ) ;
next if ( $ tagslib - > { $ tag } - > { $ subfield } - > { tab } ne $ tabloop ) ;
next if ( $ tag < 10 ) ;
next if ( ( substr ( $ tagslib - > { $ tag } - > { $ subfield } - > { hidden } , 2 , 1 ) gt "1" ) ) ; #check for visibility flag
next if ( defined ( $ field - > subfield ( $ subfield ) ) ) ;
push ( @ subfields_data , & create_input ( $ tag , $ subfield , '' , $ i , $ tabloop , $ record , $ authorised_values_sth ) ) ;
$ i + + ;
}
if ( $# subfields_data >= 0 ) {
my % tag_data ;
$ tag_data { tag } = $ tag ;
$ tag_data { tag_lib } = $ tagslib - > { $ tag } - > { lib } ;
$ tag_data { repeatable } = $ tagslib - > { $ tag } - > { repeatable } ;
$ tag_data { indicator } = $ record - > field ( $ tag ) - > indicator ( 1 ) . $ record - > field ( $ tag ) - > indicator ( 2 ) if ( $ tag >= 10 ) ;
$ tag_data { subfield_loop } = \ @ subfields_data ;
if ( $ tag < 10 ) {
$ tag_data { fixedfield } = 1 ;
}
push ( @ loop_data , \ % tag_data ) ;
}
# If there is more than 1 field, add an empty hidden field as separator.
if ( $# fields >= 1 && $# loop_data >= 0 && $ loop_data [ $# loop_data ] - > { 'tag' } eq $ tag ) {
my @ subfields_data ;
my % tag_data ;
push ( @ subfields_data , & create_input ( '' , '' , '' , $ i , $ tabloop , $ record , $ authorised_values_sth ) ) ;
$ tag_data { tag } = '' ;
$ tag_data { tag_lib } = '' ;
$ tag_data { indicator } = '' ;
$ tag_data { subfield_loop } = \ @ subfields_data ;
if ( $ tag < 10 ) {
$ tag_data { fixedfield } = 1 ;
}
push ( @ loop_data , \ % tag_data ) ;
$ i + + ;
}
}
} else {
my @ subfields_data ;
foreach my $ subfield ( sort ( keys % { $ tagslib - > { $ tag } } ) ) {
next if ( length $ subfield != 1 ) ;
next if ( ( substr ( $ tagslib - > { $ tag } - > { $ subfield } - > { hidden } , 2 , 1 ) gt "1" ) ) ; #check for visibility flag
next if ( $ tagslib - > { $ tag } - > { $ subfield } - > { tab } ne $ tabloop ) ;
push ( @ subfields_data , & create_input ( $ tag , $ subfield , '' , $ i , $ tabloop , $ record , $ authorised_values_sth ) ) ;
$ i + + ;
}
if ( $# subfields_data >= 0 ) {
my % tag_data ;
$ tag_data { tag } = $ tag ;
$ tag_data { tag_lib } = $ tagslib - > { $ tag } - > { lib } ;
$ tag_data { repeatable } = $ tagslib - > { $ tag } - > { repeatable } ;
$ tag_data { indicator } = $ indicator ;
$ tag_data { subfield_loop } = \ @ subfields_data ;
$ tag_data { tagfirstsubfield } = $ tag_data { subfield_loop } [ 0 ] ;
if ( $ tag < 10 ) {
$ tag_data { fixedfield } = 1 ;
}
push ( @ loop_data , \ % tag_data ) ;
}
}
}
$ template - > param ( $ tabloop . "XX" = > \ @ loop_data ) ;
}
my $ authorised_values_sth = $ dbh - > prepare (
" select authorised_value , lib
from authorised_values
where category = ? order by lib "
) ;
# in this array, we will push all the 10 tabs
# to avoid having 10 tabs in the template : they will all be in the same BIG_LOOP
my @ BIG_LOOP ;
my % seen ;
my @ tab_data ; # all tags to display
foreach my $ used ( keys %$ tagslib ) {
push @ tab_data , $ used if not $ seen { $ used } ;
$ seen { $ used } + + ;
}
my $ max_num_tab = 9 ;
# loop through each tab 0 through 9
for ( my $ tabloop = 0 ; $ tabloop <= $ max_num_tab ; $ tabloop + + ) {
my @ loop_data = ( ) ; #innerloop in the template.
my $ i = 0 ;
foreach my $ tag ( @ tab_data ) {
$ i + + ;
next if ! $ tag ;
my $ indicator ;
my $ index_tag = CreateKey ;
# if MARC::Record is not empty =>use it as master loop, then add missing subfields that should be in the tab.
# if MARC::Record is empty => use tab as master loop.
if ( $ record ne - 1 && ( $ record - > field ( $ tag ) || $ tag eq '000' ) ) {
my @ fields ;
if ( $ tag ne '000' ) {
@ fields = $ record - > field ( $ tag ) ;
}
else {
push @ fields , $ record - > leader ( ) ; # if tag == 000
}
# loop through each field
foreach my $ field ( @ fields ) {
my @ subfields_data ;
if ( $ tag < 10 ) {
my ( $ value , $ subfield ) ;
if ( $ tag ne '000' ) {
$ value = $ field - > data ( ) ;
$ subfield = "@" ;
}
else {
$ value = $ field ;
$ subfield = '@' ;
}
next if ( $ tagslib - > { $ tag } - > { $ subfield } - > { tab } ne $ tabloop ) ;
next
if ( $ tagslib - > { $ tag } - > { $ subfield } - > { kohafield } eq
'biblio.biblionumber' ) ;
push (
@ subfields_data ,
& create_input (
$ tag , $ subfield , $ value , $ index_tag , $ tabloop , $ record ,
$ authorised_values_sth , $ input
)
) ;
}
else {
my @ subfields = $ field - > subfields ( ) ;
foreach my $ subfieldcount ( 0 .. $# subfields ) {
my $ subfield = $ subfields [ $ subfieldcount ] [ 0 ] ;
my $ value = $ subfields [ $ subfieldcount ] [ 1 ] ;
next if ( length $ subfield != 1 ) ;
next if ( $ tagslib - > { $ tag } - > { $ subfield } - > { tab } ne $ tabloop ) ;
push (
@ subfields_data ,
& create_input (
$ tag , $ subfield , $ value , $ index_tag , $ tabloop ,
$ record , $ authorised_values_sth , $ input
)
) ;
}
}
# now, loop again to add parameter subfield that are not in the MARC::Record
foreach my $ subfield ( sort ( keys % { $ tagslib - > { $ tag } } ) )
{
next if ( length $ subfield != 1 ) ;
next if ( $ tagslib - > { $ tag } - > { $ subfield } - > { tab } ne $ tabloop ) ;
next if ( $ tag < 10 ) ;
next
if ( ( $ tagslib - > { $ tag } - > { $ subfield } - > { hidden } <= - 4 )
or ( $ tagslib - > { $ tag } - > { $ subfield } - > { hidden } >= 5 )
) ; #check for visibility flag
next if ( defined ( $ field - > subfield ( $ subfield ) ) ) ;
push (
@ subfields_data ,
& create_input (
$ tag , $ subfield , '' , $ index_tag , $ tabloop , $ record ,
$ authorised_values_sth , $ input
)
) ;
}
if ( $# subfields_data >= 0 ) {
# build the tag entry.
# note that the random() field is mandatory. Otherwise, on repeated fields, you'll
# have twice the same "name" value, and cgi->param() will return only one, making
# all subfields to be merged in a single field.
my % tag_data = (
tag = > $ tag ,
index = > $ index_tag ,
tag_lib = > $ tagslib - > { $ tag } - > { lib } ,
repeatable = > $ tagslib - > { $ tag } - > { repeatable } ,
subfield_loop = > \ @ subfields_data ,
fixedfield = > ( $ tag < 10 ) ? ( 1 ) : ( 0 ) ,
random = > CreateKey ,
) ;
if ( $ tag >= 010 ) { # no indicator for theses tag
$ tag_data { indicator } = $ field - > indicator ( 1 ) . $ field - > indicator ( 2 ) ;
}
push ( @ loop_data , \ % tag_data ) ;
}
} # foreach $field end
# if breeding is empty
}
else {
my @ subfields_data ;
foreach my $ subfield ( sort ( keys % { $ tagslib - > { $ tag } } ) ) {
next if ( length $ subfield != 1 ) ;
next
if ( ( $ tagslib - > { $ tag } - > { $ subfield } - > { hidden } <= - 5 )
or ( $ tagslib - > { $ tag } - > { $ subfield } - > { hidden } >= 4 ) )
; #check for visibility flag
next
if ( $ tagslib - > { $ tag } - > { $ subfield } - > { tab } ne $ tabloop ) ;
push (
@ subfields_data ,
& create_input (
$ tag , $ subfield , '' , $ index_tag , $ tabloop , $ record ,
$ authorised_values_sth , $ input
)
) ;
}
if ( $# subfields_data >= 0 ) {
my % tag_data = (
tag = > $ tag ,
index = > $ index_tag ,
tag_lib = > $ tagslib - > { $ tag } - > { lib } ,
repeatable = > $ tagslib - > { $ tag } - > { repeatable } ,
indicator = > $ indicator ,
subfield_loop = > \ @ subfields_data ,
tagfirstsubfield = > $ subfields_data [ 0 ] ,
fixedfield = > ( $ tag < 10 ) ? ( 1 ) : ( 0 )
) ;
push @ loop_data , \ % tag_data ;
}
}
}
if ( $# loop_data >= 0 ) {
push @ BIG_LOOP , {
number = > $ tabloop ,
innerloop = > \ @ loop_data ,
} ;
}
}
$ template - > param ( singletab = > ( scalar ( @ BIG_LOOP ) == 1 ) , BIG_LOOP = > \ @ BIG_LOOP ) ;
}
@ -382,10 +565,23 @@ 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 , 'UNIMARCAUTH' ) ;
# warn $record->as_formatted;
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' ) ;
my @ params = $ input - > param ( ) ;
my $ record = TransformHtmlToMarc ( \ @ params , $ input ) ;
if ( C4::Context - > preference ( "marcflavour" ) eq "UNIMARC" ) {
unless ( $ record - > field ( '100' ) ) {
use POSIX qw( strftime ) ;
my $ string = strftime ( "%Y%m%d" , localtime ( time ) ) ;
# set 50 to position 26 is biblios, 13 if authorities
my $ pos = 13 ;
$ string = sprintf ( "%-*s" , 35 , $ string ) ;
substr ( $ string , $ pos , 2 , "50" ) ;
$ record - > append_fields ( MARC::Field - > new ( '100' , '' , '' , "a" = > $ string ) ) ;
}
}
# warn $record->as_formatted;
# 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;
# check for a duplicate
my ( $ duplicateauthid , $ duplicateauthvalue ) = FindDuplicateAuthority ( $ record , $ authtypecode ) if ( $ op eq "add" ) && ( ! $ is_a_modif ) ;
@ -402,35 +598,35 @@ 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 , $ input ) ;
build_hidden_data ;
$ template - > param ( authid = > $ authid ,
duplicateauthid = > $ duplicateauthid ,
duplicateauthvalue = > $ duplicateauthvalue ,
) ;
}
#------------------------------------------------------------------------------------------------------------------------------
} elsif ( $ op eq "addfield" ) {
#------------------------------------------------------------------------------------------------------------------------------
my $ addedfield = $ input - > param ( 'addfield_field' ) ;
my $ tagaddfield_subfield = $ input - > param ( 'addfield_subfield' ) ;
my @ tags = $ input - > param ( 'tag' ) ;
my @ subfields = $ input - > param ( 'subfield' ) ;
my @ values = $ input - > param ( 'field_value' ) ;
# 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 $ record = MARC::Record - > new_from_xml ( $ xml , 'UTF-8' ) ;
$ record - > encoding ( 'UTF-8' ) ;
# adding an empty field
my $ field = MARC::Field - > new ( "$addedfield" , '' , '' , '$tagaddfield_subfield' = > "" ) ;
$ record - > append_fields ( $ field ) ;
build_tabs ( $ template , $ record , $ dbh , $ encoding ) ;
build_hidden_data ;
$ template - > param (
authid = > $ authid , ) ;
# # ------------------------------------------------------------------------------------------------------------------------------
# } elsif ($op eq "addfield") {
# # ------------------------------------------------------------------------------------------------------------------------------
# my $addedfield = $input->param('addfield_field') ;
# my $tagaddfield_subfield = $input->param('addfield_subfield') ;
# my @tags = $input->param('tag') ;
# my @subfields = $input->param('subfield') ;
# my @values = $input->param('field_value') ;
# # 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 $record=MARC::Record->new_from_xml($xml,'UTF-8') ;
# $record->encoding('UTF-8') ;
# # adding an empty field
# my $field = MARC::Field->new("$addedfield",'','','$tagaddfield_subfield' => "") ;
# $record->append_fields($field) ;
# build_tabs ($template, $record, $dbh,$encoding,$input) ;
# build_hidden_data ;
# $template->param (
# authid => $authid,) ;
#
} elsif ( $ op eq "delete" ) {
#------------------------------------------------------------------------------------------------------------------------------
& AUTHdelauthority ( $ authid ) ;
@ -445,7 +641,7 @@ if ($op eq "duplicate")
{
$ authid = "" ;
}
build_tabs ( $ template , $ record , $ dbh , $ encoding ) ;
build_tabs ( $ template , $ record , $ dbh , $ encoding , $ input ) ;
build_hidden_data ;
$ template - > param ( oldauthtypetagfield = > $ oldauthtypetagfield , oldauthtypetagsubfield = > $ oldauthtypetagsubfield ,
oldauthnumtagfield = > $ oldauthnumtagfield , oldauthnumtagsubfield = > $ oldauthnumtagsubfield ,
Paul POULAIN
17 years ago
Joshua Ferraro