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   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   return("</body></html>\n");
 354 }
 355
 356 sub mklink($$)  {
 357   my ($url,$text)=@_;
 358   my $string="<a href=\"$url\">$text</a>";
 359   return ($string);
 360 }
 361
 362 sub mkheadr {
 363   my ($type,$text)=@_;
 364   my $string;
 365   if ($type eq '1'){
 366     $string="<FONT SIZE=6><em>$text</em></FONT><br>";
 367   }
 368   if ($type eq '2'){
 369     $string="<FONT SIZE=6><em>$text</em></FONT>";
 370   }
 371     if ($type eq '3'){
 372     $string="<FONT SIZE=6><em>$text</em></FONT><p>";
 373   }
 374   return ($string);
 375 }
 376
 377 sub center() {
 378   return ("<CENTER>\n");
 379 }
 380
 381 sub endcenter() {
 382   return ("</CENTER>\n");
 383 }
 384
 385 sub bold($) {
 386   my ($text)=@_;
 387   my $string="<b>$text</b>";
 388   return($string);
 389 }
 390
 391 END { }       # module clean-up code here (global destructor)
 392
 393
 394