C4/Output.pm

   1 package C4::Output; #asummes 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 vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  11
  12 # set the version for version checking
  13 $VERSION = 0.01;
  14
  15 @ISA = qw(Exporter);
  16 @EXPORT = qw(&startpage &endpage &mktablehdr &mktableft &mktablerow &mklink
  17 &startmenu &endmenu &mkheadr &center &endcenter &mkform &mkform2 &bold
  18 &gotopage &mkformnotable &mkform3);
  19 %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
  20
  21 # your exported package globals go here,
  22 # as well as any optionally exported functions
  23
  24 @EXPORT_OK   = qw($Var1 %Hashit);
  25
  26
  27 # non-exported package globals go here
  28 use vars qw(@more $stuff);
  29
  30 # initalize package globals, first exported ones
  31
  32 my $Var1   = '';
  33 my %Hashit = ();
  34
  35
  36 # then the others (which are still accessible as $Some::Module::stuff)
  37 my $stuff  = '';
  38 my @more   = ();
  39
  40 # all file-scoped lexicals must be created before
  41 # the functions below that use them.
  42
  43 #
  44 # Change this value to reflect where you will store your includes
  45 #
  46 my %configfile;
  47 open (KC, "/etc/koha.conf");
  48 while (<KC>) {
  49  chomp;
  50  (next) if (/^\s*#/);
  51  if (/(.*)\s*=\s*(.*)/) {
  52    my $variable=$1;
  53    my $value=$2;
  54    # Clean up white space at beginning and end
  55    $variable=~s/^\s*//g;
  56    $variable=~s/\s*$//g;
  57    $value=~s/^\s*//g;
  58    $value=~s/\s*$//g;
  59    $configfile{$variable}=$value;
  60  }
  61 }
  62 my $path=$configfile{'includes'};
  63 ($path) || ($path="/usr/local/www/hdl/htdocs/includes");
  64
  65
  66 # here's a file-private function as a closure,
  67 # callable as &$priv_func;  it cannot be prototyped.
  68 my $priv_func = sub {
  69 # stuff goes here.
  70   };
  71
  72 # make all your functions, whether exported or not;
  73
  74 sub startpage() {
  75   return("<html>\n");
  76 }
  77
  78 sub gotopage($) {
  79   my ($target) = shift;
  80   #print "<br>goto target = $target<br>";
  81   my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
  82   return $string;
  83 }
  84
  85
  86 sub startmenu($) {
  87   # edit the paths in here
  88   my ($type)=shift;
  89   if ($type eq 'issue') {
  90     open (FILE,"$path/issues-top.inc") || die;
  91   } elsif ($type eq 'opac') {
  92     open (FILE,"$path/opac-top.inc") || die;
  93   } elsif ($type eq 'member') {
  94     open (FILE,"$path/members-top.inc") || die;
  95   } elsif ($type eq 'acquisitions'){
  96     open (FILE,"$path/acquisitions-top.inc")|| die;
  97   } elsif ($type eq 'report'){
  98     open (FILE,"$path/reports-top.inc") || die;
  99   } elsif ($type eq 'circulation') {
 100     open (FILE,"$path/circulation-top.inc") || die;
 101   } else {
 102     open (FILE,"$path/cat-top.inc") || die;
 103   }
 104   my @string=<FILE>;
 105   close FILE;
 106   # my $count=@string;
 107   # $string[$count]="<BLOCKQUOTE>";
 108   return @string;
 109 }
 110
 111
 112 sub endmenu{
 113   my ($type)=@_;
 114   if ($type eq 'issue'){
 115     open (FILE,"$path/issues-bottom.inc") || die;
 116   } elsif ($type eq 'opac') {
 117     open (FILE,"$path/opac-bottom.inc") || die;
 118   } elsif ($type eq 'member') {
 119     open (FILE,"$path/members-bottom.inc") || die;
 120   } elsif ($type eq 'acquisitions') {
 121     open (FILE,"$path/acquisitions-bottom.inc") || die;
 122   } elsif ($type eq 'report') {
 123     open (FILE,"$path/reports-bottom.inc") || die;
 124   } elsif ($type eq 'circulation') {
 125     open (FILE,"$path/circulation-bottom.inc") || die;
 126   } else {
 127     open (FILE,"$path/cat-bottom.inc") || die;
 128   }
 129   my @string=<FILE>;
 130   close FILE;
 131   return @string;
 132 }
 133
 134 sub mktablehdr() {
 135     return("<table border=0 cellspacing=0 cellpadding=5>\n");
 136 }
 137
 138
 139 sub mktablerow {
 140     #the last item in data may be a backgroundimage
 141
 142     # FIXME
 143     # should this be a foreach (1..$cols) loop?
 144
 145   my ($cols,$colour,@data)=@_;
 146   my $i=0;
 147   my $string="<tr valign=top bgcolor=$colour>";
 148   while ($i <$cols){
 149       if (defined $data[$cols]) { # if there is a background image
 150           $string.="<td background=\"$data[$cols]\">";
 151       } else { # if there's no background image
 152           $string.="<td>";
 153       }
 154       if ($data[$i] eq "") {
 155           $string.=" &nbsp; </td>";
 156       } else {
 157           $string.="$data[$i]</td>";
 158       }
 159       $i++;
 160   }
 161   $string=$string."</tr>\n";
 162   return($string);
 163 }
 164
 165 sub mktableft() {
 166   return("</table>\n");
 167 }
 168
 169 sub mkform{
 170   my ($action,%inputs)=@_;
 171   my $string="<form action=$action method=post>\n";
 172   $string=$string.mktablehdr();
 173   my $key;
 174   my @keys=sort keys %inputs;
 175
 176   my $count=@keys;
 177   my $i2=0;
 178   while ( $i2<$count) {
 179     my $value=$inputs{$keys[$i2]};
 180     my @data=split('\t',$value);
 181     #my $posn = shift(@data);
 182     if ($data[0] eq 'hidden'){
 183       $string=$string."<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
 184     } else {
 185       my $text;
 186       if ($data[0] eq 'radio') {
 187         $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
 188         <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
 189       }
 190       if ($data[0] eq 'text') {
 191         $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
 192       }
 193       if ($data[0] eq 'textarea') {
 194         $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
 195       }
 196       if ($data[0] eq 'select') {
 197         $text="<select name=$keys[$i2]>";
 198         my $i=1;
 199         while ($data[$i] ne "") {
 200           my $val = $data[$i+1];
 201           $text = $text."<option value=$data[$i]>$val";
 202           $i = $i+2;
 203         }
 204         $text=$text."</select>";
 205       }
 206       $string=$string.mktablerow(2,'white',$keys[$i2],$text);
 207       #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
 208     }
 209     $i2++;
 210   }
 211   #$string=$string.join("\n",@order);
 212   $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
 213   $string=$string.mktableft;
 214   $string=$string."</form>";
 215 }
 216
 217 sub mkform3{
 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   my @order;
 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 = $data[2];
 230     if ($data[0] eq 'hidden'){
 231       $order[$posn]="<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]\" size=40>";
 240       }
 241       if ($data[0] eq 'textarea') {
 242         $text="<textarea name=$keys[$i2] 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   my $temp=join("\n",@order);
 260   $string=$string.$temp;
 261   $string=$string.mktablerow(1,'white','<input type=submit>');
 262   $string=$string.mktableft;
 263   $string=$string."</form>";
 264 }
 265
 266 sub mkformnotable{
 267   my ($action,@inputs)=@_;
 268   my $string="<form action=$action method=post>\n";
 269   foreach my $input (@inputs){
 270       if ($$input[0] eq 'textarea') {
 271           $string .=
 272               "<textarea name=$$input[1] wrap=physical cols=40 rows=4>";
 273           $string .=
 274               "$$input[2]</textarea>";
 275       } else {
 276           $string .=
 277               "<input type=$$input[0] name=$$input[1] value=\"$$input[2]\">";
 278           if ($$input[0] eq 'radio') {
 279               $string .=
 280               "$$input[2]";
 281           }
 282       }
 283       $string .= "\n";
 284   }
 285   $string=$string."</form>";
 286 }
 287
 288 sub mkform2{
 289     # FIXME
 290     # no POD and no tests yet.  Once tests are written,
 291     # this function can be cleaned up with the following steps:
 292     #  turn the while loop into a foreach loop
 293     #  pull the nested if,elsif structure back up to the main level
 294     #  pull the code for the different kinds of inputs into separate
 295     #   functions
 296   my ($action,%inputs)=@_;
 297   my $string="<form action=$action method=post>\n";
 298   $string=$string.mktablehdr();
 299   my $key;
 300   my @order;
 301   while ( my ($key, $value) = each %inputs) {
 302     my @data=split('\t',$value);
 303     my $posn = shift(@data);
 304     my $reqd = shift(@data);
 305     my $ltext = shift(@data);
 306     if ($data[0] eq 'hidden'){
 307       $string=$string."<input type=hidden name=$key value=\"$data[1]\">\n";
 308     } else {
 309       my $text;
 310       if ($data[0] eq 'radio') {
 311         $text="<input type=radio name=$key value=$data[1]>$data[1]
 312         <input type=radio name=$key value=$data[2]>$data[2]";
 313       } elsif ($data[0] eq 'text') {
 314         my $size = $data[1];
 315         if ($size eq "") {
 316           $size=40;
 317         }
 318         $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
 319       } elsif ($data[0] eq 'textarea') {
 320         my @size=split("x",$data[1]);
 321         if ($data[1] eq "") {
 322           $size[0] = 40;
 323           $size[1] = 4;
 324         }
 325         $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
 326       } elsif ($data[0] eq 'select') {
 327         $text="<select name=$key>";
 328         my $sel=$data[1];
 329         my $i=2;
 330         while ($data[$i] ne "") {
 331           my $val = $data[$i+1];
 332           $text = $text."<option value=\"$data[$i]\"";
 333           if ($data[$i] eq $sel) {
 334              $text = $text." selected";
 335           }
 336           $text = $text.">$val";
 337           $i = $i+2;
 338         }
 339         $text=$text."</select>";
 340       }
 341       if ($reqd eq "R") {
 342         $ltext = $ltext." (Req)";
 343         }
 344       $order[$posn] =mktablerow(2,'white',$ltext,$text);
 345     }
 346   }
 347   $string=$string.join("\n",@order);
 348   $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
 349   $string=$string.mktableft;
 350   $string=$string."</form>";
 351 }
 352
 353 =pod
 354
 355 =head2 &endpage
 356
 357  &endpage does not expect any arguments, it returns the string:
 358    </body></html>\n
 359
 360 =cut
 361
 362
 363 sub endpage() {
 364   return("</body></html>\n");
 365 }
 366
 367 =pod
 368
 369 =head2 &mklink
 370
 371  &mklink expects two arguments, the url to link to and the text of the link.
 372  It returns this string:
 373    <a href="$url">$text</a>
 374  where $url is the first argument and $text is the second.
 375
 376 =cut
 377
 378
 379 sub mklink($$)  {
 380   my ($url,$text)=@_;
 381   my $string="<a href=\"$url\">$text</a>";
 382   return ($string);
 383 }
 384
 385 =pod
 386
 387 =head2 &mkheadr
 388
 389  &mkeadr expects two strings, a type and the text to use in the header.
 390  types are:
 391
 392 =over
 393
 394 =item 1  ends with <br>
 395
 396 =item 2  no special ending tag
 397
 398 =item 3  ends with <p>
 399
 400 =back
 401
 402  Other than this, the return value is the same:
 403    <FONT SIZE=6><em>$text</em></FONT>$string
 404  Where $test is the text passed in and $string is the tag generated from
 405  the type value.
 406
 407 =cut
 408
 409
 410 sub mkheadr {
 411     # FIXME
 412     # would it be better to make this more generic by accepting an optional
 413     # argument with a closing tag instead of a numeric type?
 414
 415   my ($type,$text)=@_;
 416   my $string;
 417   if ($type eq '1'){
 418       $string="<br>";
 419   } elsif ($type eq '3') {
 420       $string="<p>";
 421   } else {
 422       $string="";
 423   }
 424   return ("<FONT SIZE=6><em>$text</em></FONT>$string");
 425 }
 426
 427 =pod
 428
 429 =head2 &center and &endcenter
 430
 431  &center and &endcenter take no arguments and return html tags <CENTER> and
 432  </CENTER> respectivley.
 433
 434 =cut
 435
 436 sub center() {
 437   return ("<CENTER>\n");
 438 }
 439
 440 sub endcenter() {
 441   return ("</CENTER>\n");
 442 }
 443
 444 =pod
 445
 446 =head2 &bold
 447
 448  &bold requires that a single string be passed in by the caller.  &bold
 449  will return "<b>$text</b>" where $text is the string passed in.
 450
 451 =cut
 452
 453 sub bold($) {
 454   my ($text)=shift;
 455   return("<b>$text</b>");
 456 }
 457
 458 END { }       # module clean-up code here (global destructor)
 459
 460
 461