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
8 # Copyright 2000-2002 Katipo Communications
10 # This file is part of Koha.
12 # Koha is free software; you can redistribute it and/or modify it under the
13 # terms of the GNU General Public License as published by the Free Software
14 # Foundation; either version 2 of the License, or (at your option) any later
17 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
18 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
19 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
21 # You should have received a copy of the GNU General Public License along with
22 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
23 # Suite 330, Boston, MA 02111-1307 USA
30 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
32 # set the version for version checking
36 @EXPORT = qw(&startpage &endpage
37 &mktablehdr &mktableft &mktablerow &mklink
38 &startmenu &endmenu &mkheadr
40 &mkform &mkform2 &bold
41 &gotopage &mkformnotable &mkform3
42 &getkeytableselectoptions
44 %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
46 # your exported package globals go here,
47 # as well as any optionally exported functions
49 @EXPORT_OK = qw($Var1 %Hashit);
52 # non-exported package globals go here
53 use vars qw(@more $stuff);
55 # initalize package globals, first exported ones
61 # then the others (which are still accessible as $Some::Module::stuff)
65 # all file-scoped lexicals must be created before
66 # the functions below that use them.
69 # Change this value to reflect where you will store your includes
72 open (KC, "/etc/koha.conf");
76 if (/(.*)\s*=\s*(.*)/) {
80 $variable =~ s/^\s*//g;
81 $variable =~ s/\s*$//g;
84 $configfile{$variable}=$value;
89 my $path=$configfile{'includes'};
90 ($path) || ($path="/usr/local/www/hdl/htdocs/includes");
92 # make all your functions, whether exported or not;
95 my ($includes, $base) = @_;
98 opendir (D, "$includes/templates");
99 my @dirlist=readdir D;
102 #(next) unless (/\.tmpl$/);
103 (next) unless (-e "$includes/templates/$_/$base");
106 my $sth=$dbh->prepare("select value from systempreferences where
107 variable='template'");
109 my ($preftemplate) = $sth->fetchrow;
112 if ($templates->{$preftemplate}) {
113 return $preftemplate;
125 my ($target) = shift;
126 #print "<br>goto target = $target<br>";
127 my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
133 # edit the paths in here
135 if ($type eq 'issue') {
136 open (FILE,"$path/issues-top.inc") || die;
137 } elsif ($type eq 'opac') {
138 open (FILE,"$path/opac-top.inc") || die;
139 } elsif ($type eq 'member') {
140 open (FILE,"$path/members-top.inc") || die;
141 } elsif ($type eq 'acquisitions'){
142 open (FILE,"$path/acquisitions-top.inc") || die;
143 } elsif ($type eq 'report'){
144 open (FILE,"$path/reports-top.inc") || die;
145 } elsif ($type eq 'circulation') {
146 open (FILE,"$path/circulation-top.inc") || die;
148 open (FILE,"$path/cat-top.inc") || die;
153 # $string[$count]="<BLOCKQUOTE>";
160 if ( ! defined $type ) { $type=''; }
161 if ($type eq 'issue') {
162 open (FILE,"$path/issues-bottom.inc") || die;
163 } elsif ($type eq 'opac') {
164 open (FILE,"$path/opac-bottom.inc") || die;
165 } elsif ($type eq 'member') {
166 open (FILE,"$path/members-bottom.inc") || die;
167 } elsif ($type eq 'acquisitions') {
168 open (FILE,"$path/acquisitions-bottom.inc") || die;
169 } elsif ($type eq 'report') {
170 open (FILE,"$path/reports-bottom.inc") || die;
171 } elsif ($type eq 'circulation') {
172 open (FILE,"$path/circulation-bottom.inc") || die;
174 open (FILE,"$path/cat-bottom.inc") || die;
182 return("<table border=0 cellspacing=0 cellpadding=5>\n");
187 #the last item in data may be a backgroundimage
190 # should this be a foreach (1..$cols) loop?
192 my ($cols,$colour,@data)=@_;
194 my $string="<tr valign=top bgcolor=$colour>";
196 if (defined $data[$cols]) { # if there is a background image
197 $string.="<td background=\"$data[$cols]\">";
198 } else { # if there's no background image
201 if (! defined $data[$i]) {$data[$i]="";}
202 if ($data[$i] eq "") {
203 $string.=" </td>";
205 $string.="$data[$i]</td>";
209 $string=$string."</tr>\n";
214 return("</table>\n");
218 my ($action,%inputs)=@_;
219 my $string="<form action=$action method=post>\n";
220 $string=$string.mktablehdr();
222 my @keys=sort keys %inputs;
226 while ( $i2<$count) {
227 my $value=$inputs{$keys[$i2]};
228 my @data=split('\t',$value);
229 #my $posn = shift(@data);
230 if ($data[0] eq 'hidden'){
231 $string=$string."<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
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]";
238 if ($data[0] eq 'text') {
239 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
241 if ($data[0] eq 'textarea') {
242 $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
244 if ($data[0] eq 'select') {
245 $text="<select name=$keys[$i2]>";
247 while ($data[$i] ne "") {
248 my $val = $data[$i+1];
249 $text = $text."<option value=$data[$i]>$val";
252 $text=$text."</select>";
254 $string=$string.mktablerow(2,'white',$keys[$i2],$text);
255 #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
259 #$string=$string.join("\n",@order);
260 $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
261 $string=$string.mktableft;
262 $string=$string."</form>";
266 my ($action, %inputs) = @_;
267 my $string = "<form action=\"$action\" method=\"post\">\n";
268 $string .= mktablehdr();
270 my @keys = sort(keys(%inputs));
274 while ($i2 < $count) {
275 my $value=$inputs{$keys[$i2]};
276 my @data=split('\t',$value);
278 if ($data[0] eq 'hidden'){
279 $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
282 if ($data[0] eq 'radio') {
283 $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
284 <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
286 if ($data[0] eq 'text') {
287 $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
289 if ($data[0] eq 'textarea') {
290 $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
292 if ($data[0] eq 'select') {
293 $text="<select name=$keys[$i2]>";
295 while ($data[$i] ne "") {
296 my $val = $data[$i+1];
297 $text = $text."<option value=$data[$i]>$val";
300 $text=$text."</select>";
302 # $string=$string.mktablerow(2,'white',$keys[$i2],$text);
303 $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
307 my $temp=join("\n",@order);
308 $string=$string.$temp;
309 $string=$string.mktablerow(1,'white','<input type=submit>');
310 $string=$string.mktableft;
311 $string=$string."</form>";
315 my ($action,@inputs)=@_;
316 my $string="<form action=$action method=post>\n";
318 for (my $i=0; $i<$count; $i++){
319 if ($inputs[$i][0] eq 'hidden'){
320 $string=$string."<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
322 if ($inputs[$i][0] eq 'radio') {
323 $string.="<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
325 if ($inputs[$i][0] eq 'text') {
326 $string.="<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
328 if ($inputs[$i][0] eq 'textarea') {
329 $string.="<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
331 if ($inputs[$i][0] eq 'reset'){
332 $string.="<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
334 if ($inputs[$i][0] eq 'submit'){
335 $string.="<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
338 $string=$string."</form>";
343 # no POD and no tests yet. Once tests are written,
344 # this function can be cleaned up with the following steps:
345 # turn the while loop into a foreach loop
346 # pull the nested if,elsif structure back up to the main level
347 # pull the code for the different kinds of inputs into separate
349 my ($action,%inputs)=@_;
350 my $string="<form action=$action method=post>\n";
351 $string=$string.mktablehdr();
354 while ( my ($key, $value) = each %inputs) {
355 my @data=split('\t',$value);
356 my $posn = shift(@data);
357 my $reqd = shift(@data);
358 my $ltext = shift(@data);
359 if ($data[0] eq 'hidden'){
360 $string=$string."<input type=hidden name=$key value=\"$data[1]\">\n";
363 if ($data[0] eq 'radio') {
364 $text="<input type=radio name=$key value=$data[1]>$data[1]
365 <input type=radio name=$key value=$data[2]>$data[2]";
366 } elsif ($data[0] eq 'text') {
371 $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
372 } elsif ($data[0] eq 'textarea') {
373 my @size=split("x",$data[1]);
374 if ($data[1] eq "") {
378 $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
379 } elsif ($data[0] eq 'select') {
380 $text="<select name=$key>";
383 while ($data[$i] ne "") {
384 my $val = $data[$i+1];
385 $text = $text."<option value=\"$data[$i]\"";
386 if ($data[$i] eq $sel) {
387 $text = $text." selected";
389 $text = $text.">$val";
392 $text=$text."</select>";
395 $ltext = $ltext." (Req)";
397 $order[$posn] =mktablerow(2,'white',$ltext,$text);
400 $string=$string.join("\n",@order);
401 $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
402 $string=$string.mktableft;
403 $string=$string."</form>";
410 &endpage does not expect any arguments, it returns the string:
416 return("</body></html>\n");
423 &mklink expects two arguments, the url to link to and the text of the link.
424 It returns this string:
425 <a href="$url">$text</a>
426 where $url is the first argument and $text is the second.
432 my $string="<a href=\"$url\">$text</a>";
440 &mkeadr expects two strings, a type and the text to use in the header.
445 =item 1 ends with <br>
447 =item 2 no special ending tag
449 =item 3 ends with <p>
453 Other than this, the return value is the same:
454 <FONT SIZE=6><em>$text</em></FONT>$string
455 Where $test is the text passed in and $string is the tag generated from
462 # would it be better to make this more generic by accepting an optional
463 # argument with a closing tag instead of a numeric type?
468 $string="<FONT SIZE=6><em>$text</em></FONT><br>";
471 $string="<FONT SIZE=6><em>$text</em></FONT><br>";
474 $string="<FONT SIZE=6><em>$text</em></FONT><p>";
481 =head2 ¢er and &endcenter
483 ¢er and &endcenter take no arguments and return html tags <CENTER> and
484 </CENTER> respectivley.
489 return ("<CENTER>\n");
493 return ("</CENTER>\n");
500 &bold requires that a single string be passed in by the caller. &bold
501 will return "<b>$text</b>" where $text is the string passed in.
507 return("<b>$text</b>");
510 #---------------------------------------------
511 # Create an HTML option list for a <SELECT> form tag by using
512 # values from a DB file
513 sub getkeytableselectoptions {
518 $tablename, # name of table containing list of choices
519 $keyfieldname, # column name of code to use in option list
520 $descfieldname, # column name of descriptive field
521 $showkey, # flag to show key in description
522 $default, # optional default key
524 my $selectclause; # return value
528 $key, $desc, $orderfieldname,
532 requireDBI($dbh,"getkeytableselectoptions");
535 $orderfieldname=$keyfieldname;
537 $orderfieldname=$descfieldname;
539 $query= "select $keyfieldname,$descfieldname
541 order by $orderfieldname ";
542 print "<PRE>Query=$query </PRE>\n" if $debug;
543 $sth=$dbh->prepare($query);
545 while ( ($key, $desc) = $sth->fetchrow) {
546 if ($showkey || ! $desc ) { $desc="$key - $desc"; }
547 $selectclause.="<option";
548 if (defined $default && $default eq $key) {
549 $selectclause.=" selected";
551 $selectclause.=" value='$key'>$desc\n";
552 print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
554 return $selectclause;
555 } # sub getkeytableselectoptions
557 #---------------------------------
559 END { } # module clean-up code here (global destructor)