gitea
/
Koha-clms
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

commiting POD patches from Andrew Arenburger

This commit is contained in:
pate 2002-09-20 12:51:51 +00:00
parent 464871dabb
commit 91a5af2ce0
4 changed files with 1267 additions and 97 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
C4/Database.pm
View File

@ -1,4 +1,4 @@
package C4::Database; #asummes C4/Database
package C4::Database; #assumes C4/Database
#requires DBI.pm to be installed
@ -68,12 +68,28 @@ sub C4Connect {
return $dbh;
} # sub C4Connect
=item requireDBI
&requireDBI($dbh, $functionnname);
Verifies that C<$dbh> is a valid DBI::db database handle (presumably
to the Koha database). If it isn't, the function dies.
C<$functionname> is the name of the calling function, which will be
used in error messages.
=cut
#'
#------------------
# Helper subroutine to make sure database handle was passed properly
sub requireDBI {
my (
$dbh,
$subrname, # name of calling subroutine
# FIXME - Ought to get this with 'caller',
# instead of requiring developers to always
# get it right. Plus, it'd give the line
# number.
)=@_;
unless ( ref($dbh) =~ /DBI::db/ ) {
@ -85,3 +101,13 @@ sub requireDBI {
END { }
1;
__END__
=back
=head1 SEE ALSO
L<DBI(3)|DBI>
=cut

93
C4/Koha.pm
View File

@ -26,6 +26,30 @@ use vars qw($VERSION @ISA @EXPORT);
$VERSION = 0.01;
=head1 NAME
C4::Koha - Perl Module containing convenience functions for Koha scripts
=head1 SYNOPSIS
use C4::Koha;
$date = slashifyDate("01-01-2002")
$ethnicity = fixEthnicity('asian');
($categories, $labels) = borrowercategories();
($categories, $labels) = ethnicitycategories();
=head1 DESCRIPTION
Koha.pm provides many functions for Koha scripts.
=head1 FUNCTIONS
=over 2
=cut
@ISA = qw(Exporter);
@EXPORT = qw(&slashifyDate
&fixEthnicity
@ -37,6 +61,15 @@ use vars qw();
my $DEBUG = 0;
=item slashifyDate
$slash_date = &slashifyDate($dash_date);
Takes a string of the form "DD-MM-YYYY" (or anything separated by
dashes), converts it to the form "YYYY/MM/DD", and returns the result.
=cut
sub slashifyDate {
# accepts a date of the form xx-xx-xx[xx] and returns it in the
# form xx/xx/xx[xx]
@ -44,6 +77,17 @@ sub slashifyDate {
return("$dateOut[2]/$dateOut[1]/$dateOut[0]")
}
=item fixEthnicity
$ethn_name = &fixEthnicity($ethn_code);
Takes an ethnicity code (e.g., "european" or "pi") and returns the
corresponding descriptive name from the C<ethnicity> table in the
Koha database ("European" or "Pacific Islander").
=cut
#'
sub fixEthnicity($) {
my $ethnicity = shift;
@ -56,6 +100,18 @@ sub fixEthnicity($) {
return $data->{'name'};
}
=item borrowercategories
($codes_arrayref, $labels_hashref) = &borrowercategories();
Looks up the different types of borrowers in the database. Returns two
elements: a reference-to-array, which lists the borrower category
codes, and a reference-to-hash, which maps the borrower category codes
to category descriptions.
=cut
#'
sub borrowercategories {
my $dbh=C4Connect();
my $sth=$dbh->prepare("Select categorycode,description from categories order by description");
@ -71,6 +127,18 @@ sub borrowercategories {
return(\@codes,\%labels);
}
=item ethnicitycategories
($codes_arrayref, $labels_hashref) = &ethnicitycategories();
Looks up the different ethnic types in the database. Returns two
elements: a reference-to-array, which lists the ethnicity codes, and a
reference-to-hash, which maps the ethnicity codes to ethnicity
descriptions.
=cut
#'
sub ethnicitycategories {
my $dbh=C4Connect();
my $sth=$dbh->prepare("Select code,name from ethnicity order by name");
@ -89,25 +157,7 @@ sub ethnicitycategories {
1;
__END__
=head1 NAME
Koha - Perl Module containing convenience functions for Koha scripts
=head1 SYNOPSIS
use Koha;
$date = slashifyDate("01-01-2002")
$ethnicity=fixEthnicity('asian');
($categories,$labels)=borrowercategories();
=head1 DESCRIPTION
Koha.pm provides many functions for Koha scripts.
slashifyDate() takes a dash separated date string and returns a slash
separated date string
=back
=head1 AUTHOR
@ -118,8 +168,3 @@ Pat Eyler, pate@gnu.org
perl(1).
=cut

379
C4/Output.pm
View File

@ -36,6 +36,28 @@ use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking
$VERSION = 0.01;
=head1 NAME
C4::Output - Functions for generating HTML for the Koha web interface
=head1 SYNOPSIS
use C4::Output;
$str = &mklink("http://www.koha.org/", "Koha web page");
print $str;
=head1 DESCRIPTION
The functions in this module generate HTML, and return the result as a
printable string.
=head1 FUNCTIONS
=over 2
=cut
@ISA = qw(Exporter);
@EXPORT = qw(&startpage &endpage
&mktablehdr &mktableft &mktablerow &mklink
@ -51,19 +73,21 @@ $VERSION = 0.01;
# your exported package globals go here,
# as well as any optionally exported functions
@EXPORT_OK = qw($Var1 %Hashit);
@EXPORT_OK = qw($Var1 %Hashit); # FIXME - These are never used
# non-exported package globals go here
use vars qw(@more $stuff);
use vars qw(@more $stuff); # FIXME - These are never used
# initalize package globals, first exported ones
# FIXME - These are never used
my $Var1 = '';
my %Hashit = ();
# then the others (which are still accessible as $Some::Module::stuff)
# FIXME - These are never used
my $stuff = '';
my @more = ();
@ -101,10 +125,31 @@ sub gettemplate {
return $template;
}
=item picktemplate
$template = &picktemplate($includes, $base);
Returns the preferred template for a given page. C<$base> is the
basename of the script that will generate the page (with the C<.pl>
extension stripped off), and C<$includes> is the directory in which
HTML include files are located.
The preferred template is given by the C<template> entry in the
C<systempreferences> table in the Koha database. If
C<$includes>F</templates/preferred-template/>C<$base.tmpl> exists,
C<&picktemplate> returns the preferred template; otherwise, it returns
the string C<default>.
=cut
#'
sub picktemplate {
my ($includes, $base) = @_;
my $dbh=C4Connect;
my $templates;
# FIXME - Instead of generating the list of possible templates, and
# then querying the database to see if, by chance, one of them has
# been selected, wouldn't it be better to query the database first,
# and then see whether the selected template file exists?
opendir (D, "$includes/templates");
my @dirlist=readdir D;
foreach (@dirlist) {
@ -179,10 +224,25 @@ sub gotopage($) {
return $string;
}
=item startmenu
@lines = &startmenu($type);
print join("", @lines);
Given a page type, or category, returns a set of lines of HTML which,
when concatenated, generate the menu at the top of the web page.
C<$type> may be one of C<issue>, C<opac>, C<member>, C<acquisitions>,
C<report>, C<circulation>, or something else, in which case the menu
will be for the catalog pages.
=cut
#'
sub startmenu($) {
# edit the paths in here
my ($type)=shift;
# FIXME - It's bad form to die in a CGI script. It's even worse form
# to die without issuing an error message.
if ($type eq 'issue') {
open (FILE,"$path/issues-top.inc") || die;
} elsif ($type eq 'opac') {
@ -228,11 +288,43 @@ sub endmenu {
return @string;
}
=item mktablehdr
$str = &mktablehdr();
print $str;
Returns a string of HTML, which generates the beginning of a table
declaration.
=cut
#'
sub mktablehdr() {
return("<table border=0 cellspacing=0 cellpadding=5>\n");
}
=item mktablerow
$str = &mktablerow($columns, $color, @column_data, $bgimage);
print $str;
Returns a string of HTML, which generates a row of data inside a table
(see also C<&mktablehdr>, C<&mktableft>).
C<$columns> specifies the number of columns in this row of data.
C<$color> specifies the background color for the row, e.g., C<"white">
or C<"#ffacac">.
C<@column_data> is an array of C<$columns> elements, each one a string
of HTML. These are the contents of the row.
The optional C<$bgimage> argument specifies the pathname to an image
to use as the background for each cell in the row. This pathname will
used as is in the output, so it should be relative to the HTTP
document root.
=cut
#'
sub mktablerow {
#the last item in data may be a backgroundimage
@ -259,10 +351,21 @@ sub mktablerow {
return($string);
}
=item mktableft
$str = &mktableft();
print $str;
Returns a string of HTML, which generates the end of a table
declaration.
=cut
#'
sub mktableft() {
return("</table>\n");
}
# XXX - POD
sub mkform{
my ($action,%inputs)=@_;
my $string="<form action=$action method=post>\n";
@ -311,18 +414,103 @@ sub mkform{
$string=$string."</form>";
}
=item mkform3
$str = &mkform3($action,
$fieldname => "$fieldtype\t$fieldvalue\t$fieldpos",
...
);
print $str;
Takes a set of arguments that define an input form, generates an HTML
string for the form, and returns the string.
C<$action> is the action for the form, usually the URL of the script
that will process it.
The remaining arguments define the fields in the form. C<$fieldname>
is the field's name. This is for the script's benefit, and will not be
shown to the user.
C<$fieldpos> is an integer; fields will be output in order of
increasing C<$fieldpos>. This number must be unique: if two fields
have the same C<$fieldpos>, one will be picked at random, and the
other will be ignored. See below for special considerations, however.
C<$fieldtype> specifies the type of the input field. It may be one of
the following:
=over 4
=item C<hidden>
Generates a hidden field, used to pass data to the script without
showing it to the user. C<$fieldvalue> is the value.
=item C<radio>
Generates a pair of radio buttons, with values C<$fieldvalue> and
C<$fieldpos>. In both cases, C<$fieldvalue> and C<$fieldpos> will be
shown to the user.
=item C<text>
Generates a one-line text input field. It initially contains
C<$fieldvalue>.
=item C<textarea>
Generates a four-line text input area. The initial text (which, of
course, may not contain any tabs) is C<$fieldvalue>.
=item C<select>
Generates a list of items, from which the user may choose one. This is
somewhat different from other input field types, and should be
specified as:
"myselectfield" => "select\t<label0>\t<text0>\t<label1>\t<text1>...",
where the C<text>N strings are the choices that will be presented to
the user, and C<label>N are the labels that will be passed to the
script.
However, C<text0> should be an integer, since it will be used to
determine the order in which this field appears in the form. If any of
the C<label>Ns are empty, the rest of the list will be ignored.
=back
=cut
#'
sub mkform3 {
my ($action, %inputs) = @_;
my $string = "<form action=\"$action\" method=\"post\">\n";
$string .= mktablehdr();
my $key;
my @keys = sort(keys(%inputs));
my @keys = sort(keys(%inputs)); # FIXME - Why do these need to be
# sorted?
my @order;
# FIXME - Use
# while (my ($key, $value) = each %inputs)
# Then $count and $i2 can go away.
my $count = @keys;
my $i2 = 0;
while ($i2 < $count) {
my $value=$inputs{$keys[$i2]};
# FIXME - Why use a tab-separated string? Why not just use an
# anonymous array?
my @data=split('\t',$value);
# FIXME - $data[2] is used in two contradictory ways: first,
# it is always used as the order in which this field should be
# output. Secondly, for radio and select fields, it contains
# data used to define the input field. Thus, for instance, you
# can't have
# fuzzy => "radio\ttrue\tfalse",
# color => "radio\tblue\tred",
# because both "false" and "red" have numeric value 0, and will
# wind up as the first element of the output.
# The obvious way to fix this is to change %inputs into an
# array; then just read (name, definition) pairs, and output
# them in the order in which they were specified.
my $posn = $data[2];
if ($data[0] eq 'hidden'){
$order[$posn]="<input type=hidden name=$keys[$i2] value=\"$data[1]\">\n";
@ -331,10 +519,12 @@ sub mkform3 {
if ($data[0] eq 'radio') {
$text="<input type=radio name=$keys[$i2] value=$data[1]>$data[1]
<input type=radio name=$keys[$i2] value=$data[2]>$data[2]";
}
}
# FIXME - Is 40 the right size in all cases?
if ($data[0] eq 'text') {
$text="<input type=$data[0] name=$keys[$i2] value=\"$data[1]\" size=40>";
}
# FIXME - Is 40x4 the right size in all cases?
if ($data[0] eq 'textarea') {
$text="<textarea name=$keys[$i2] cols=40 rows=4>$data[1]</textarea>";
}
@ -344,7 +534,7 @@ sub mkform3 {
while ($data[$i] ne "") {
my $val = $data[$i+1];
$text = $text."<option value=$data[$i]>$val";
$i = $i+2;
$i = $i+2; # FIXME - Use $i += 2.
}
$text=$text."</select>";
}
@ -354,12 +544,15 @@ sub mkform3 {
$i2++;
}
my $temp=join("\n",@order);
# FIXME - Use ".=". That's what it's for.
$string=$string.$temp;
$string=$string.mktablerow(1,'white','<input type=submit>');
$string=$string.mktableft;
$string=$string."</form>";
# FIXME - A return statement, while not strictly necessary, would be nice.
}
# XXX - POD
sub mkformnotable{
my ($action,@inputs)=@_;
my $string="<form action=$action method=post>\n";
@ -382,6 +575,79 @@ sub mkformnotable{
$string=$string."</form>";
}
=item mkform2
$str = &mkform2($action,
$fieldname => "$fieldpos\t$required\t$label\t$fieldtype\t$value0\t$value1\t...",
...
);
print $str;
Takes a set of arguments that define an input form, generates an HTML
string for the form, and returns the string.
C<$action> is the action for the form, usually the URL of the script
that will process it.
The remaining arguments define the fields in the form. C<$fieldname>
is the field's name. This is for the script's benefit, and will not be
shown to the user.
C<$fieldpos> is an integer; fields will be output in order of
increasing C<$fieldpos>. This number must be unique: if two fields
have the same C<$fieldpos>, one will be picked at random, and the
other will be ignored. See below for special considerations, however.
If C<$required> is the string C<R>, then the field is required, and
the label will have C< (Req.)> appended.
C<$label> is a string that will appear next to the input field.
C<$fieldtype> specifies the type of the input field. It may be one of
the following:
=over 4
=item C<hidden>
Generates a hidden field, used to pass data to the script without
showing it to the user. C<$value0> is its value.
=item C<radio>
Generates a pair of radio buttons, with values C<$value0> and
C<$value1>. In both cases, C<$value0> and C<$value1> will be shown to
the user, next to the radio button.
=item C<text>
Generates a one-line text input field. Its size may be specified by
C<$value0>. The default is 40. The initial text of the field may be
specified by C<$value1>.
=item C<textarea>
Generates a text input area. C<$value0> may be a string of the form
"WWWxHHH", in which case the text input area will be WWW columns wide
and HHH rows tall. The size defaults to 40x4.
The initial text (which, of course, may not contain any tabs) may be
specified by C<$value1>.
=item C<select>
Generates a list of items, from which the user may choose one. Here,
C<$value1>, C<$value2>, etc. are a list of key-value pairs. In each
pair, the key specifies an internal label for a choice, and the value
specifies the description of the choice that will be shown the user.
If C<$value0> is the same as one of the keys that follows, then the
corresponding choice will initially be selected.
=back
=cut
#'
sub mkform2{
# FIXME
# no POD and no tests yet. Once tests are written,
@ -447,60 +713,49 @@ sub mkform2{
$string=$string."</form>";
}
=pod
=item endpage
=head2 &endpage
$str = &endpage();
print $str;
&endpage does not expect any arguments, it returns the string:
</body></html>\n
Returns a string of HTML, the end of an HTML document.
=cut
#'
sub endpage() {
return("</body></html>\n");
}
=pod
=item mklink
=head2 &mklink
$str = &mklink($url, $text);
print $str;
&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.
Returns an HTML string, where C<$text> is a link to C<$url>.
=cut
#'
sub mklink($$) {
my ($url,$text)=@_;
my $string="<a href=\"$url\">$text</a>";
return ($string);
}
=pod
=item mkheadr
=head2 &mkheadr
$str = &mkheadr($type, $text);
print $str;
&mkeadr expects two strings, a type and the text to use in the header.
types are:
Takes a header type and header text, and returns a string of HTML,
where C<$text> is rendered with emphasis in a large font size (not an
actual HTML header).
=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.
C<$type> may be 1, 2, or 3. A type 1 "header" ends with a line break;
Type 2 has no special tag at the end; Type 3 ends with a paragraph
break.
=cut
#'
sub mkheadr {
# FIXME
# would it be better to make this more generic by accepting an optional
@ -512,7 +767,7 @@ sub mkheadr {
$string="<FONT SIZE=6><em>$text</em></FONT><br>";
}
if ($type eq '2'){
$string="<FONT SIZE=6><em>$text</em></FONT><br>";
$string="<FONT SIZE=6><em>$text</em></FONT>";
}
if ($type eq '3'){
$string="<FONT SIZE=6><em>$text</em></FONT><p>";
@ -520,15 +775,15 @@ sub mkheadr {
return ($string);
}
=pod
=item center and endcenter
=head2 &center and &endcenter
print &center(), "This is a line of centered text.", &endcenter();
&center and &endcenter take no arguments and return html tags <CENTER> and
</CENTER> respectivley.
C<&center> and C<&endcenter> take no arguments and return HTML tags
<CENTER> and </CENTER> respectivley.
=cut
#'
sub center() {
return ("<CENTER>\n");
}
@ -537,23 +792,53 @@ sub endcenter() {
return ("</CENTER>\n");
}
=pod
=item bold
=head2 &bold
$str = &bold($text);
print $str;
&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.
Returns a string of HTML that renders C<$text> in bold.
=cut
#'
sub bold($) {
my ($text)=shift;
return("<b>$text</b>");
}
=item getkeytableselectoptions
$str = &getkeytableselectoptions($dbh, $tablename,
$keyfieldname, $descfieldname,
$showkey, $default);
print $str;
Builds an HTML selection box from a database table. Returns a string
of HTML that implements this.
C<$dbh> is a DBI::db database handle.
C<$tablename> is the database table in which to look up the possible
values for the selection box.
C<$keyfieldname> is field in C<$tablename>. It will be used as the
internal label for the selection.
C<$descfieldname> is a field in C<$tablename>. It will be used as the
option shown to the user.
If C<$showkey> is true, then both the key and value will be shown to
the user.
If the C<$default> argument is given, then if a value (from
C<$keyfieldname>) matches C<$default>, it will be selected by default.
=cut
#'
#---------------------------------------------
# Create an HTML option list for a <SELECT> form tag by using
# values from a DB file
# XXX - POD
sub getkeytableselectoptions {
use strict;
# inputs

864
C4/Search.pm
View File

File diff suppressed because it is too large Load Diff