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) = @_;
  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)=@_;
  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 ($data[$cols] ne ''){
 150     #check for backgroundimage
 151       $string.="<td background=\"$data[$cols]\">";
 152     } else {
 153       $string.="<td>";
 154     }
 155     if ($data[$i] eq "") {
 156       $string.=" &nbsp; </td>";
 157     } else {
 158       $string.="$data[$i]</td>";
 159     }
 160     $i++;
 161   }
 162   $string=$string."</tr>\n";
 163   return($string);
 164 }
 165
 166 sub mktableft {
 167   return("</table>\n");
 168 }
 169
 170 sub mkform{
 171   my ($action,%inputs)=@_;
 172   my $string="<form action=$action method=post>\n";
 173   $string=$string.mktablehdr();
 174   my $key;
 175   my @keys=sort keys %inputs;
 176
 177   my $count=@keys;
 178   my $i2=0;
 179   while ( $i2<$count) {
 180     my $value=$inputs{$keys[$i2]};
 181     my @data=split('\t',$value);
 182     #my $posn = shift(@data);
 183     if ($data[0] eq 'hidden'){
 184       $string=$string."<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
 185     } else {
 186       my $text;
 187       if ($data[0] eq 'radio') {
 188         $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
 189         <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
 190       }
 191       if ($data[0] eq 'text') {
 192         $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
 193       }
 194       if ($data[0] eq 'textarea') {
 195         $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
 196       }
 197       if ($data[0] eq 'select') {
 198         $text="<select name=$keys[$i2]>";
 199         my $i=1;
 200         while ($data[$i] ne "") {
 201           my $val = $data[$i+1];
 202           $text = $text."<option value=$data[$i]>$val";
 203           $i = $i+2;
 204         }
 205         $text=$text."</select>";
 206       }
 207       $string=$string.mktablerow(2,'white',$keys[$i2],$text);
 208       #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
 209     }
 210     $i2++;
 211   }
 212   #$string=$string.join("\n",@order);
 213   $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
 214   $string=$string.mktableft;
 215   $string=$string."</form>";
 216 }
 217
 218 sub mkform3{
 219   my ($action,%inputs)=@_;
 220   my $string="<form action=$action method=post>\n";
 221   $string=$string.mktablehdr();
 222   my $key;
 223   my @keys=sort keys %inputs;
 224   my @order;
 225   my $count=@keys;
 226   my $i2=0;
 227   while ( $i2<$count) {
 228     my $value=$inputs{$keys[$i2]};
 229     my @data=split('\t',$value);
 230     my $posn = $data[2];
 231     if ($data[0] eq 'hidden'){
 232       $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
 233     } else {
 234       my $text;
 235       if ($data[0] eq 'radio') {
 236         $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
 237         <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
 238       }
 239       if ($data[0] eq 'text') {
 240         $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
 241       }
 242       if ($data[0] eq 'textarea') {
 243         $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
 244       }
 245       if ($data[0] eq 'select') {
 246         $text="<select name=$keys[$i2]>";
 247         my $i=1;
 248         while ($data[$i] ne "") {
 249           my $val = $data[$i+1];
 250           $text = $text."<option value=$data[$i]>$val";
 251           $i = $i+2;
 252         }
 253         $text=$text."</select>";
 254       }
 255 #      $string=$string.mktablerow(2,'white',$keys[$i2],$text);
 256       $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
 257     }
 258     $i2++;
 259   }
 260   my $temp=join("\n",@order);
 261   $string=$string.$temp;
 262   $string=$string.mktablerow(1,'white','<input type=submit>');
 263   $string=$string.mktableft;
 264   $string=$string."</form>";
 265 }
 266
 267 sub mkformnotable{
 268   my ($action,@inputs)=@_;
 269   my $string="<form action=$action method=post>\n";
 270   my $count=@inputs;
 271   for (my $i=0; $i<$count; $i++){
 272     if ($inputs[$i][0] eq 'hidden'){
 273       $string=$string."<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
 274     }
 275     if ($inputs[$i][0] eq 'radio') {
 276       $string.="<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
 277     }
 278     if ($inputs[$i][0] eq 'text') {
 279       $string.="<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 280     }
 281     if ($inputs[$i][0] eq 'textarea') {
 282         $string.="<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
 283     }
 284     if ($inputs[$i][0] eq 'reset'){
 285       $string.="<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 286     }
 287     if ($inputs[$i][0] eq 'submit'){
 288       $string.="<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 289     }
 290   }
 291   $string=$string."</form>";
 292 }
 293
 294 sub mkform2{
 295   my ($action,%inputs)=@_;
 296   my $string="<form action=$action method=post>\n";
 297   $string=$string.mktablehdr();
 298   my $key;
 299   my @order;
 300   while ( my ($key, $value) = each %inputs) {
 301     my @data=split('\t',$value);
 302     my $posn = shift(@data);
 303     my $reqd = shift(@data);
 304     my $ltext = shift(@data);
 305     if ($data[0] eq 'hidden'){
 306       $string=$string."<input type=hidden name=$key value=\"$data[1]\">\n";
 307     } else {
 308       my $text;
 309       if ($data[0] eq 'radio') {
 310         $text="<input type=radio name=$key value=$data[1]>$data[1]
 311         <input type=radio name=$key value=$data[2]>$data[2]";
 312       } elsif ($data[0] eq 'text') {
 313         my $size = $data[1];
 314         if ($size eq "") {
 315           $size=40;
 316         }
 317         $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
 318       } elsif ($data[0] eq 'textarea') {
 319         my @size=split("x",$data[1]);
 320         if ($data[1] eq "") {
 321           $size[0] = 40;
 322           $size[1] = 4;
 323         }
 324         $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
 325       } elsif ($data[0] eq 'select') {
 326         $text="<select name=$key>";
 327         my $sel=$data[1];
 328         my $i=2;
 329         while ($data[$i] ne "") {
 330           my $val = $data[$i+1];
 331           $text = $text."<option value=\"$data[$i]\"";
 332           if ($data[$i] eq $sel) {
 333              $text = $text." selected";
 334           }
 335           $text = $text.">$val";
 336           $i = $i+2;
 337         }
 338         $text=$text."</select>";
 339       }
 340       if ($reqd eq "R") {
 341         $ltext = $ltext." (Req)";
 342         }
 343       @order[$posn] =mktablerow(2,'white',$ltext,$text);
 344     }
 345   }
 346   $string=$string.join("\n",@order);
 347   $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
 348   $string=$string.mktableft;
 349   $string=$string."</form>";
 350 }
 351
 352
 353 sub endpage{
 354   return("</body></html>\n");
 355 }
 356
 357 sub mklink {
 358   my ($url,$text)=@_;
 359   my $string="<a href=\"$url\">$text</a>";
 360   return ($string);
 361 }
 362
 363 sub mkheadr {
 364   my ($type,$text)=@_;
 365   my $string;
 366   if ($type eq '1'){
 367     $string="<FONT SIZE=6><em>$text</em></FONT><br>";
 368   }
 369   if ($type eq '2'){
 370     $string="<FONT SIZE=6><em>$text</em></FONT>";
 371   }
 372     if ($type eq '3'){
 373     $string="<FONT SIZE=6><em>$text</em></FONT><p>";
 374   }
 375   return ($string);
 376 }
 377
 378 sub center {
 379   return ("<CENTER>\n");
 380 }
 381
 382 sub endcenter {
 383   return ("</CENTER>\n");
 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
 394
 395