[Koha-cvs] CVS: koha/C4 Output.pm,1.10,1.11
Paul POULAIN
tipaul at users.sourceforge.net
Wed Jul 3 14:41:03 CEST 2002
Update of /cvsroot/koha/koha/C4
In directory usw-pr-cvs1:/tmp/cvs-serv4080/C4
Modified Files:
Output.pm
Log Message:
merging 1.2 and main branches
Index: Output.pm
===================================================================
RCS file: /cvsroot/koha/koha/C4/Output.pm,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -r1.10 -r1.11
*** Output.pm 21 May 2002 06:15:41 -0000 1.10
--- Output.pm 3 Jul 2002 12:41:01 -0000 1.11
***************
*** 1,3 ****
! package C4::Output; #asummes C4/Output
#package to deal with marking up output
--- 1,3 ----
! package C4::Output;
#package to deal with marking up output
***************
*** 6,12 ****
use strict;
use warnings;
use C4::Database;
- require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
--- 6,13 ----
use strict;
+ require Exporter;
use warnings;
+
use C4::Database;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
***************
*** 16,22 ****
@ISA = qw(Exporter);
! @EXPORT = qw(&startpage &endpage &mktablehdr &mktableft &mktablerow &mklink
! &startmenu &endmenu &mkheadr ¢er &endcenter &mkform &mkform2 &bold
! &gotopage &mkformnotable &mkform3 picktemplate);
%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
--- 17,28 ----
@ISA = qw(Exporter);
! @EXPORT = qw(&startpage &endpage
! &mktablehdr &mktableft &mktablerow &mklink
! &startmenu &endmenu &mkheadr
! ¢er &endcenter
! &mkform &mkform2 &bold
! &gotopage &mkformnotable &mkform3
! &getkeytableselectoptions
! &picktemplate);
%EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ],
***************
*** 95,107 ****
}
!
!
! sub startpage{
return("<html>\n");
}
! sub gotopage{
! my ($target) = @_;
! print "<br>goto target = $target<br>";
my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
return $string;
--- 101,111 ----
}
! sub startpage() {
return("<html>\n");
}
! sub gotopage($) {
! my ($target) = shif;
! #print "<br>goto target = $target<br>";
my $string = "<META HTTP-EQUIV=Refresh CONTENT=\"0;URL=http:$target\">";
return $string;
***************
*** 109,115 ****
! sub startmenu{
# edit the paths in here
! my ($type)=@_;
if ($type eq 'issue') {
open (FILE,"$path/issues-top.inc") || die;
--- 113,119 ----
! sub startmenu($) {
# edit the paths in here
! my ($type)=shift;
if ($type eq 'issue') {
open (FILE,"$path/issues-top.inc") || die;
***************
*** 119,124 ****
open (FILE,"$path/members-top.inc") || die;
} elsif ($type eq 'acquisitions'){
! open (FILE,"$path/acquisitions-top.inc")
! || die "Cannot open $path/acquisitions-top.inc";
} elsif ($type eq 'report'){
open (FILE,"$path/reports-top.inc") || die;
--- 123,127 ----
open (FILE,"$path/members-top.inc") || die;
} elsif ($type eq 'acquisitions'){
! open (FILE,"$path/acquisitions-top.inc") || die;
} elsif ($type eq 'report'){
open (FILE,"$path/reports-top.inc") || die;
***************
*** 130,135 ****
my @string=<FILE>;
close FILE;
! my $count=@string;
! # $string[$count]="<BLOCKQUOTE>";
return @string;
}
--- 133,138 ----
my @string=<FILE>;
close FILE;
! # my $count=@string;
! # $string[$count]="<BLOCKQUOTE>";
return @string;
}
***************
*** 159,163 ****
}
! sub mktablehdr {
return("<table border=0 cellspacing=0 cellpadding=5>\n");
}
--- 162,166 ----
}
! sub mktablehdr() {
return("<table border=0 cellspacing=0 cellpadding=5>\n");
}
***************
*** 174,189 ****
my $string="<tr valign=top bgcolor=$colour>";
while ($i <$cols){
! if ($data[$cols] ne ''){
! #check for backgroundimage
! $string.="<td background=\"$data[$cols]\">";
! } else {
! $string.="<td>";
! }
! if ($data[$i] eq "") {
! $string.=" </td>";
! } else {
! $string.="$data[$i]</td>";
! }
! $i++;
}
$string=$string."</tr>\n";
--- 177,191 ----
my $string="<tr valign=top bgcolor=$colour>";
while ($i <$cols){
! if (defined $data[$cols]) { # if there is a background image
! $string.="<td background=\"$data[$cols]\">";
! } else { # if there's no background image
! $string.="<td>";
! }
! if ($data[$i] eq "") {
! $string.=" </td>";
! } else {
! $string.="$data[$i]</td>";
! }
! $i++;
}
$string=$string."</tr>\n";
***************
*** 191,195 ****
}
! sub mktableft {
return("</table>\n");
}
--- 193,197 ----
}
! sub mktableft() {
return("</table>\n");
}
***************
*** 249,253 ****
my $key;
my @keys = sort(keys(%inputs));
! my @order;
my $count = @keys;
my $i2 = 0;
--- 251,255 ----
my $key;
my @keys = sort(keys(%inputs));
! my @order;
my $count = @keys;
my $i2 = 0;
***************
*** 320,323 ****
--- 322,332 ----
sub mkform2{
+ # FIXME
+ # no POD and no tests yet. Once tests are written,
+ # this function can be cleaned up with the following steps:
+ # turn the while loop into a foreach loop
+ # pull the nested if,elsif structure back up to the main level
+ # pull the code for the different kinds of inputs into separate
+ # functions
my ($action,%inputs)=@_;
my $string="<form action=$action method=post>\n";
***************
*** 377,386 ****
}
! sub endpage{
return("</body></html>\n");
}
! sub mklink {
my ($url,$text)=@_;
my $string="<a href=\"$url\">$text</a>";
--- 386,414 ----
}
+ =pod
+
+ =head2 &endpage
! &endpage does not expect any arguments, it returns the string:
! </body></html>\n
!
! =cut
!
! sub endpage() {
return("</body></html>\n");
}
! =pod
!
! =head2 &mklink
!
! &mklink expects two arguments, the url to link to and the text of the link.
! It returns this string:
! <a href="$url">$text</a>
! where $url is the first argument and $text is the second.
!
! =cut
!
! sub mklink($$) {
my ($url,$text)=@_;
my $string="<a href=\"$url\">$text</a>";
***************
*** 388,392 ****
--- 416,448 ----
}
+ =pod
+
+ =head2 &mkheadr
+
+ &mkeadr expects two strings, a type and the text to use in the header.
+ types are:
+
+ =over
+
+ =item 1 ends with <br>
+
+ =item 2 no special ending tag
+
+ =item 3 ends with <p>
+
+ =back
+
+ Other than this, the return value is the same:
+ <FONT SIZE=6><em>$text</em></FONT>$string
+ Where $test is the text passed in and $string is the tag generated from
+ the type value.
+
+ =cut
+
sub mkheadr {
+ # FIXME
+ # would it be better to make this more generic by accepting an optional
+ # argument with a closing tag instead of a numeric type?
+
my ($type,$text)=@_;
my $string;
***************
*** 395,401 ****
}
if ($type eq '2'){
! $string="<FONT SIZE=6><em>$text</em></FONT>";
}
! if ($type eq '3'){
$string="<FONT SIZE=6><em>$text</em></FONT><p>";
}
--- 451,457 ----
}
if ($type eq '2'){
! $string="<FONT SIZE=6><em>$text</em></FONT><br>";
}
! if ($type eq '3'){
$string="<FONT SIZE=6><em>$text</em></FONT><p>";
}
***************
*** 403,422 ****
}
! sub center {
return ("<CENTER>\n");
}
! sub endcenter {
return ("</CENTER>\n");
}
! sub bold {
! my ($text)=@_;
! my $string="<b>$text</b>";
! return($string);
! }
END { } # module clean-up code here (global destructor)
--- 459,541 ----
}
! =pod
!
! =head2 ¢er and &endcenter
!
! ¢er and &endcenter take no arguments and return html tags <CENTER> and
! </CENTER> respectivley.
!
! =cut
!
! sub center() {
return ("<CENTER>\n");
}
! sub endcenter() {
return ("</CENTER>\n");
}
! =pod
!
! =head2 &bold
!
! &bold requires that a single string be passed in by the caller. &bold
! will return "<b>$text</b>" where $text is the string passed in.
+ =cut
+ sub bold($) {
+ my ($text)=shift;
+ return("<b>$text</b>");
+ }
+
+ #---------------------------------------------
+ # Create an HTML option list for a <SELECT> form tag by using
+ # values from a DB file
+ sub getkeytableselectoptions {
+ use strict;
+ # inputs
+ my (
+ $dbh, # DBI handle
+ $tablename, # name of table containing list of choices
+ $keyfieldname, # column name of code to use in option list
+ $descfieldname, # column name of descriptive field
+ $showkey, # flag to show key in description
+ $default, # optional default key
+ )=@_;
+ my $selectclause; # return value
+
+ my (
+ $sth, $query,
+ $key, $desc, $orderfieldname,
+ );
+ my $debug=0;
+
+ requireDBI($dbh,"getkeytableselectoptions");
+
+ if ( $showkey ) {
+ $orderfieldname=$keyfieldname;
+ } else {
+ $orderfieldname=$descfieldname;
+ }
+ $query= "select $keyfieldname,$descfieldname
+ from $tablename
+ order by $orderfieldname ";
+ print "<PRE>Query=$query </PRE>\n" if $debug;
+ $sth=$dbh->prepare($query);
+ $sth->execute;
+ while ( ($key, $desc) = $sth->fetchrow) {
+ if ($showkey || ! $desc ) { $desc="$key - $desc"; }
+ $selectclause.="<option";
+ if (defined $default && $default eq $key) {
+ $selectclause.=" selected";
+ }
+ $selectclause.=" value='$key'>$desc\n";
+ print "<PRE>Sel=$selectclause </PRE>\n" if $debug;
+ }
+ return $selectclause;
+ } # sub getkeytableselectoptions
+ #---------------------------------
END { } # module clean-up code here (global destructor)
More information about the Koha-cvs
mailing list