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 use warnings;
   9 use C4::Database;
  10 require Exporter;
  11
  12 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  13
  14 # set the version for version checking
  15 $VERSION = 0.01;
  16
  17 @ISA = qw(Exporter);
  18 @EXPORT = qw(&startpage &endpage &mktablehdr &mktableft &mktablerow &mklink
  19 &startmenu &endmenu &mkheadr &center &endcenter &mkform &mkform2 &bold
  20 &gotopage &mkformnotable &mkform3 picktemplate);
  21 %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
  22
  23 # your exported package globals go here,
  24 # as well as any optionally exported functions
  25
  26 @EXPORT_OK   = qw($Var1 %Hashit);
  27
  28
  29 # non-exported package globals go here
  30 use vars qw(@more $stuff);
  31
  32 # initalize package globals, first exported ones
  33
  34 my $Var1   = '';
  35 my %Hashit = ();
  36
  37
  38 # then the others (which are still accessible as $Some::Module::stuff)
  39 my $stuff  = '';
  40 my @more   = ();
  41
  42 # all file-scoped lexicals must be created before
  43 # the functions below that use them.
  44
  45 #
  46 # Change this value to reflect where you will store your includes
  47 #
  48 my %configfile;
  49 open (KC, "/etc/koha.conf");
  50 while (<KC>) {
  51  chomp;
  52  (next) if (/^\s*#/);
  53  if (/(.*)\s*=\s*(.*)/) {
  54    my $variable=$1;
  55    my $value=$2;
  56    # Clean up white space at beginning and end
  57    $variable=~s/^\s*//g;
  58    $variable=~s/\s*$//g;
  59    $value=~s/^\s*//g;
  60    $value=~s/\s*$//g;
  61    $configfile{$variable}=$value;
  62  }
  63 }
  64 my $path=$configfile{'includes'};
  65 ($path) || ($path="/usr/local/www/hdl/htdocs/includes");
  66
  67
  68 # here's a file-private function as a closure,
  69 # callable as &$priv_func;  it cannot be prototyped.
  70 my $priv_func = sub {
  71 # stuff goes here.
  72   };
  73
  74 # make all your functions, whether exported or not;
  75
  76 sub picktemplate {
  77   my ($includes, $base) = @_;
  78   my $dbh=C4Connect;
  79   my $templates;
  80   opendir (D, "$includes/templates");
  81   my @dirlist=readdir D;
  82   foreach (@dirlist) {
  83     (next) if (/^\./);
  84     #(next) unless (/\.tmpl$/);
  85     (next) unless (-e "$includes/templates/$_/$base");
  86     $templates->{$_}=1;
  87   }
  88   my $sth=$dbh->prepare("select value from systempreferences where
  89   variable='template'");
  90   $sth->execute;
  91   my ($preftemplate) = $sth->fetchrow;
  92   $sth->finish;
  93   $dbh->disconnect;
  94   if ($templates->{$preftemplate}) {
  95     return $preftemplate;
  96   } else {
  97     return 'default';
  98   }
  99
 100 }
 101
 102
 103
 104 sub startpage{
 105   return("<html>\n");
 106 }
 107
 108 sub gotopage{
 109   my ($target) = @_;
 110   print "<br>goto target = $target<br>";
 111   my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
 112   return $string;
 113 }
 114
 115
 116 sub startmenu{
 117   # edit the paths in here
 118   my ($type)=@_;
 119   if ($type eq 'issue') {
 120     open (FILE,"$path/issues-top.inc") || die;
 121   } elsif ($type eq 'opac') {
 122     open (FILE,"$path/opac-top.inc") || die;
 123   } elsif ($type eq 'member') {
 124     open (FILE,"$path/members-top.inc") || die;
 125   } elsif ($type eq 'acquisitions'){
 126     open (FILE,"$path/acquisitions-top.inc")|| die;
 127   } elsif ($type eq 'report'){
 128     open (FILE,"$path/reports-top.inc") || die;
 129   } elsif ($type eq 'circulation') {
 130     open (FILE,"$path/circulation-top.inc") || die;
 131   } else {
 132     open (FILE,"$path/cat-top.inc") || die;
 133   }
 134   my @string=<FILE>;
 135   close FILE;
 136   my $count=@string;
 137   #  $string[$count]="<BLOCKQUOTE>";
 138   return @string;
 139 }
 140
 141
 142 sub endmenu{
 143   my ($type)=@_;
 144   if ($type eq 'issue'){
 145     open (FILE,"$path/issues-bottom.inc") || die;
 146   } elsif ($type eq 'opac') {
 147     open (FILE,"$path/opac-bottom.inc") || die;
 148   } elsif ($type eq 'member') {
 149     open (FILE,"$path/members-bottom.inc") || die;
 150   } elsif ($type eq 'acquisitions') {
 151     open (FILE,"$path/acquisitions-bottom.inc") || die;
 152   } elsif ($type eq 'report') {
 153     open (FILE,"$path/reports-bottom.inc") || die;
 154   } elsif ($type eq 'circulation') {
 155     open (FILE,"$path/circulation-bottom.inc") || die;
 156   } else {
 157     open (FILE,"$path/cat-bottom.inc") || die;
 158   }
 159   my @string=<FILE>;
 160   close FILE;
 161   return @string;
 162 }
 163
 164 sub mktablehdr {
 165     return("<table border=0 cellspacing=0 cellpadding=5>\n");
 166 }
 167
 168
 169 sub mktablerow {
 170     #the last item in data may be a backgroundimage
 171
 172     # FIXME
 173     # should this be a foreach (1..$cols) loop?
 174
 175   my ($cols,$colour,@data)=@_;
 176   my $i=0;
 177   my $string="<tr valign=top bgcolor=$colour>";
 178   while ($i <$cols){
 179     if ($data[$cols] ne ''){
 180     #check for backgroundimage
 181       $string.="<td background=\"$data[$cols]\">";
 182     } else {
 183       $string.="<td>";
 184     }
 185     if ($data[$i] eq "") {
 186       $string.=" &nbsp; </td>";
 187     } else {
 188       $string.="$data[$i]</td>";
 189     }
 190     $i++;
 191   }
 192   $string=$string."</tr>\n";
 193   return($string);
 194 }
 195
 196 sub mktableft {
 197   return("</table>\n");
 198 }
 199
 200 sub mkform{
 201   my ($action,%inputs)=@_;
 202   my $string="<form action=$action method=post>\n";
 203   $string=$string.mktablehdr();
 204   my $key;
 205   my @keys=sort keys %inputs;
 206
 207   my $count=@keys;
 208   my $i2=0;
 209   while ( $i2<$count) {
 210     my $value=$inputs{$keys[$i2]};
 211     my @data=split('\t',$value);
 212     #my $posn = shift(@data);
 213     if ($data[0] eq 'hidden'){
 214       $string=$string."<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
 215     } else {
 216       my $text;
 217       if ($data[0] eq 'radio') {
 218         $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
 219         <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
 220       }
 221       if ($data[0] eq 'text') {
 222         $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
 223       }
 224       if ($data[0] eq 'textarea') {
 225         $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
 226       }
 227       if ($data[0] eq 'select') {
 228         $text="<select name=$keys[$i2]>";
 229         my $i=1;
 230         while ($data[$i] ne "") {
 231           my $val = $data[$i+1];
 232           $text = $text."<option value=$data[$i]>$val";
 233           $i = $i+2;
 234         }
 235         $text=$text."</select>";
 236       }
 237       $string=$string.mktablerow(2,'white',$keys[$i2],$text);
 238       #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
 239     }
 240     $i2++;
 241   }
 242   #$string=$string.join("\n",@order);
 243   $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
 244   $string=$string.mktableft;
 245   $string=$string."</form>";
 246 }
 247
 248 sub mkform3 {
 249   my ($action, %inputs) = @_;
 250   my $string = "<form action=\"$action\" method=\"post\">\n";
 251   $string   .= mktablehdr();
 252   my $key;
 253   my @keys = sort(keys(%inputs));
 254   my @order;
 255   my $count = @keys;
 256   my $i2 = 0;
 257   while ($i2 < $count) {
 258     my $value=$inputs{$keys[$i2]};
 259     my @data=split('\t',$value);
 260     my $posn = $data[2];
 261     if ($data[0] eq 'hidden'){
 262       $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
 263     } else {
 264       my $text;
 265       if ($data[0] eq 'radio') {
 266         $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
 267         <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
 268       }
 269       if ($data[0] eq 'text') {
 270         $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
 271       }
 272       if ($data[0] eq 'textarea') {
 273         $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
 274       }
 275       if ($data[0] eq 'select') {
 276         $text="<select name=$keys[$i2]>";
 277         my $i=1;
 278         while ($data[$i] ne "") {
 279           my $val = $data[$i+1];
 280           $text = $text."<option value=$data[$i]>$val";
 281           $i = $i+2;
 282         }
 283         $text=$text."</select>";
 284       }
 285 #      $string=$string.mktablerow(2,'white',$keys[$i2],$text);
 286       $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
 287     }
 288     $i2++;
 289   }
 290   my $temp=join("\n",@order);
 291   $string=$string.$temp;
 292   $string=$string.mktablerow(1,'white','<input type=submit>');
 293   $string=$string.mktableft;
 294   $string=$string."</form>";
 295 }
 296
 297 sub mkformnotable{
 298   my ($action,@inputs)=@_;
 299   my $string="<form action=$action method=post>\n";
 300   my $count=@inputs;
 301   for (my $i=0; $i<$count; $i++){
 302     if ($inputs[$i][0] eq 'hidden'){
 303       $string=$string."<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
 304     }
 305     if ($inputs[$i][0] eq 'radio') {
 306       $string.="<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
 307     }
 308     if ($inputs[$i][0] eq 'text') {
 309       $string.="<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 310     }
 311     if ($inputs[$i][0] eq 'textarea') {
 312         $string.="<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
 313     }
 314     if ($inputs[$i][0] eq 'reset'){
 315       $string.="<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 316     }
 317     if ($inputs[$i][0] eq 'submit'){
 318       $string.="<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
 319     }
 320   }
 321   $string=$string."</form>";
 322 }
 323
 324 sub mkform2{
 325   my ($action,%inputs)=@_;
 326   my $string="<form action=$action method=post>\n";
 327   $string=$string.mktablehdr();
 328   my $key;
 329   my @order;
 330   while ( my ($key, $value) = each %inputs) {
 331     my @data=split('\t',$value);
 332     my $posn = shift(@data);
 333     my $reqd = shift(@data);
 334     my $ltext = shift(@data);
 335     if ($data[0] eq 'hidden'){
 336       $string=$string."<input type=hidden name=$key value=\"$data[1]\">\n";
 337     } else {
 338       my $text;
 339       if ($data[0] eq 'radio') {
 340         $text="<input type=radio name=$key value=$data[1]>$data[1]
 341         <input type=radio name=$key value=$data[2]>$data[2]";
 342       } elsif ($data[0] eq 'text') {
 343         my $size = $data[1];
 344         if ($size eq "") {
 345           $size=40;
 346         }
 347         $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
 348       } elsif ($data[0] eq 'textarea') {
 349         my @size=split("x",$data[1]);
 350         if ($data[1] eq "") {
 351           $size[0] = 40;
 352           $size[1] = 4;
 353         }
 354         $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
 355       } elsif ($data[0] eq 'select') {
 356         $text="<select name=$key>";
 357         my $sel=$data[1];
 358         my $i=2;
 359         while ($data[$i] ne "") {
 360           my $val = $data[$i+1];
 361           $text = $text."<option value=\"$data[$i]\"";
 362           if ($data[$i] eq $sel) {
 363              $text = $text." selected";
 364           }
 365           $text = $text.">$val";
 366           $i = $i+2;
 367         }
 368         $text=$text."</select>";
 369       }
 370       if ($reqd eq "R") {
 371         $ltext = $ltext." (Req)";
 372         }
 373       @order[$posn] =mktablerow(2,'white',$ltext,$text);
 374     }
 375   }
 376   $string=$string.join("\n",@order);
 377   $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
 378   $string=$string.mktableft;
 379   $string=$string."</form>";
 380 }
 381
 382
 383 sub endpage{
 384   return("</body></html>\n");
 385 }
 386
 387 sub mklink {
 388   my ($url,$text)=@_;
 389   my $string="<a href=\"$url\">$text</a>";
 390   return ($string);
 391 }
 392
 393 sub mkheadr {
 394   my ($type,$text)=@_;
 395   my $string;
 396   if ($type eq '1'){
 397     $string="<FONT SIZE=6><em>$text</em></FONT><br>";
 398   }
 399   if ($type eq '2'){
 400     $string="<FONT SIZE=6><em>$text</em></FONT>";
 401   }
 402     if ($type eq '3'){
 403     $string="<FONT SIZE=6><em>$text</em></FONT><p>";
 404   }
 405   return ($string);
 406 }
 407
 408 sub center {
 409   return ("<CENTER>\n");
 410 }
 411
 412 sub endcenter {
 413   return ("</CENTER>\n");
 414 }
 415
 416 sub bold {
 417   my ($text)=@_;
 418   my $string="<b>$text</b>";
 419   return($string);
 420 }
 421
 422
 423
 424
 425 END { }       # module clean-up code here (global destructor)
 426
 427
 428