package C4::Output; #package to deal with marking up output #You will need to edit parts of this pm #set the value of path to be where your html lives use strict; require Exporter; use C4::Database; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); # set the version for version checking $VERSION = 0.01; @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! ], # your exported package globals go here, # as well as any optionally exported functions @EXPORT_OK = qw($Var1 %Hashit); # non-exported package globals go here use vars qw(@more $stuff); # initalize package globals, first exported ones my $Var1 = ''; my %Hashit = (); # then the others (which are still accessible as $Some::Module::stuff) my $stuff = ''; my @more = (); # all file-scoped lexicals must be created before # the functions below that use them. # # Change this value to reflect where you will store your includes # my %configfile; open (KC, "/etc/koha.conf"); while () { chomp; (next) if (/^\s*#/); if (/(.*)\s*=\s*(.*)/) { my $variable=$1; my $value=$2; $variable =~ s/^\s*//g; $variable =~ s/\s*$//g; $value =~ s/^\s*//g; $value =~ s/\s*$//g; $configfile{$variable}=$value; } # if } # while close(KC); my $path=$configfile{'includes'}; ($path) || ($path="/usr/local/www/hdl/htdocs/includes"); # make all your functions, whether exported or not; sub picktemplate { my ($includes, $base) = @_; my $dbh=C4Connect; my $templates; opendir (D, "$includes/templates"); my @dirlist=readdir D; foreach (@dirlist) { (next) if (/^\./); #(next) unless (/\.tmpl$/); (next) unless (-e "$includes/templates/$_/$base"); $templates->{$_}=1; } my $sth=$dbh->prepare("select value from systempreferences where variable='template'"); $sth->execute; my ($preftemplate) = $sth->fetchrow; $sth->finish; $dbh->disconnect; if ($templates->{$preftemplate}) { return $preftemplate; } else { return 'default'; } } sub startpage() { return("\n"); } sub gotopage($) { my ($target) = shift; #print "
goto target = $target
"; my $string = ""; return $string; } sub startmenu($) { # edit the paths in here my ($type)=shift; if ($type eq 'issue') { open (FILE,"$path/issues-top.inc") || die; } elsif ($type eq 'opac') { open (FILE,"$path/opac-top.inc") || die; } elsif ($type eq 'member') { 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; } elsif ($type eq 'circulation') { open (FILE,"$path/circulation-top.inc") || die; } else { open (FILE,"$path/cat-top.inc") || die; } my @string=; close FILE; # my $count=@string; # $string[$count]="

"; return @string; } sub endmenu { my ($type) = @_; if ( ! defined $type ) { $type=''; } if ($type eq 'issue') { open (FILE,"$path/issues-bottom.inc") || die; } elsif ($type eq 'opac') { open (FILE,"$path/opac-bottom.inc") || die; } elsif ($type eq 'member') { open (FILE,"$path/members-bottom.inc") || die; } elsif ($type eq 'acquisitions') { open (FILE,"$path/acquisitions-bottom.inc") || die; } elsif ($type eq 'report') { open (FILE,"$path/reports-bottom.inc") || die; } elsif ($type eq 'circulation') { open (FILE,"$path/circulation-bottom.inc") || die; } else { open (FILE,"$path/cat-bottom.inc") || die; } my @string=; close FILE; return @string; } sub mktablehdr() { return("\n"); } sub mktablerow { #the last item in data may be a backgroundimage # FIXME # should this be a foreach (1..$cols) loop? my ($cols,$colour,@data)=@_; my $i=0; my $string=""; while ($i <$cols){ if (defined $data[$cols]) { # if there is a background image $string.=""; } else { $string.="$data[$i]"; } $i++; } $string=$string."\n"; return($string); } sub mktableft() { return("
"; } else { # if there's no background image $string.=" "; } if (! defined $data[$i]) {$data[$i]="";} if ($data[$i] eq "") { $string.="
\n"); } sub mkform{ my ($action,%inputs)=@_; my $string="
\n"; $string=$string.mktablehdr(); my $key; my @keys=sort keys %inputs; my $count=@keys; my $i2=0; while ( $i2<$count) { my $value=$inputs{$keys[$i2]}; my @data=split('\t',$value); #my $posn = shift(@data); if ($data[0] eq 'hidden'){ $string=$string."\n"; } else { my $text; if ($data[0] eq 'radio') { $text="$data[1] $data[2]"; } if ($data[0] eq 'text') { $text=""; } if ($data[0] eq 'textarea') { $text="$data[1]"; } if ($data[0] eq 'select') { $text=""; } $string=$string.mktablerow(2,'white',$keys[$i2],$text); #@order[$posn] =mktablerow(2,'white',$keys[$i2],$text); } $i2++; } #$string=$string.join("\n",@order); $string=$string.mktablerow(2,'white','',''); $string=$string.mktableft; $string=$string."
"; } sub mkform3 { my ($action, %inputs) = @_; my $string = "
\n"; $string .= mktablehdr(); my $key; my @keys = sort(keys(%inputs)); my @order; my $count = @keys; my $i2 = 0; while ($i2 < $count) { my $value=$inputs{$keys[$i2]}; my @data=split('\t',$value); my $posn = $data[2]; if ($data[0] eq 'hidden'){ $order[$posn]="\n"; } else { my $text; if ($data[0] eq 'radio') { $text="$data[1] $data[2]"; } if ($data[0] eq 'text') { $text=""; } if ($data[0] eq 'textarea') { $text="$data[1]"; } if ($data[0] eq 'select') { $text=""; } # $string=$string.mktablerow(2,'white',$keys[$i2],$text); $order[$posn]=mktablerow(2,'white',$keys[$i2],$text); } $i2++; } my $temp=join("\n",@order); $string=$string.$temp; $string=$string.mktablerow(1,'white',''); $string=$string.mktableft; $string=$string."
"; } sub mkformnotable{ my ($action,@inputs)=@_; my $string="
\n"; my $count=@inputs; for (my $i=0; $i<$count; $i++){ if ($inputs[$i][0] eq 'hidden'){ $string=$string."\n"; } if ($inputs[$i][0] eq 'radio') { $string.="$inputs[$i][2]"; } if ($inputs[$i][0] eq 'text') { $string.=""; } if ($inputs[$i][0] eq 'textarea') { $string.="$inputs[$i][2]"; } if ($inputs[$i][0] eq 'reset'){ $string.=""; } if ($inputs[$i][0] eq 'submit'){ $string.=""; } } $string=$string."
"; } 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="
\n"; $string=$string.mktablehdr(); my $key; my @order; while ( my ($key, $value) = each %inputs) { my @data=split('\t',$value); my $posn = shift(@data); my $reqd = shift(@data); my $ltext = shift(@data); if ($data[0] eq 'hidden'){ $string=$string."\n"; } else { my $text; if ($data[0] eq 'radio') { $text="$data[1] $data[2]"; } elsif ($data[0] eq 'text') { my $size = $data[1]; if ($size eq "") { $size=40; } $text=""; } elsif ($data[0] eq 'textarea') { my @size=split("x",$data[1]); if ($data[1] eq "") { $size[0] = 40; $size[1] = 4; } $text="$data[2]"; } elsif ($data[0] eq 'select') { $text=""; } if ($reqd eq "R") { $ltext = $ltext." (Req)"; } $order[$posn] =mktablerow(2,'white',$ltext,$text); } } $string=$string.join("\n",@order); $string=$string.mktablerow(2,'white','',''); $string=$string.mktableft; $string=$string."
"; } =pod =head2 &endpage &endpage does not expect any arguments, it returns the string: \n =cut sub endpage() { return("\n"); } =pod =head2 &mklink &mklink expects two arguments, the url to link to and the text of the link. It returns this string: $text where $url is the first argument and $text is the second. =cut sub mklink($$) { my ($url,$text)=@_; my $string="$text"; return ($string); } =pod =head2 &mkheadr &mkeadr expects two strings, a type and the text to use in the header. types are: =over =item 1 ends with
=item 2 no special ending tag =item 3 ends with
=back Other than this, the return value is the same: $text$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; if ($type eq '1'){ $string="$text
"; } if ($type eq '2'){ $string="$text
"; } if ($type eq '3'){ $string="$text
"; } return ($string); } =pod =head2 ¢er and &endcenter ¢er and &endcenter take no arguments and return html tags
and respectivley. =cut sub center() { return ("\n"); } sub endcenter() { return ("\n"); } =pod =head2 &bold &bold requires that a single string be passed in by the caller. &bold will return "$text" where $text is the string passed in. =cut sub bold($) { my ($text)=shift; return("$text"); } #--------------------------------------------- # Create an HTML option list for a