cataloguing/value_builder/macles.pl

   1 #!/usr/bin/perl
   2
   3
   4 # Copyright 2000-2002 Katipo Communications
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it under the
   9 # terms of the GNU General Public License as published by the Free Software
  10 # Foundation; either version 2 of the License, or (at your option) any later
  11 # version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License along
  18 # with Koha; if not, write to the Free Software Foundation, Inc.,
  19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  20
  21 use strict;
  22 #use warnings; FIXME - Bug 2505
  23 use CGI;
  24 use C4::Context;
  25 use C4::Output;
  26 use C4::Auth;
  27
  28 # use Data::Dumper;
  29 use vars qw( $tagslib);
  30 use vars qw( $authorised_values_sth);
  31 use vars qw( $is_a_modif );
  32 use utf8;
  33
  34 =head1
  35
  36 plugin_parameters : other parameters added when the plugin is called by the dopop function
  37
  38 =cut
  39
  40 sub plugin_parameters {
  41 my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
  42 return "";
  43 }
  44
  45 sub plugin_javascript {
  46 my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
  47 my $function_name= "macles".(int(rand(100000))+1);
  48 my $res="
  49 <script type=\"text/javascript\">
  50 //<![CDATA[
  51
  52 function Focus$function_name(subfield_managed) {
  53 return 1;
  54 }
  55
  56 function Blur$function_name(subfield_managed) {
  57         return 1;
  58 }
  59
  60 function Clic$function_name(i) {
  61         newin=window.open(\"../cataloguing/plugin_launcher.pl?plugin_name=macles.pl&index=\"+i,\"MACLES\",',toolbar=false,scrollbars=yes');
  62
  63 }
  64 //]]>
  65 </script>
  66 ";
  67
  68 return ($function_name,$res);
  69 }
  70
  71 sub plugin {
  72 my ($input) = @_;
  73         my %env;
  74
  75 #       my $input = new CGI;
  76         my $index= $input->param('index');
  77
  78
  79         my $dbh = C4::Context->dbh;
  80     my $rq=$dbh->prepare("SELECT authorised_value, lib from authorised_values where category=\"MACLES\" order by authorised_value DESC");
  81     #tabs
  82     $rq->execute;
  83     my @BIGLOOP;
  84     my @innerloop;
  85     my (%numbers,%cells,@colhdr,@rowhdr,@multiplelines,@lists,$table);
  86     while (my $tab = $rq->fetchrow_hashref){
  87 #       if (! utf8::is_utf8($tab->{lib})) {
  88 #         utf8::decode($tab->{lib});
  89 #       }
  90 #       warn $tab->{lib};
  91       my $number=substr($tab->{authorised_value},0,1);
  92       if ($tab->{authorised_value}=~/[0-9]XX/){
  93         $numbers{$number}->{'hdr_tab'}=$tab->{lib};
  94         $numbers{$number}->{'Table'}=($number=~/[1-7]/);
  95       } elsif ($tab->{authorised_value}=~/.X./){
  96         $tab->{authorised_value}=~s/X/\./;
  97         $table=1;
  98         unshift @{$numbers{$number}->{"col_hdr"}},{"colvalue"=>$tab->{authorised_value},"collib"=>$tab->{lib}};
  99       } elsif ($tab->{authorised_value}=~/..X/){
 100         $tab->{authorised_value}=~s/X/\./;
 101         unshift @{$numbers{$number}->{"row_hdr"}},{"rowvalue"=>$tab->{authorised_value},"rowlib"=>$tab->{lib}}
 102       } elsif ($tab->{'authorised_value'}=~/,/){
 103         my @listval=split /,/,$tab->{'authorised_value'};
 104 #          $tab->{authorised_value}=~s/,/","/g;
 105 #         $tab->{authorised_value}="(".$tab->{authorised_value}.")";
 106         my %mulrows;
 107         foreach my $val (@listval){
 108           unshift @{$numbers{$number}->{$val}},$tab->{'lib'};
 109           my $mulrow=substr($val,0,2);
 110           $mulrows{$mulrow}=1;
 111         }
 112         foreach my $mulrow (sort keys %mulrows){
 113           unshift @{$numbers{$number}->{$mulrow}},{'listlib' => $tab->{'lib'},'listvalue' => $tab->{'authorised_value'}};
 114         }
 115       } else {
 116         unshift @{$numbers{$number}->{$tab->{'authorised_value'}}},$tab->{'lib'};
 117       }
 118 #        use Data::Dumper;warn "BIGLOOP IN".Dumper(@BIGLOOP);
 119     }
 120     foreach my $num (sort keys %numbers){
 121       my @tmpcolhdr = @{$numbers{$num}->{'col_hdr'}} if ($numbers{$num}->{'col_hdr'});
 122       my @tmprowhdr = @{$numbers{$num}->{"row_hdr"}} if ($numbers{$num}->{'row_hdr'});
 123       my @lines;
 124       my @lists;
 125       my %BIGLOOPcell;
 126       foreach my $row (@tmprowhdr){
 127         my $tmprowvalue=$row->{rowvalue};
 128         my $rowcode=$1 if $tmprowvalue=~/[0-9]([0-9])\./;
 129         my @cells;
 130         if (scalar(@tmpcolhdr)>0){
 131         #cas du tableau bidim
 132           foreach my $col (@tmpcolhdr){
 133             my $tmpcolvalue=$col->{colvalue};
 134             my $colcode=$1 if $tmpcolvalue=~/[0-9]\.([0-9])/;
 135             my %cell;
 136             $cell{celvalue}=$num.$rowcode.$colcode;
 137             $cell{rowvalue}=$tmprowvalue;
 138             $cell{colvalue}=$tmpcolvalue;
 139             if ($numbers{$num}->{$num.$rowcode.$colcode}){
 140               foreach (@{$numbers{$num}->{$num.$rowcode.$colcode}}){
 141                 push @{$cell{libs}},{'lib'=>$_};
 142               }
 143             }else {
 144               push @{$cell{libs}},{'lib'=>$num.$rowcode.$colcode};
 145             }
 146             push @cells,\%cell;
 147           }
 148           if ($numbers{$num}->{$num.$rowcode}){
 149             my @tmpliblist=@{$numbers{$num}->{$num.$rowcode}};
 150             push @lists,{'lib'=>$row->{rowlib},'liblist'=>\@tmpliblist};
 151           }
 152         } else {
 153         #Cas de la liste simple
 154           foreach my $key (sort keys %{$numbers{$num}}){
 155             my %cell;
 156             if ($key=~/$num$rowcode[0-9]/){
 157               $cell{celvalue}=$key;
 158               foreach my $lib (@{$numbers{$num}->{$key}}){
 159                 push @{$cell{'libs'}},{'lib'=>$lib};
 160               }
 161               push @cells,\%cell;
 162             }
 163           }
 164         }
 165         push @lines,{'cells'=>\@cells,'rowvalue'=>$row->{rowvalue},'rowlib'=>$row->{rowlib}};
 166       }
 167       $BIGLOOPcell{'Lists'}=\@lists if (scalar(@lists)>0);
 168       $BIGLOOPcell{'lines'}=\@lines if (scalar(@lines)>0);
 169       $BIGLOOPcell{'col_hdr'}=\@tmpcolhdr if (scalar(@tmpcolhdr)>0);
 170       $BIGLOOPcell{'Table'}=$numbers{$num}->{'Table'};
 171       $BIGLOOPcell{'hdr_tab'}=$numbers{$num}->{'hdr_tab'};
 172       $BIGLOOPcell{'number'}=$num;
 173       push @BIGLOOP,\%BIGLOOPcell;
 174     }
 175 #     warn "BIGLOOP OUT".Dumper(@BIGLOOP);
 176     my ($template, $loggedinuser, $cookie)
 177         = get_template_and_user({template_name => "cataloguing/value_builder/macles.tmpl",
 178                     query => $input,
 179                     type => "intranet",
 180                     authnotrequired => 0,
 181                     flagsrequired => {editcatalogue => '*'},
 182                     debug => 1,
 183                     });
 184     $template->param(BIGLOOP=>\@BIGLOOP);
 185         $template->param("index"=>$index);
 186         output_html_with_http_headers $input, $cookie, $template->output;
 187 }
 188 1;
 189
 190