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{'path'};
  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   my $string="<html>\n";
  76   return($string);
  77 }
  78
  79 sub gotopage{
  80   my ($target) = @_;
  81   print "<br>goto target = $target<br>";
  82   my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
  83   return $string;
  84 }
  85
  86
  87 sub startmenu{
  88   # edit the paths in here
  89   my ($type)=@_;
  90   if ($type eq 'issue') {
  91     open (FILE,"$path/issues-top.inc") || die;
  92   } elsif ($type eq 'opac') {
  93     open (FILE,"$path/opac-top.inc") || die;
  94   } elsif ($type eq 'member') {
  95     open (FILE,"$path/members-top.inc") || die;
  96   } elsif ($type eq 'acquisitions'){
  97     open (FILE,"$path/aquisitions-top.inc")|| die;
  98   } elsif ($type eq 'report'){
  99     open (FILE,"$path/reports-top.inc") || die;
 100   } else {
 101     open (FILE,"$path/cat-top.inc") || die;
 102   }
 103   my @string=<FILE>;
 104   close FILE;
 105   my $count=@string;
 106   #  $string[$count]="<BLOCKQUOTE>";
 107   return @string;
 108 }
 109
 110
 111 sub endmenu{
 112   my ($type)=@_;
 113   if ($type eq 'issue'){
 114     open (FILE,"$path/issues-bottom.inc") || die;
 115   } elsif ($type eq 'opac') {
 116     open (FILE,"$path/opac-bottom.inc") || die;
 117   } elsif ($type eq 'member') {
 118     open (FILE,"$path/members-bottom.inc") || die;
 119   } elsif ($type eq 'acquisitions') {
 120     open (FILE,"$path/aquisitions-bottom.inc") || die;
 121   } elsif ($type eq 'report') {
 122     open (FILE,"$path/reports-bottom.inc") || die;
 123   } else {
 124     open (FILE,"$path/cat-bottom.inc") || die;
 125   }
 126   my @string=<FILE>;
 127   close FILE;
 128   return @string;
 129 }
 130
 131 sub mktablehdr {
 132   my $string="<table border=0 cellspacing=0 cellpadding=5>\n";
 133   return($string);
 134 }
 135
 136
 137 sub mktablerow {
 138   #the last item in data may be a backgroundimage
 139   my ($cols,$colour,@data)=@_;
 140   my $i=0;
 141   my $string="<tr valign=top bgcolor=$colour>";
 142   while ($i <$cols){
 143     if ($data[$cols] ne ''){
 144     #check for backgroundimage
 145       $string.="<td background=\"$data[$cols]\">";
 146     } else {
 147       $string.="<td>";
 148     }
 149     if ($data[$i] eq "") {
 150       $string.=" &nbsp; </td>";
 151     } else {
 152       $string.="$data[$i]</td>";
 153     }
 154     $i++;
 155   }
 156   $string=$string."</tr>\n";
 157   return($string);
 158 }
 159
 160 sub mktableft {
 161   my $string="</table>\n";
 162   return($string);
 163 }
 164
 165 sub mkform{
 166   my ($action,%inputs)=@_;
 167   my $string="<form action=$action method=post>\n";
 168   $string=$string.mktablehdr();
 169   my $key;
 170   my @keys=sort keys %inputs;
 171
 172   my $count=@keys;
 173   my $i2=0;
 174   while ( $i2<$count) {
 175     my $value=$inputs{$keys[$i2]};
 176     my @data=split('\t',$value);
 177     #my $posn = shift(@data);
 178     if ($data[0] eq 'hidden'){
 179       $string=$string."<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
 180     } else {
 181       my $text;
 182       if ($data[0] eq 'radio') {
 183         $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
 184         <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
 185       }
 186       if ($data[0] eq 'text') {
 187         $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
 188       }
 189       if ($data[0] eq 'textarea') {
 190         $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
 191       }
 192       if ($data[0] eq 'select') {
 193         $text="<select name=$keys[$i2]>";
 194         my $i=1;
 195         while ($data[$i] ne "") {
 196           my $val = $data[$i+1];
 197           $text = $text."<option value=$data[$i]>$val";
 198           $i = $i+2;
 199         }
 200         $text=$text."</select>";
 201       }
 202       $string=$string.mktablerow(2,'white',$keys[$i2],$text);
 203       #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
 204     }
 205     $i2++;
 206   }
 207   #$string=$string.join("\n",@order);
 208   $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
 209   $string=$string.mktableft;
 210   $string=$string."</form>";
 211 }
 212
 213 sub mkform3{
 214   my ($action,%inputs)=@_;
 215   my $string="<form action=$action method=post>\n";
 216   $string=$string.mktablehdr();
 217   my $key;
 218   my @keys=sort keys %inputs;
 219   my @order;
 220   my $count=@keys;
 221   my $i2=0;
 222   while ( $i2<$count) {
 223     my $value=$inputs{$keys[$i2]};
 224     my @data=split('\t',$value);
 225     my $posn = $data[2];
 226     if ($data[0] eq 'hidden'){
 227       $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
 228     } else {
 229       my $text;
 230       if ($data[0] eq 'radio') {
 231         $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
 232         <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
 233       }
 234       if ($data[0] eq 'text') {
 235         $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
 236       }
 237       if ($data[0] eq 'textarea') {
 238         $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
 239       }
 240       if ($data[0] eq 'select') {
 241         $text="<select name=$keys[$i2]>";
 242         my $i=1;
 243         while ($data[$i] ne "") {
 244           my $val = $data[$i+1];
 245           $text = $text."<option value=$data[$i]>$val";
 246           $i = $i+2;
 247         }
 248         $text=$text."</select>";
 249       }
 250 #      $string=$string.mktablerow(2,'white',$keys[$i2],$text);
 251       $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
 252     }
 253     $i2++;
 254   }
 255   my $temp=join("\n",@order);
 256   $string=$string.$temp;
 257   $string=$string.mktablerow(1,'white','<input type=submit>');
 258   $string=$string.mktableft;
 259   $string=$string."</form>";
 260 }
 261
 262 sub mkformnotable{
 263   my ($action,@inputs)=@_;
 264   my $string="<form action=$action method=post>\n";
 265   my $count=@inputs;
 266   for (my $i=0; $i<$count; $i++){
 267     if ($inputs[$i][0] eq 'hidden'){
 268       $string=$string."<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
 269     }
 270     if ($inputs[$i][0] eq 'radio') {
 271       $string.="<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
 272     }
 273     if ($inputs[$i][0] eq 'text') {
 274       $string.="<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 275     }
 276     if ($inputs[$i][0] eq 'textarea') {
 277         $string.="<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
 278     }
 279     if ($inputs[$i][0] eq 'reset'){
 280       $string.="<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 281     }
 282     if ($inputs[$i][0] eq 'submit'){
 283       $string.="<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 284     }
 285   }
 286   $string=$string."</form>";
 287 }
 288
 289 sub mkform2{
 290   my ($action,%inputs)=@_;
 291   my $string="<form action=$action method=post>\n";
 292   $string=$string.mktablehdr();
 293   my $key;
 294   my @order;
 295   while ( my ($key, $value) = each %inputs) {
 296     my @data=split('\t',$value);
 297     my $posn = shift(@data);
 298     my $reqd = shift(@data);
 299     my $ltext = shift(@data);
 300     if ($data[0] eq 'hidden'){
 301       $string=$string."<input type=hidden name=$key value=\"$data[1]\">\n";
 302     } else {
 303       my $text;
 304       if ($data[0] eq 'radio') {
 305         $text="<input type=radio name=$key value=$data[1]>$data[1]
 306         <input type=radio name=$key value=$data[2]>$data[2]";
 307       } elsif ($data[0] eq 'text') {
 308         my $size = $data[1];
 309         if ($size eq "") {
 310           $size=40;
 311         }
 312         $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
 313       } elsif ($data[0] eq 'textarea') {
 314         my @size=split("x",$data[1]);
 315         if ($data[1] eq "") {
 316           $size[0] = 40;
 317           $size[1] = 4;
 318         }
 319         $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
 320       } elsif ($data[0] eq 'select') {
 321         $text="<select name=$key>";
 322         my $sel=$data[1];
 323         my $i=2;
 324         while ($data[$i] ne "") {
 325           my $val = $data[$i+1];
 326           $text = $text."<option value=\"$data[$i]\"";
 327           if ($data[$i] eq $sel) {
 328              $text = $text." selected";
 329           }
 330           $text = $text.">$val";
 331           $i = $i+2;
 332         }
 333         $text=$text."</select>";
 334       }
 335       if ($reqd eq "R") {
 336         $ltext = $ltext." (Req)";
 337         }
 338       @order[$posn] =mktablerow(2,'white',$ltext,$text);
 339     }
 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
 348 sub endpage{
 349   my $string="</body></html>\n";
 350   return($string);
 351 }
 352
 353 sub mklink {
 354   my ($url,$text)=@_;
 355   my $string="<a href=\"$url\">$text</a>";
 356   return ($string);
 357 }
 358
 359 sub mkheadr {
 360   my ($type,$text)=@_;
 361   my $string;
 362   if ($type eq '1'){
 363     $string="<FONT SIZE=6><em>$text</em></FONT><br>";
 364   }
 365   if ($type eq '2'){
 366     $string="<FONT SIZE=6><em>$text</em></FONT>";
 367   }
 368     if ($type eq '3'){
 369     $string="<FONT SIZE=6><em>$text</em></FONT><p>";
 370   }
 371   return ($string);
 372 }
 373
 374 sub center {
 375   my ($text)=@_;
 376   my $string="<CENTER>\n";
 377   return ($string);
 378 }
 379
 380 sub endcenter {
 381   my ($text)=@_;
 382   my $string="</CENTER>\n";
 383   return ($string);
 384 }
 385
 386 sub bold {
 387   my ($text)=@_;
 388   my $string="<b>$text</b>";
 389   return($string);
 390 }
 391
 392 END { }       # module clean-up code here (global destructor)
 393