C4/Output.pm

   1 package C4::Output;
   2
   3 #package to deal with marking up output
   4 #You will need to edit parts of this pm
   5 #set the value of path to be where your html lives
   6
   7
   8 # Copyright 2000-2002 Katipo Communications
   9 #
  10 # This file is part of Koha.
  11 #
  12 # Koha is free software; you can redistribute it and/or modify it under the
  13 # terms of the GNU General Public License as published by the Free Software
  14 # Foundation; either version 2 of the License, or (at your option) any later
  15 # version.
  16 #
  17 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  18 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  19 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  20 #
  21 # You should have received a copy of the GNU General Public License along with
  22 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  23 # Suite 330, Boston, MA  02111-1307 USA
  24
  25 use strict;
  26 require Exporter;
  27
  28 use C4::Database;
  29
  30 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  31
  32 # set the version for version checking
  33 $VERSION = 0.01;
  34
  35 @ISA = qw(Exporter);
  36 @EXPORT = qw(&startpage &endpage
  37              &mktablehdr &mktableft &mktablerow &mklink
  38              &startmenu &endmenu &mkheadr
  39              &center &endcenter
  40              &mkform &mkform2 &bold
  41              &gotopage &mkformnotable &mkform3
  42              &getkeytableselectoptions
  43              &picktemplate);
  44 %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
  45
  46 # your exported package globals go here,
  47 # as well as any optionally exported functions
  48
  49 @EXPORT_OK   = qw($Var1 %Hashit);
  50
  51
  52 # non-exported package globals go here
  53 use vars qw(@more $stuff);
  54
  55 # initalize package globals, first exported ones
  56
  57 my $Var1   = '';
  58 my %Hashit = ();
  59
  60
  61 # then the others (which are still accessible as $Some::Module::stuff)
  62 my $stuff  = '';
  63 my @more   = ();
  64
  65 # all file-scoped lexicals must be created before
  66 # the functions below that use them.
  67
  68 #
  69 # Change this value to reflect where you will store your includes
  70 #
  71 my %configfile;
  72 open (KC, "/etc/koha.conf");
  73 while (<KC>) {
  74     chomp;
  75     (next) if (/^\s*#/);
  76     if (/(.*)\s*=\s*(.*)/) {
  77         my $variable=$1;
  78         my $value=$2;
  79
  80         $variable =~ s/^\s*//g;
  81         $variable =~ s/\s*$//g;
  82         $value    =~ s/^\s*//g;
  83         $value    =~ s/\s*$//g;
  84         $configfile{$variable}=$value;
  85     } # if
  86 } # while
  87 close(KC);
  88
  89 my $path=$configfile{'includes'};
  90 ($path) || ($path="/usr/local/www/hdl/htdocs/includes");
  91
  92 # make all your functions, whether exported or not;
  93
  94 sub picktemplate {
  95   my ($includes, $base) = @_;
  96   my $dbh=C4Connect;
  97   my $templates;
  98   opendir (D, "$includes/templates");
  99   my @dirlist=readdir D;
 100   foreach (@dirlist) {
 101     (next) if (/^\./);
 102     #(next) unless (/\.tmpl$/);
 103     (next) unless (-e "$includes/templates/$_/$base");
 104     $templates->{$_}=1;
 105   }
 106   my $sth=$dbh->prepare("select value from systempreferences where
 107   variable='template'");
 108   $sth->execute;
 109   my ($preftemplate) = $sth->fetchrow;
 110   $sth->finish;
 111   $dbh->disconnect;
 112   if ($templates->{$preftemplate}) {
 113     return $preftemplate;
 114   } else {
 115     return 'default';
 116   }
 117
 118 }
 119
 120 sub startpage() {
 121   return("<html>\n");
 122 }
 123
 124 sub gotopage($) {
 125   my ($target) = shift;
 126   #print "<br>goto target = $target<br>";
 127   my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
 128   return $string;
 129 }
 130
 131
 132 sub startmenu($) {
 133   # edit the paths in here
 134   my ($type)=shift;
 135   if ($type eq 'issue') {
 136     open (FILE,"$path/issues-top.inc") || die;
 137   } elsif ($type eq 'opac') {
 138     open (FILE,"$path/opac-top.inc") || die;
 139   } elsif ($type eq 'member') {
 140     open (FILE,"$path/members-top.inc") || die;
 141   } elsif ($type eq 'acquisitions'){
 142     open (FILE,"$path/acquisitions-top.inc") || die;
 143   } elsif ($type eq 'report'){
 144     open (FILE,"$path/reports-top.inc") || die;
 145   } elsif ($type eq 'circulation') {
 146     open (FILE,"$path/circulation-top.inc") || die;
 147   } else {
 148     open (FILE,"$path/cat-top.inc") || die;
 149   }
 150   my @string=<FILE>;
 151   close FILE;
 152   # my $count=@string;
 153   # $string[$count]="<BLOCKQUOTE>";
 154   return @string;
 155 }
 156
 157
 158 sub endmenu {
 159   my ($type) = @_;
 160   if ( ! defined $type ) { $type=''; }
 161   if ($type eq 'issue') {
 162     open (FILE,"$path/issues-bottom.inc") || die;
 163   } elsif ($type eq 'opac') {
 164     open (FILE,"$path/opac-bottom.inc") || die;
 165   } elsif ($type eq 'member') {
 166     open (FILE,"$path/members-bottom.inc") || die;
 167   } elsif ($type eq 'acquisitions') {
 168     open (FILE,"$path/acquisitions-bottom.inc") || die;
 169   } elsif ($type eq 'report') {
 170     open (FILE,"$path/reports-bottom.inc") || die;
 171   } elsif ($type eq 'circulation') {
 172     open (FILE,"$path/circulation-bottom.inc") || die;
 173   } else {
 174     open (FILE,"$path/cat-bottom.inc") || die;
 175   }
 176   my @string=<FILE>;
 177   close FILE;
 178   return @string;
 179 }
 180
 181 sub mktablehdr() {
 182     return("<table border=0 cellspacing=0 cellpadding=5>\n");
 183 }
 184
 185
 186 sub mktablerow {
 187     #the last item in data may be a backgroundimage
 188
 189     # FIXME
 190     # should this be a foreach (1..$cols) loop?
 191
 192   my ($cols,$colour,@data)=@_;
 193   my $i=0;
 194   my $string="<tr valign=top bgcolor=$colour>";
 195   while ($i <$cols){
 196       if (defined $data[$cols]) { # if there is a background image
 197           $string.="<td background=\"$data[$cols]\">";
 198       } else { # if there's no background image
 199           $string.="<td>";
 200       }
 201       if (! defined $data[$i]) {$data[$i]="";}
 202       if ($data[$i] eq "") {
 203           $string.=" &nbsp; </td>";
 204       } else {
 205           $string.="$data[$i]</td>";
 206       }
 207       $i++;
 208   }
 209   $string=$string."</tr>\n";
 210   return($string);
 211 }
 212
 213 sub mktableft() {
 214   return("</table>\n");
 215 }
 216
 217 sub mkform{
 218   my ($action,%inputs)=@_;
 219   my $string="<form action=$action method=post>\n";
 220   $string=$string.mktablehdr();
 221   my $key;
 222   my @keys=sort keys %inputs;
 223
 224   my $count=@keys;
 225   my $i2=0;
 226   while ( $i2<$count) {
 227     my $value=$inputs{$keys[$i2]};
 228     my @data=split('\t',$value);
 229     #my $posn = shift(@data);
 230     if ($data[0] eq 'hidden'){
 231       $string=$string."<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
 232     } else {
 233       my $text;
 234       if ($data[0] eq 'radio') {
 235         $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
 236         <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
 237       }
 238       if ($data[0] eq 'text') {
 239         $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
 240       }
 241       if ($data[0] eq 'textarea') {
 242         $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
 243       }
 244       if ($data[0] eq 'select') {
 245         $text="<select name=$keys[$i2]>";
 246         my $i=1;
 247         while ($data[$i] ne "") {
 248           my $val = $data[$i+1];
 249           $text = $text."<option value=$data[$i]>$val";
 250           $i = $i+2;
 251         }
 252         $text=$text."</select>";
 253       }
 254       $string=$string.mktablerow(2,'white',$keys[$i2],$text);
 255       #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
 256     }
 257     $i2++;
 258   }
 259   #$string=$string.join("\n",@order);
 260   $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
 261   $string=$string.mktableft;
 262   $string=$string."</form>";
 263 }
 264
 265 sub mkform3 {
 266   my ($action, %inputs) = @_;
 267   my $string = "<form action=\"$action\" method=\"post\">\n";
 268   $string   .= mktablehdr();
 269   my $key;
 270   my @keys = sort(keys(%inputs));
 271   my @order;
 272   my $count = @keys;
 273   my $i2 = 0;
 274   while ($i2 < $count) {
 275     my $value=$inputs{$keys[$i2]};
 276     my @data=split('\t',$value);
 277     my $posn = $data[2];
 278     if ($data[0] eq 'hidden'){
 279       $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
 280     } else {
 281       my $text;
 282       if ($data[0] eq 'radio') {
 283         $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
 284         <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
 285       }
 286       if ($data[0] eq 'text') {
 287         $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
 288       }
 289       if ($data[0] eq 'textarea') {
 290         $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
 291       }
 292       if ($data[0] eq 'select') {
 293         $text="<select name=$keys[$i2]>";
 294         my $i=1;
 295         while ($data[$i] ne "") {
 296           my $val = $data[$i+1];
 297           $text = $text."<option value=$data[$i]>$val";
 298           $i = $i+2;
 299         }
 300         $text=$text."</select>";
 301       }
 302 #      $string=$string.mktablerow(2,'white',$keys[$i2],$text);
 303       $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
 304     }
 305     $i2++;
 306   }
 307   my $temp=join("\n",@order);
 308   $string=$string.$temp;
 309   $string=$string.mktablerow(1,'white','<input type=submit>');
 310   $string=$string.mktableft;
 311   $string=$string."</form>";
 312 }
 313
 314 sub mkformnotable{
 315   my ($action,@inputs)=@_;
 316   my $string="<form action=$action method=post>\n";
 317   my $count=@inputs;
 318   for (my $i=0; $i<$count; $i++){
 319     if ($inputs[$i][0] eq 'hidden'){
 320       $string=$string."<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
 321     }
 322     if ($inputs[$i][0] eq 'radio') {
 323       $string.="<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
 324     }
 325     if ($inputs[$i][0] eq 'text') {
 326       $string.="<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 327     }
 328     if ($inputs[$i][0] eq 'textarea') {
 329         $string.="<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
 330     }
 331     if ($inputs[$i][0] eq 'reset'){
 332       $string.="<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 333     }
 334     if ($inputs[$i][0] eq 'submit'){
 335       $string.="<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 336     }
 337   }
 338   $string=$string."</form>";
 339 }
 340
 341 sub mkform2{
 342     # FIXME
 343     # no POD and no tests yet.  Once tests are written,
 344     # this function can be cleaned up with the following steps:
 345     #  turn the while loop into a foreach loop
 346     #  pull the nested if,elsif structure back up to the main level
 347     #  pull the code for the different kinds of inputs into separate
 348     #   functions
 349   my ($action,%inputs)=@_;
 350   my $string="<form action=$action method=post>\n";
 351   $string=$string.mktablehdr();
 352   my $key;
 353   my @order;
 354   while ( my ($key, $value) = each %inputs) {
 355     my @data=split('\t',$value);
 356     my $posn = shift(@data);
 357     my $reqd = shift(@data);
 358     my $ltext = shift(@data);
 359     if ($data[0] eq 'hidden'){
 360       $string=$string."<input type=hidden name=$key value=\"$data[1]\">\n";
 361     } else {
 362       my $text;
 363       if ($data[0] eq 'radio') {
 364         $text="<input type=radio name=$key value=$data[1]>$data[1]
 365         <input type=radio name=$key value=$data[2]>$data[2]";
 366       } elsif ($data[0] eq 'text') {
 367         my $size = $data[1];
 368         if ($size eq "") {
 369           $size=40;
 370         }
 371         $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
 372       } elsif ($data[0] eq 'textarea') {
 373         my @size=split("x",$data[1]);
 374         if ($data[1] eq "") {
 375           $size[0] = 40;
 376           $size[1] = 4;
 377         }
 378         $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
 379       } elsif ($data[0] eq 'select') {
 380         $text="<select name=$key>";
 381         my $sel=$data[1];
 382         my $i=2;
 383         while ($data[$i] ne "") {
 384           my $val = $data[$i+1];
 385           $text = $text."<option value=\"$data[$i]\"";
 386           if ($data[$i] eq $sel) {
 387              $text = $text." selected";
 388           }
 389           $text = $text.">$val";
 390           $i = $i+2;
 391         }
 392         $text=$text."</select>";
 393       }
 394       if ($reqd eq "R") {
 395         $ltext = $ltext." (Req)";
 396         }
 397       $order[$posn] =mktablerow(2,'white',$ltext,$text);
 398     }
 399   }
 400   $string=$string.join("\n",@order);
 401   $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
 402   $string=$string.mktableft;
 403   $string=$string."</form>";
 404 }
 405
 406 =pod
 407
 408 =head2 &endpage
 409
 410  &endpage does not expect any arguments, it returns the string:
 411    </body></html>\n
 412
 413 =cut
 414
 415 sub endpage() {
 416   return("</body></html>\n");
 417 }
 418
 419 =pod
 420
 421 =head2 &mklink
 422
 423  &mklink expects two arguments, the url to link to and the text of the link.
 424  It returns this string:
 425    <a href="$url">$text</a>
 426  where $url is the first argument and $text is the second.
 427
 428 =cut
 429
 430 sub mklink($$) {
 431   my ($url,$text)=@_;
 432   my $string="<a href=\"$url\">$text</a>";
 433   return ($string);
 434 }
 435
 436 =pod
 437
 438 =head2 &mkheadr
 439
 440  &mkeadr expects two strings, a type and the text to use in the header.
 441  types are:
 442
 443 =over
 444
 445 =item 1  ends with <br>
 446
 447 =item 2  no special ending tag
 448
 449 =item 3  ends with <p>
 450
 451 =back
 452
 453  Other than this, the return value is the same:
 454    <FONT SIZE=6><em>$text</em></FONT>$string
 455  Where $test is the text passed in and $string is the tag generated from
 456  the type value.
 457
 458 =cut
 459
 460 sub mkheadr {
 461     # FIXME
 462     # would it be better to make this more generic by accepting an optional
 463     # argument with a closing tag instead of a numeric type?
 464
 465   my ($type,$text)=@_;
 466   my $string;
 467   if ($type eq '1'){
 468     $string="<FONT SIZE=6><em>$text</em></FONT><br>";
 469   }
 470   if ($type eq '2'){
 471     $string="<FONT SIZE=6><em>$text</em></FONT><br>";
 472   }
 473   if ($type eq '3'){
 474     $string="<FONT SIZE=6><em>$text</em></FONT><p>";
 475   }
 476   return ($string);
 477 }
 478
 479 =pod
 480
 481 =head2 &center and &endcenter
 482
 483  &center and &endcenter take no arguments and return html tags <CENTER> and
 484  </CENTER> respectivley.
 485
 486 =cut
 487
 488 sub center() {
 489   return ("<CENTER>\n");
 490 }
 491
 492 sub endcenter() {
 493   return ("</CENTER>\n");
 494 }
 495
 496 =pod
 497
 498 =head2 &bold
 499
 500  &bold requires that a single string be passed in by the caller.  &bold
 501  will return "<b>$text</b>" where $text is the string passed in.
 502
 503 =cut
 504
 505 sub bold($) {
 506   my ($text)=shift;
 507   return("<b>$text</b>");
 508 }
 509
 510 #---------------------------------------------
 511 # Create an HTML option list for a <SELECT> form tag by using
 512 #    values from a DB file
 513 sub getkeytableselectoptions {
 514         use strict;
 515         # inputs
 516         my (
 517                 $dbh,           # DBI handle
 518                 $tablename,     # name of table containing list of choices
 519                 $keyfieldname,  # column name of code to use in option list
 520                 $descfieldname, # column name of descriptive field
 521                 $showkey,       # flag to show key in description
 522                 $default,       # optional default key
 523         )=@_;
 524         my $selectclause;       # return value
 525
 526         my (
 527                 $sth, $query,
 528                 $key, $desc, $orderfieldname,
 529         );
 530         my $debug=0;
 531
 532         requireDBI($dbh,"getkeytableselectoptions");
 533
 534         if ( $showkey ) {
 535                 $orderfieldname=$keyfieldname;
 536         } else {
 537                 $orderfieldname=$descfieldname;
 538         }
 539         $query= "select $keyfieldname,$descfieldname
 540                 from $tablename
 541                 order by $orderfieldname ";
 542         print "<PRE>Query=$query </PRE>\n" if $debug;
 543         $sth=$dbh->prepare($query);
 544         $sth->execute;
 545         while ( ($key, $desc) = $sth->fetchrow) {
 546             if ($showkey || ! $desc ) { $desc="$key - $desc"; }
 547             $selectclause.="<option";
 548             if (defined $default && $default eq $key) {
 549                 $selectclause.=" selected";
 550             }
 551             $selectclause.=" value='$key'>$desc\n";
 552             print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
 553         }
 554         return $selectclause;
 555 } # sub getkeytableselectoptions
 556
 557 #---------------------------------
 558
 559 END { }       # module clean-up code here (global destructor)
 560
 561
 562