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