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