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