Minor SIP cleanup, conditionalize warnings.
[koha.git] / admin / marc_subfields_structure.pl
1 #!/usr/bin/perl
2
3 # Copyright 2000-2002 Katipo Communications
4 #
5 # This file is part of Koha.
6 #
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
10 # version.
11 #
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA  02111-1307 USA
19
20 use strict;
21 use C4::Output;
22 use C4::Auth;
23 use CGI;
24 use C4::Context;
25
26
27 sub StringSearch {
28     my ( $searchstring, $frameworkcode ) = @_;
29     my $dbh = C4::Context->dbh;
30     $searchstring =~ s/\'/\\\'/g;
31     my @data  = split( ' ', $searchstring );
32     my $count = @data;
33     my $sth   =
34       $dbh->prepare(
35 "Select * from marc_subfield_structure where (tagfield like ? and frameworkcode=?) order by tagfield"
36       );
37     $sth->execute( "$searchstring%", $frameworkcode );
38     my @results;
39     my $cnt = 0;
40     my $u   = 1;
41
42     while ( my $data = $sth->fetchrow_hashref ) {
43         push( @results, $data );
44         $cnt++;
45         $u++;
46     }
47     $sth->finish;
48     $dbh->disconnect;
49     return ( $cnt, \@results );
50 }
51
52 my $input         = new CGI;
53 my $tagfield      = $input->param('tagfield');
54 my $tagsubfield   = $input->param('tagsubfield');
55 my $frameworkcode = $input->param('frameworkcode');
56 my $pkfield       = "tagfield";
57 my $offset        = $input->param('offset');
58 my $script_name   = "/cgi-bin/koha/admin/marc_subfields_structure.pl";
59
60 my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
61     {
62         template_name   => "admin/marc_subfields_structure.tmpl",
63         query           => $input,
64         type            => "intranet",
65         authnotrequired => 0,
66         flagsrequired   => { parameters => 1 },
67         debug           => 1,
68     }
69 );
70 my $pagesize = 30;
71 my $op       = $input->param('op');
72 $tagfield =~ s/\,//g;
73
74 if ($op) {
75     $template->param(
76         script_name   => $script_name,
77         tagfield      => $tagfield,
78         frameworkcode => $frameworkcode,
79         $op           => 1
80     );    # we show only the TMPL_VAR names $op
81 }
82 else {
83     $template->param(
84         script_name   => $script_name,
85         tagfield      => $tagfield,
86         frameworkcode => $frameworkcode,
87         else          => 1
88     );    # we show only the TMPL_VAR names $op
89 }
90
91 ################## ADD_FORM ##################################
92 # called by default. Used to create form to add or  modify a record
93 if ( $op eq 'add_form' ) {
94     my $data;
95     my $dbh            = C4::Context->dbh;
96     my $more_subfields = $input->param("more_subfields") + 1;
97
98     # builds kohafield tables
99     my @kohafields;
100     push @kohafields, "";
101     my $sth2 = $dbh->prepare("SHOW COLUMNS from biblio");
102     $sth2->execute;
103     while ( ( my $field ) = $sth2->fetchrow_array ) {
104         push @kohafields, "biblio." . $field;
105     }
106     $sth2 = $dbh->prepare("SHOW COLUMNS from biblioitems");
107     $sth2->execute;
108     while ( ( my $field ) = $sth2->fetchrow_array ) {
109         if ( $field eq 'notes' ) { $field = 'bnotes'; }
110         push @kohafields, "biblioitems." . $field;
111     }
112     $sth2 = $dbh->prepare("SHOW COLUMNS from items");
113     $sth2->execute;
114     while ( ( my $field ) = $sth2->fetchrow_array ) {
115         push @kohafields, "items." . $field;
116     }
117
118     # build authorised value list
119     $sth2->finish;
120     $sth2 = $dbh->prepare("select distinct category from authorised_values");
121     $sth2->execute;
122     my @authorised_values;
123     push @authorised_values, "";
124     while ( ( my $category ) = $sth2->fetchrow_array ) {
125         push @authorised_values, $category;
126     }
127     push( @authorised_values, "branches" );
128     push( @authorised_values, "itemtypes" );
129     push( @authorised_values, "cn_source" );
130
131     # build thesaurus categories list
132     $sth2->finish;
133     $sth2 = $dbh->prepare("select authtypecode from auth_types");
134     $sth2->execute;
135     my @authtypes;
136     push @authtypes, "";
137     while ( ( my $authtypecode ) = $sth2->fetchrow_array ) {
138         push @authtypes, $authtypecode;
139     }
140
141     # build value_builder list
142     my @value_builder = ('');
143
144     # read value_builder directory.
145     # 2 cases here : on CVS install, $cgidir does not need a /cgi-bin
146     # on a standard install, /cgi-bin need to be added.
147     # test one, then the other
148     my $cgidir = C4::Context->intranetdir . "/cgi-bin";
149     unless ( opendir( DIR, "$cgidir/cataloguing/value_builder" ) ) {
150         $cgidir = C4::Context->intranetdir;
151         opendir( DIR, "$cgidir/cataloguing/value_builder" )
152           || die "can't opendir $cgidir/value_builder: $!";
153     }
154     while ( my $line = readdir(DIR) ) {
155         if ( $line =~ /\.pl$/ ) {
156             push( @value_builder, $line );
157         }
158     }
159     @value_builder= sort {$a cmp $b} @value_builder;
160     closedir DIR;
161
162     # build values list
163     my $sth =
164       $dbh->prepare(
165 "select * from marc_subfield_structure where tagfield=? and frameworkcode=?"
166       );    # and tagsubfield='$tagsubfield'");
167     $sth->execute( $tagfield, $frameworkcode );
168     my @loop_data = ();
169     my $toggle    = 1;
170     my $i         = 0;
171     while ( $data = $sth->fetchrow_hashref ) {
172         my %row_data;    # get a fresh hash for the row data
173         if ( $toggle eq 1 ) {
174             $toggle = 0;
175         }
176         else {
177             $toggle = 1;
178         }
179         $row_data{defaultvalue} = $data->{defaultvalue};
180         $row_data{tab} = CGI::scrolling_list(
181             -name   => 'tab',
182             -id     => "tab$i",
183             -values =>
184               [ '-1', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '10' ],
185             -labels => {
186                 '-1' => 'ignore',
187                 '0'  => '0',
188                 '1'  => '1',
189                 '2'  => '2',
190                 '3'  => '3',
191                 '4'  => '4',
192                 '5'  => '5',
193                 '6'  => '6',
194                 '7'  => '7',
195                 '8'  => '8',
196                 '9'  => '9',
197                 '10' => 'items (10)',
198             },
199             -default  => $data->{'tab'},
200             -size     => 1,
201             -tabindex => '',
202             -multiple => 0,
203         );
204         $row_data{tagsubfield} =
205             $data->{'tagsubfield'}
206           . "<input type=\"hidden\" name=\"tagsubfield\" value=\""
207           . $data->{'tagsubfield'}
208           . "\" id=\"tagsubfield\" />";
209         $row_data{subfieldcode} = $data->{'tagsubfield'} eq '@'?'_':$data->{'tagsubfield'};
210         $row_data{urisubfieldcode} = $row_data{subfieldcode} eq '%' ? 'pct' : $row_data{subfieldcode};
211         $row_data{liblibrarian} = CGI::escapeHTML( $data->{'liblibrarian'} );
212         $row_data{libopac}      = CGI::escapeHTML( $data->{'libopac'} );
213         $row_data{seealso}      = CGI::escapeHTML( $data->{'seealso'} );
214         $row_data{kohafield}    = CGI::scrolling_list(
215             -name     => "kohafield",
216             -id       => "kohafield$i",
217             -values   => \@kohafields,
218             -default  => "$data->{'kohafield'}",
219             -size     => 1,
220             -tabindex => '',
221             -multiple => 0,
222         );
223         $row_data{authorised_value} = CGI::scrolling_list(
224             -name     => 'authorised_value',
225             -id       => 'authorised_value',
226             -values   => \@authorised_values,
227             -default  => $data->{'authorised_value'},
228             -size     => 1,
229             -tabindex => '',
230             -multiple => 0,
231         );
232         $row_data{value_builder} = CGI::scrolling_list(
233             -name     => 'value_builder',
234             -id       => 'value_builder',
235             -values   => \@value_builder,
236             -default  => $data->{'value_builder'},
237             -size     => 1,
238             -tabindex => '',
239             -multiple => 0,
240         );
241         $row_data{authtypes} = CGI::scrolling_list(
242             -name     => 'authtypecode',
243             -id       => 'authtypecode',
244             -values   => \@authtypes,
245             -default  => $data->{'authtypecode'},
246             -size     => 1,
247             -tabindex => '',
248             -multiple => 0,
249         );
250         $row_data{repeatable} = CGI::checkbox(
251             -name     => "repeatable$i",
252             -checked  => $data->{'repeatable'} ? 'checked' : '',
253             -value    => 1,
254             -tabindex => '',
255             -label    => '',
256             -id       => "repeatable$i"
257         );
258         $row_data{mandatory} = CGI::checkbox(
259             -name     => "mandatory$i",
260             -checked  => $data->{'mandatory'} ? 'checked' : '',
261             -value    => 1,
262             -tabindex => '',
263             -label    => '',
264             -id       => "mandatory$i"
265         );
266         $row_data{hidden} = CGI::escapeHTML( $data->{hidden} );
267         $row_data{isurl}  = CGI::checkbox(
268             -name     => "isurl$i",
269             -id       => "isurl$i",
270             -checked  => $data->{'isurl'} ? 'checked' : '',
271             -value    => 1,
272             -tabindex => '',
273             -label    => ''
274         );
275         $row_data{row}    = $i;
276         $row_data{toggle} = $toggle;
277         $row_data{link}   = CGI::escapeHTML( $data->{'link'} ); 
278         push( @loop_data, \%row_data );
279         $i++;
280     }
281
282     # add more_subfields empty lines for add if needed
283     for ( my $j = 1 ; $j <= 1 ; $j++ ) {
284         my %row_data;    # get a fresh hash for the row data
285         $row_data{'new_subfield'} = 1;
286         $row_data{'subfieldcode'} = '';
287
288         $row_data{tab} = CGI::scrolling_list(
289             -name   => 'tab',
290             -id     => "tab$j",
291             -values =>
292               [ '-1', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '10' ],
293             -labels => {
294                 '-1' => 'ignore',
295                 '0'  => '0',
296                 '1'  => '1',
297                 '2'  => '2',
298                 '3'  => '3',
299                 '4'  => '4',
300                 '5'  => '5',
301                 '6'  => '6',
302                 '7'  => '7',
303                 '8'  => '8',
304                 '9'  => '9',
305                 '10' => 'items (10)',
306             },
307             -default  => "",
308             -size     => 1,
309             -tabindex => '',
310             -multiple => 0,
311         );
312         $row_data{tagsubfield} =
313             "<input type=\"text\" name=\"tagsubfield\" value=\""
314           . $data->{'tagsubfield'}
315           . "\" size=\"1\" id=\"tagsubfield\" maxlength=\"1\" />";
316         $row_data{liblibrarian} = "";
317         $row_data{libopac}      = "";
318         $row_data{seealso}      = "";
319         $row_data{kohafield}    = CGI::scrolling_list(
320             -name     => 'kohafield',
321             -id       => "kohafield$j",
322             -values   => \@kohafields,
323             -default  => "",
324             -size     => 1,
325             -tabindex => '',
326             -multiple => 0,
327         );
328         $row_data{hidden}     = "";
329         $row_data{repeatable} = CGI::checkbox(
330             -name     => "repeatable$j",
331             -id       => "repeatable$j",
332             -checked  => '',
333             -value    => 1,
334             -tabindex => '',
335             -label    => ''
336         );
337         $row_data{mandatory} = CGI::checkbox(
338             -name     => "mandatory$j",
339             -id       => "mandatory$j",
340             -checked  => '',
341             -value    => 1,
342             -tabindex => '',
343             -label    => ''
344         );
345         $row_data{isurl} = CGI::checkbox(
346             -name     => "isurl$j",
347             -id       => "isurl$j",
348             -checked  => '',
349             -value    => 1,
350             -tabindex => '',
351             -label    => ''
352         );
353         $row_data{value_builder} = CGI::scrolling_list(
354             -name     => 'value_builder',
355             -id       => 'value_builder',
356             -values   => \@value_builder,
357             -default  => $data->{'value_builder'},
358             -size     => 1,
359             -tabindex => '',
360             -multiple => 0,
361         );
362         $row_data{authorised_value} = CGI::scrolling_list(
363             -name     => 'authorised_value',
364             -id       => 'authorised_value',
365             -values   => \@authorised_values,
366             -size     => 1,
367             -tabindex => '',
368             -multiple => 0,
369         );
370         $row_data{authtypes} = CGI::scrolling_list(
371             -name     => 'authtypecode',
372             -id       => 'authtypecode',
373             -values   => \@authtypes,
374             -size     => 1,
375             -tabindex => '',
376             -multiple => 0,
377         );
378         $row_data{link}   = CGI::escapeHTML( $data->{'link'} );
379         $row_data{toggle} = $toggle;
380         $row_data{row}    = $j;
381         push( @loop_data, \%row_data );
382         use Data::Dumper;
383     }
384     $template->param( 'use-heading-flags-p'      => 1 );
385     $template->param( 'heading-edit-subfields-p' => 1 );
386     $template->param(
387         action   => "Edit subfields",
388         tagfield => $tagfield,
389         loop           => \@loop_data,
390         more_subfields => $more_subfields,
391         more_tag       => $tagfield
392     );
393
394     # END $OP eq ADD_FORM
395 ################## ADD_VALIDATE ##################################
396     # called by add_form, used to insert/modify data in DB
397 }
398 elsif ( $op eq 'add_validate' ) {
399     my $dbh = C4::Context->dbh;
400     $template->param( tagfield => "$input->param('tagfield')" );
401     my $sth = $dbh->prepare(
402 "replace marc_subfield_structure (tagfield,tagsubfield,liblibrarian,libopac,repeatable,mandatory,kohafield,tab,seealso,authorised_value,authtypecode,value_builder,hidden,isurl,frameworkcode, link,defaultvalue)
403                                     values (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
404     );
405     my @tagsubfield       = $input->param('tagsubfield');
406     my @liblibrarian      = $input->param('liblibrarian');
407     my @libopac           = $input->param('libopac');
408     my @kohafield         = $input->param('kohafield');
409     my @tab               = $input->param('tab');
410     my @seealso           = $input->param('seealso');
411     my @hidden            = $input->param('hidden');
412     my @authorised_values = $input->param('authorised_value');
413     my @authtypecodes     = $input->param('authtypecode');
414     my @value_builder     = $input->param('value_builder');
415     my @link              = $input->param('link');
416     my @defaultvalue      = $input->param('defaultvalue');
417     
418     for ( my $i = 0 ; $i <= $#tagsubfield ; $i++ ) {
419         my $tagfield    = $input->param('tagfield');
420         my $tagsubfield = $tagsubfield[$i];
421         $tagsubfield = "@" unless $tagsubfield ne '';
422         $tagsubfield = "@" if $tagsubfield eq '_';
423         my $liblibrarian     = $liblibrarian[$i];
424         my $libopac          = $libopac[$i];
425         my $repeatable       = $input->param("repeatable$i") ? 1 : 0;
426         my $mandatory        = $input->param("mandatory$i") ? 1 : 0;
427         my $kohafield        = $kohafield[$i];
428         my $tab              = $tab[$i];
429         my $seealso          = $seealso[$i];
430         my $authorised_value = $authorised_values[$i];
431         my $authtypecode     = $authtypecodes[$i];
432         my $value_builder    = $value_builder[$i];
433         my $hidden = $hidden[$i];                     #input->param("hidden$i");
434         my $isurl  = $input->param("isurl$i") ? 1 : 0;
435         my $link   = $link[$i];
436         my $defaultvalue = $defaultvalue[$i];
437         
438         if ($liblibrarian) {
439             unless ( C4::Context->config('demo') eq 1 ) {
440                 $sth->execute(
441                     $tagfield,
442                     $tagsubfield,
443                     $liblibrarian,
444                     $libopac,
445                     $repeatable,
446                     $mandatory,
447                     $kohafield,
448                     $tab,
449                     $seealso,
450                     $authorised_value,
451                     $authtypecode,
452                     $value_builder,
453                     $hidden,
454                     $isurl,
455                     $frameworkcode,
456                     $link,
457                     $defaultvalue,
458                 );
459             }
460         }
461     }
462     $sth->finish;
463     print
464 "Content-Type: text/html\n\n<META HTTP-EQUIV=Refresh CONTENT=\"0; URL=marc_subfields_structure.pl?tagfield=$tagfield&frameworkcode=$frameworkcode\"></html>";
465     exit;
466
467     # END $OP eq ADD_VALIDATE
468 ################## DELETE_CONFIRM ##################################
469     # called by default form, used to confirm deletion of data in DB
470 }
471 elsif ( $op eq 'delete_confirm' ) {
472     my $dbh = C4::Context->dbh;
473     my $sth =
474       $dbh->prepare(
475 "select * from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?"
476       );
477
478     $sth->execute( $tagfield, $tagsubfield, $frameworkcode );
479     my $data = $sth->fetchrow_hashref;
480     $sth->finish;
481     $template->param(
482         liblibrarian  => $data->{'liblibrarian'},
483         tagsubfield   => $data->{'tagsubfield'},
484         delete_link   => $script_name,
485         tagfield      => $tagfield,
486         tagsubfield   => $tagsubfield,
487         frameworkcode => $frameworkcode,
488     );
489
490     # END $OP eq DELETE_CONFIRM
491 ################## DELETE_CONFIRMED ##################################
492   # called by delete_confirm, used to effectively confirm deletion of data in DB
493 }
494 elsif ( $op eq 'delete_confirmed' ) {
495     my $dbh = C4::Context->dbh;
496     unless ( C4::Context->config('demo') eq 1 ) {
497         my $sth =
498           $dbh->prepare(
499 "delete from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?"
500           );
501         $sth->execute( $tagfield, $tagsubfield, $frameworkcode );
502         $sth->finish;
503     }
504     print
505 "Content-Type: text/html\n\n<META HTTP-EQUIV=Refresh CONTENT=\"0; URL=marc_subfields_structure.pl?tagfield=$tagfield&frameworkcode=$frameworkcode\"></html>";
506     exit;
507     $template->param( tagfield => $tagfield );
508
509     # END $OP eq DELETE_CONFIRMED
510 ################## DEFAULT ##################################
511 }
512 else {    # DEFAULT
513     my ( $count, $results ) = StringSearch( $tagfield, $frameworkcode );
514     my $toggle    = 1;
515     my @loop_data = ();
516     for (
517         my $i = $offset ;
518         $i < ( $offset + $pagesize < $count ? $offset + $pagesize : $count ) ;
519         $i++
520       )
521     {
522         if ( $toggle eq 1 ) {
523             $toggle = 0;
524         }
525         else {
526             $toggle = 1;
527         }
528         my %row_data;    # get a fresh hash for the row data
529         $row_data{tagfield}         = $results->[$i]{'tagfield'};
530         $row_data{tagsubfield}      = $results->[$i]{'tagsubfield'};
531         $row_data{liblibrarian}     = $results->[$i]{'liblibrarian'};
532         $row_data{kohafield}        = $results->[$i]{'kohafield'};
533         $row_data{repeatable}       = $results->[$i]{'repeatable'};
534         $row_data{mandatory}        = $results->[$i]{'mandatory'};
535         $row_data{tab}              = $results->[$i]{'tab'};
536         $row_data{seealso}          = $results->[$i]{'seealso'};
537         $row_data{authorised_value} = $results->[$i]{'authorised_value'};
538         $row_data{authtypecode}     = $results->[$i]{'authtypecode'};
539         $row_data{value_builder}    = $results->[$i]{'value_builder'};
540         $row_data{hidden}           = $results->[$i]{'hidden'};
541         $row_data{isurl}            = $results->[$i]{'isurl'};
542         $row_data{link}             = $results->[$i]{'link'};
543         $row_data{delete}           =
544 "$script_name?op=delete_confirm&amp;tagfield=$tagfield&amp;tagsubfield="
545           . $results->[$i]{'tagsubfield'}
546           . "&amp;frameworkcode=$frameworkcode";
547         $row_data{toggle} = $toggle;
548
549         if ( $row_data{tab} eq -1 ) {
550             $row_data{subfield_ignored} = 1;
551         }
552
553         push( @loop_data, \%row_data );
554     }
555     $template->param( loop => \@loop_data );
556     $template->param(
557         edit_tagfield      => $tagfield,
558         edit_frameworkcode => $frameworkcode
559     );
560
561     if ( $offset > 0 ) {
562         my $prevpage = $offset - $pagesize;
563         $template->param(
564             prev => "<a href=\"$script_name?offset=$prevpage\&tagfield=$tagfield\&frameworkcode=$frameworkcode \">" );
565     }
566     if ( $offset + $pagesize < $count ) {
567         my $nextpage = $offset + $pagesize;
568         $template->param(
569             next => "<a href=\"$script_name?offset=$nextpage\&tagfield=$tagfield\&frameworkcode=$frameworkcode \">" );
570     }
571 }    #---- END $OP eq DEFAULT
572
573 output_html_with_http_headers $input, $cookie, $template->output;