Initial revision
[wip/koha-chris_n.git] / 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 $path="/usr/local/www/hdl/htdocs/includes";
47
48
49 # here's a file-private function as a closure,
50 # callable as &$priv_func;  it cannot be prototyped.
51 my $priv_func = sub {
52 # stuff goes here.
53   };
54    
55 # make all your functions, whether exported or not;
56  
57 sub startpage{
58   my $string="<html>\n";
59   return($string);
60 }
61
62 sub gotopage{
63   my ($target) = @_;
64   print "<br>goto target = $target<br>";
65   my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
66   return $string;
67 }
68
69
70 sub startmenu{
71   # edit the paths in here
72   my ($type)=@_;
73   if ($type eq 'issue') {
74     open (FILE,"$path/issues-top.inc") || die;
75   } elsif ($type eq 'opac') {
76     open (FILE,"$path/opac-top.inc") || die;
77   } elsif ($type eq 'member') {
78     open (FILE,"$path/members-top.inc") || die;
79   } elsif ($type eq 'acquisitions'){
80     open (FILE,"$path/aquisitions-top.inc")|| die;
81   } elsif ($type eq 'report'){
82     open (FILE,"$path/reports-top.inc") || die;
83   } else {
84     open (FILE,"$path/cat-top.inc") || die;
85   }
86   my @string=<FILE>;
87   close FILE;
88   my $count=@string;
89   #  $string[$count]="<BLOCKQUOTE>";
90   return @string;
91 }
92
93
94 sub endmenu{
95   my ($type)=@_;
96   if ($type eq 'issue'){
97     open (FILE,"$path/issues-bottom.inc") || die;
98   } elsif ($type eq 'opac') {
99     open (FILE,"$path/opac-bottom.inc") || die;
100   } elsif ($type eq 'member') {
101     open (FILE,"$path/members-bottom.inc") || die;
102   } elsif ($type eq 'acquisitions') {
103     open (FILE,"$path/aquisitions-bottom.inc") || die;
104   } elsif ($type eq 'report') {
105     open (FILE,"$path/reports-bottom.inc") || die;
106   } else {
107     open (FILE,"$path/cat-bottom.inc") || die;
108   }
109   my @string=<FILE>;
110   close FILE;
111   return @string;
112 }
113
114 sub mktablehdr {
115   my $string="<table border=0 cellspacing=0 cellpadding=5>\n";
116   return($string);
117 }
118
119
120 sub mktablerow {
121   #the last item in data may be a backgroundimage
122   my ($cols,$colour,@data)=@_;
123   my $i=0;
124   my $string="<tr valign=top bgcolor=$colour>";
125   while ($i <$cols){
126     if ($data[$cols] ne ''){
127     #check for backgroundimage
128       $string.="<td background=\"$data[$cols]\">";
129     } else {
130       $string.="<td>";
131     }
132     if ($data[$i] eq "") {
133       $string.=" &nbsp; </td>";
134     } else {
135       $string.="$data[$i]</td>";
136     } 
137     $i++;
138   }
139   $string=$string."</tr>\n";
140   return($string);
141 }
142
143 sub mktableft {
144   my $string="</table>\n";
145   return($string);
146 }
147
148 sub mkform{
149   my ($action,%inputs)=@_;
150   my $string="<form action=$action method=post>\n";
151   $string=$string.mktablehdr();
152   my $key;
153   my @keys=sort keys %inputs;
154   
155   my $count=@keys;
156   my $i2=0;
157   while ( $i2<$count) {
158     my $value=$inputs{$keys[$i2]};
159     my @data=split('\t',$value);
160     #my $posn = shift(@data);
161     if ($data[0] eq 'hidden'){
162       $string=$string."<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
163     } else {
164       my $text;
165       if ($data[0] eq 'radio') {
166         $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
167         <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
168       } 
169       if ($data[0] eq 'text') {
170         $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\">";
171       }
172       if ($data[0] eq 'textarea') {
173         $text="<textarea name=$keys[$i2] wrap=physical cols=40 rows=4>$data[1]</textarea>";
174       }
175       if ($data[0] eq 'select') {
176         $text="<select name=$keys[$i2]>";
177         my $i=1;
178         while ($data[$i] ne "") {
179           my $val = $data[$i+1];
180           $text = $text."<option value=$data[$i]>$val";
181           $i = $i+2;
182         }
183         $text=$text."</select>";
184       } 
185       $string=$string.mktablerow(2,'white',$keys[$i2],$text);
186       #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text);
187     }
188     $i2++;
189   }
190   #$string=$string.join("\n",@order);
191   $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
192   $string=$string.mktableft;
193   $string=$string."</form>";
194 }
195
196 sub mkform3{
197   my ($action,%inputs)=@_;
198   my $string="<form action=$action method=post>\n";
199   $string=$string.mktablehdr();
200   my $key;
201   my @keys=sort keys %inputs;
202   my @order;  
203   my $count=@keys;
204   my $i2=0;
205   while ( $i2<$count) {
206     my $value=$inputs{$keys[$i2]};
207     my @data=split('\t',$value);
208     my $posn = $data[2];
209     if ($data[0] eq 'hidden'){
210       $order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
211     } else {
212       my $text;
213       if ($data[0] eq 'radio') {
214         $text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
215         <input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
216       } 
217       if ($data[0] eq 'text') {
218         $text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
219       }
220       if ($data[0] eq 'textarea') {
221         $text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
222       }
223       if ($data[0] eq 'select') {
224         $text="<select name=$keys[$i2]>";
225         my $i=1;
226         while ($data[$i] ne "") {
227           my $val = $data[$i+1];
228           $text = $text."<option value=$data[$i]>$val";
229           $i = $i+2;
230         }
231         $text=$text."</select>";
232       } 
233 #      $string=$string.mktablerow(2,'white',$keys[$i2],$text);
234       $order[$posn]=mktablerow(2,'white',$keys[$i2],$text);
235     }
236     $i2++;
237   }
238   my $temp=join("\n",@order);
239   $string=$string.$temp;
240   $string=$string.mktablerow(1,'white','<input type=submit>');
241   $string=$string.mktableft;
242   $string=$string."</form>";
243 }
244
245 sub mkformnotable{
246   my ($action,@inputs)=@_;
247   my $string="<form action=$action method=post>\n";
248   my $count=@inputs;
249   for (my $i=0; $i<$count; $i++){
250     if ($inputs[$i][0] eq 'hidden'){
251       $string=$string."<input type=hidden name=$inputs[$i][1] value=\"$inputs[$i][2]\">\n";
252     }
253     if ($inputs[$i][0] eq 'radio') {
254       $string.="<input type=radio name=$inputs[1] value=$inputs[$i][2]>$inputs[$i][2]";
255     } 
256     if ($inputs[$i][0] eq 'text') {
257       $string.="<input type=$inputs[$i][0] name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
258     }
259     if ($inputs[$i][0] eq 'textarea') {
260         $string.="<textarea name=$inputs[$i][1] wrap=physical cols=40 rows=4>$inputs[$i][2]</textarea>";
261     }
262     if ($inputs[$i][0] eq 'reset'){
263       $string.="<input type=reset name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
264     }    
265     if ($inputs[$i][0] eq 'submit'){
266       $string.="<input type=submit name=$inputs[$i][1] value=\"$inputs[$i][2]\">";
267     }    
268   }
269   $string=$string."</form>";
270 }
271
272 sub mkform2{
273   my ($action,%inputs)=@_;
274   my $string="<form action=$action method=post>\n";
275   $string=$string.mktablehdr();
276   my $key;
277   my @order;
278   while ( my ($key, $value) = each %inputs) {
279     my @data=split('\t',$value);
280     my $posn = shift(@data);
281     my $reqd = shift(@data);
282     my $ltext = shift(@data);    
283     if ($data[0] eq 'hidden'){
284       $string=$string."<input type=hidden name=$key value=\"$data[1]\">\n";
285     } else {
286       my $text;
287       if ($data[0] eq 'radio') {
288         $text="<input type=radio name=$key value=$data[1]>$data[1]
289         <input type=radio name=$key value=$data[2]>$data[2]";
290       } elsif ($data[0] eq 'text') {
291         my $size = $data[1];
292         if ($size eq "") {
293           $size=40;
294         }
295         $text="<input type=$data[0] name=$key size=$size value=\"$data[2]\">";
296       } elsif ($data[0] eq 'textarea') {
297         my @size=split("x",$data[1]);
298         if ($data[1] eq "") {
299           $size[0] = 40;
300           $size[1] = 4;
301         }
302         $text="<textarea name=$key wrap=physical cols=$size[0] rows=$size[1]>$data[2]</textarea>";
303       } elsif ($data[0] eq 'select') {
304         $text="<select name=$key>";
305         my $sel=$data[1];
306         my $i=2;
307         while ($data[$i] ne "") {
308           my $val = $data[$i+1];
309           $text = $text."<option value=\"$data[$i]\"";
310           if ($data[$i] eq $sel) {
311              $text = $text." selected";
312           }   
313           $text = $text.">$val";
314           $i = $i+2;
315         }
316         $text=$text."</select>";
317       }
318       if ($reqd eq "R") {
319         $ltext = $ltext." (Req)";
320         }
321       @order[$posn] =mktablerow(2,'white',$ltext,$text);
322     }
323   }
324   $string=$string.join("\n",@order);
325   $string=$string.mktablerow(2,'white','<input type=submit>','<input type=reset>');
326   $string=$string.mktableft;
327   $string=$string."</form>";
328 }
329
330
331 sub endpage{
332   my $string="</body></html>\n";
333   return($string);
334 }
335
336 sub mklink {
337   my ($url,$text)=@_;
338   my $string="<a href=\"$url\">$text</a>";
339   return ($string);
340 }
341
342 sub mkheadr {
343   my ($type,$text)=@_;
344   my $string;
345   if ($type eq '1'){
346     $string="<FONT SIZE=6><em>$text</em></FONT><br>";
347   }
348   if ($type eq '2'){
349     $string="<FONT SIZE=6><em>$text</em></FONT>";
350   }
351     if ($type eq '3'){
352     $string="<FONT SIZE=6><em>$text</em></FONT><p>";
353   }
354   return ($string);
355 }
356
357 sub center {
358   my ($text)=@_;
359   my $string="<CENTER>\n";
360   return ($string);
361 }  
362
363 sub endcenter {
364   my ($text)=@_;
365   my $string="</CENTER>\n";
366   return ($string);
367 }  
368
369 sub bold {
370   my ($text)=@_;
371   my $string="<b>$text</b>";
372   return($string);
373 }
374
375 END { }       # module clean-up code here (global destructor)
376