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   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   } elsif ($type eq 'circulation') {
 101     open (FILE,"$path/circulation-top.inc") || die;
 102   } else {
 103     open (FILE,"$path/cat-top.inc") || die;
 104   }
 105   my @string=<FILE>;
 106   close FILE;
 107   my $count=@string;
 108   #  $string[$count]="<BLOCKQUOTE>";
 109   return @string;
 110 }
 111
 112
 113 sub endmenu{
 114   my ($type)=@_;
 115   if ($type eq 'issue'){
 116     open (FILE,"$path/issues-bottom.inc") || die;
 117   } elsif ($type eq 'opac') {
 118     open (FILE,"$path/opac-bottom.inc") || die;
 119   } elsif ($type eq 'member') {
 120     open (FILE,"$path/members-bottom.inc") || die;
 121   } elsif ($type eq 'acquisitions') {
 122     open (FILE,"$path/aquisitions-bottom.inc") || die;
 123   } elsif ($type eq 'report') {
 124     open (FILE,"$path/reports-bottom.inc") || die;
 125   } elsif ($type eq 'circulation') {
 126     open (FILE,"$path/circulation-bottom.inc") || die;
 127   } else {
 128     open (FILE,"$path/cat-bottom.inc") || die;
 129   }
 130   my @string=<FILE>;
 131   close FILE;
 132   return @string;
 133 }
 134
 135 sub mktablehdr {
 136   my $string="<table border=0 cellspacing=0 cellpadding=5>\n";
 137   return($string);
 138 }
 139
 140
 141 sub mktablerow {
 142   #the last item in data may be a backgroundimage
 143   my ($cols,$colour,@data)=@_;
 144   my $i=0;
 145   my $string="<tr valign=top bgcolor=$colour>";
 146   while ($i <$cols){
 147     if ($data[$cols] ne ''){
 148     #check for backgroundimage
 149       $string.="<td background=\"$data[$cols]\">";
 150     } else {
 151       $string.="<td>";
 152     }
 153     if ($data[$i] eq "") {
 154       $string.=" &nbsp; </td>";
 155     } else {
 156       $string.="$data[$i]</td>";
 157     }
 158     $i++;
 159   }
 160   $string=$string."</tr>\n";
 161   return($string);
 162 }
 163
 164 sub mktableft {
 165   my $string="</table>\n";
 166   return($string);
 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   my $count=@inputs;
 270   for (my $i=0; $i<$count; $i++){
 271     if ($inputs[$i][0] eq 'hidden'){
 272       $string=$string."<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
 273     }
 274     if ($inputs[$i][0] eq 'radio') {
 275       $string.="<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
 276     }
 277     if ($inputs[$i][0] eq 'text') {
 278       $string.="<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 279     }
 280     if ($inputs[$i][0] eq 'textarea') {
 281         $string.="<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
 282     }
 283     if ($inputs[$i][0] eq 'reset'){
 284       $string.="<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 285     }
 286     if ($inputs[$i][0] eq 'submit'){
 287       $string.="<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 288     }
 289   }
 290   $string=$string."</form>";
 291 }
 292
 293 sub mkform2{
 294   my ($action,%inputs)=@_;
 295   my $string="<form action=$action method=post>\n";
 296   $string=$string.mktablehdr();
 297   my $key;
 298   my @order;
 299   while ( my ($key, $value) = each %inputs) {
 300     my @data=split('\t',$value);
 301     my $posn = shift(@data);
 302     my $reqd = shift(@data);
 303     my $ltext = shift(@data);
 304     if ($data[0] eq 'hidden'){
 305       $string=$string."<input type=hidden name=$key value=\"$data[1]\">\n";
 306     } else {
 307       my $text;
 308       if ($data[0] eq 'radio') {
 309         $text="<input type=radio name=$key value=$data[1]>$data[1]
 310         <input type=radio name=$key value=$data[2]>$data[2]";
 311       } elsif ($data[0] eq 'text') {
 312         my $size = $data[1];
 313         if ($size eq "") {
 314           $size=40;
 315         }
 316         $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
 317       } elsif ($data[0] eq 'textarea') {
 318         my @size=split("x",$data[1]);
 319         if ($data[1] eq "") {
 320           $size[0] = 40;
 321           $size[1] = 4;
 322         }
 323         $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
 324       } elsif ($data[0] eq 'select') {
 325         $text="<select name=$key>";
 326         my $sel=$data[1];
 327         my $i=2;
 328         while ($data[$i] ne "") {
 329           my $val = $data[$i+1];
 330           $text = $text."<option value=\"$data[$i]\"";
 331           if ($data[$i] eq $sel) {
 332              $text = $text." selected";
 333           }
 334           $text = $text.">$val";
 335           $i = $i+2;
 336         }
 337         $text=$text."</select>";
 338       }
 339       if ($reqd eq "R") {
 340         $ltext = $ltext." (Req)";
 341         }
 342       @order[$posn] =mktablerow(2,'white',$ltext,$text);
 343     }
 344   }
 345   $string=$string.join("\n",@order);
 346   $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
 347   $string=$string.mktableft;
 348   $string=$string."</form>";
 349 }
 350
 351
 352 sub endpage{
 353   my $string="</body></html>\n";
 354   return($string);
 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   my ($text)=@_;
 380   my $string="<CENTER>\n";
 381   return ($string);
 382 }
 383
 384 sub endcenter {
 385   my ($text)=@_;
 386   my $string="</CENTER>\n";
 387   return ($string);
 388 }
 389
 390 sub bold {
 391   my ($text)=@_;
 392   my $string="<b>$text</b>";
 393   return($string);
 394 }
 395
 396 END { }       # module clean-up code here (global destructor)
 397