From 5087f3d2089a88f76c994e1a69ce84fee5a10f5f Mon Sep 17 00:00:00 2001 From: arensb Date: Mon, 23 Sep 2002 13:53:18 +0000 Subject: [PATCH] Added POD. --- C4/Format.pm | 138 +++++++++++++++++++++++++++++++++++++++++++++++---- C4/Input.pm | 78 ++++++++++++++++++++++++++--- C4/Print.pm | 101 +++++++++++++++++++++++++++++++++---- 3 files changed, 289 insertions(+), 28 deletions(-) diff --git a/C4/Format.pm b/C4/Format.pm index e6857d3019..119c6c595b 100755 --- a/C4/Format.pm +++ b/C4/Format.pm @@ -23,13 +23,56 @@ require Exporter; use vars qw($VERSION @ISA @EXPORT); - + # set the version for version checking $VERSION = 0.01; - + +=head1 NAME + +C4::Format - Functions for pretty-printing strings and numbers + +=head1 SYNOPSIS + + use C4::Format; + +=head1 DESCRIPTION + +These functions return pretty-printed versions of strings and numbers. + +=head1 FUNCTIONS + +=over 2 + +=cut + @ISA = qw(Exporter); @EXPORT = qw(&fmtstr &fmtdec); +=item fmtstr + + $str = &fmtstr($env, $string, $format); + +Returns C<$string>, padded with space to a given length. + +C<$format> is either C or C, where I is a positive integer. +C<$str> will be either left-padded or right-padded, respectively. + +C<&fmtstr> is almost equivalent to + + sprintf("%-n.ns", $string); + +or + + sprintf("%n.ns", $string); + +The only difference is that if I is less than the length of +C<$string>, then C<&fmtstr> will return the last I characters of +C<$string>, whereas C will return the first I characters. + +C<$env> is ignored. + +=cut +#' sub fmtstr { # format (space pad) a string # $fmt is Ln.. or Rn.. where n is the length @@ -39,26 +82,77 @@ sub fmtstr { if ($align eq"R" ) { $strg = substr((" "x$lenst).$strg,0-$lenst,$lenst); } elsif ($align eq "C" ) { - $strg = + $strg = substr((" "x(($lenst/2)-(length($strg)/2))).$strg.(" "x$lenst),0,$lenst); } else { $strg = substr($strg.(" "x$lenst),0,$lenst); - } + } return ($strg); } +=item fmtdec + + $str = &fmtdec($env, $number, $format) + +Returns a pretty-printed version of C<$number>. + +C<$format> specifies how to print the number. It is of the form + + [$][,]n[m] + +where I and I are digits, specifying the number of digits to use +before and after the decimal, respectively. Thus, + + &fmtdec(undef, 123.456, "42") + +will return + + " 123.45" + +If I is smaller than the size of the integer part, only the last +I digits will be returned. If I is greater than the number of +digits after the decimal in C<$number>, the result will be +right-padded with zeros. + +If C<$format> has a leading dollar sign, the number is assumed to be a +monetary amount. C<$str> will have a dollar sign prepended to the +value. + +If C<$format> has a comma after the optional dollar sign, the integer +part will be split into three-digit groups separated by commas. + +=cut +#' +# FIXME - This is all terribly provincial, not at all +# internationalized. I'm pretty sure there's already something out +# there that'll figure out the current locale, look up the local +# currency symbol (and whether it goes on the left or right), figure +# out how numbers are grouped (commas, periods, or what? And how many +# digits per group?), and will print the whole thing prettily. +# But I can't find it just now. Maybe POSIX::setlocale() or +# perllocale(1) might help. +# FIXME - Bug: +# fmtdec(undef, 12345.6, ',82') prints " 345.60" +# fmtdec(undef, 12345.6, '$,82') prints ".60" sub fmtdec { # format a decimal # $fmt is [$][,]n[m] my ($env,$numb,$fmt)=@_; + + # FIXME - Use $fmt =~ /^(\$)?(,)?(\d)(\d)?$/ instead of this mess of + # substr()s. + + # See if there's a leading dollar sign. my $curr = substr($fmt,0,1); if ($curr eq "\$") { $fmt = substr($fmt,1,length($fmt)-1); }; + # See if there's a leading comma my $comma = substr($fmt,0,1); if ($comma eq ",") { $fmt = substr($fmt,1,length($fmt)-1); }; + # See whether one number was given, or two. my $right; my $left = substr($fmt,0,1); if (length($fmt) == 1) { @@ -66,12 +160,17 @@ sub fmtdec { } else { $right = substr($fmt,1,1); } + # See if $numb is a floating-point number. my $fnumb = ""; my $tempint = ""; my $tempdec = ""; + # FIXME - Use + # $numb =~ /(\d+)\.(\d+)/; + # $tempint = $1 + 0; + # $tempdec = $2; if (index($numb,".") == 0 ){ $tempint = 0; - $tempdec = substr($numb,1,length($numb)-1); + $tempdec = substr($numb,1,length($numb)-1); } else { if (index($numb,".") > 0) { my $decpl = index($numb,"."); @@ -81,16 +180,19 @@ sub fmtdec { $tempint = $numb; $tempdec = 0; } + # If a comma was specified, then comma-separate the integer part if ($comma eq ",") { while (length($tempdec) > 3) { $fnumb = ",".substr($tempint,-3,3).$fnumb; substr($tempint,-3,3) = ""; } $fnumb = substr($tempint,-3,3).$fnumb; - } else { - $fnumb = $tempint; - } + } else { + $fnumb = $tempint; + } } + # If a dollar sign was specified, prepend a dollar sign and + # right-justify the number if ($curr eq "\$") { $fnumb = fmtstr($env,$curr.$fnumb,"R".$left+1); } else { @@ -99,13 +201,29 @@ sub fmtdec { } else { $fnumb = fmtstr($env,$fnumb,"R".$left); } - } + } + # Right-pad the decimal part to the given number of digits. if ($right > 0) { $tempdec = $tempdec.("0"x$right); $tempdec = substr($tempdec,0,$right); $fnumb = $fnumb.".".$tempdec; } - return ($fnumb); + return ($fnumb); # FIXME - Shouldn't return a list. } END { } # module clean-up code here (global destructor) + +1; +__END__ + +=back + +=head1 AUTHOR + +Koha Developement team + +=head1 SEE ALSO + +L. + +=cut diff --git a/C4/Input.pm b/C4/Input.pm index ccbc301a61..0d544bff56 100644 --- a/C4/Input.pm +++ b/C4/Input.pm @@ -26,11 +26,31 @@ use vars qw($VERSION @ISA @EXPORT); # set the version for version checking $VERSION = 0.01; +=head1 NAME + +C4::Input - Miscellaneous sanity checks + +=head1 SYNOPSIS + + use C4::Input; + +=head1 DESCRIPTION + +This module provides functions to see whether a given library card +number or ISBN is valid. + +=head1 FUNCTIONS + +=over 2 + +=cut + @ISA = qw(Exporter); @EXPORT = qw( &checkflds &checkdigit &checkvalidisbn ); - + +# FIXME - This is never used. sub checkflds { my ($env,$reqflds,$data) = @_; my $numrflds = @$reqflds; @@ -39,12 +59,24 @@ sub checkflds { while ($i < $numrflds) { if ($data->{@$reqflds[$i]} eq "") { push(@probarr, @$reqflds[$i]); - } + } $i++ } return (\@probarr); } +=item checkdigit + + $valid = &checkdigit($env, $cardnumber); + +Takes a card number, computes its check digit, and compares it to the +checkdigit at the end of C<$cardnumber>. Returns a true value iff +C<$cardnumber> has a valid check digit. + +C<$env> is ignored. + +=cut +#' sub checkdigit { my ($env,$infl) = @_; $infl = uc $infl; @@ -53,17 +85,19 @@ sub checkdigit { my $i = 1; my $valid = 0; # print $infl."
"; + # FIXME - for ($i = 1; $i < 8; $i++) + # or foreach $i (1..7) while ($i <8) { my $temp1 = $weightings[$i-1]; my $temp2 = substr($infl,$i,1); - $sum = $sum + ($temp1*$temp2); + $sum += $temp1 * $temp2; # print "$sum $temp1 $temp2
"; $i++; } my $rem = ($sum%11); if ($rem == 10) { $rem = "X"; - } + } #print $rem."
"; if ($rem eq substr($infl,8,1)) { $valid = 1; @@ -71,11 +105,21 @@ sub checkdigit { return $valid; } # sub checkdigit +=item checkvalidisbn + + $valid = &checkvalidisbn($isbn); + +Returns a true value iff C<$isbn> is a valid ISBN: it must be ten +digits long (counting "X" as a digit), and must have a valid check +digit at the end. + +=cut +#' #-------------------------------------- # Determine if a number is a valid ISBN number, according to length # of 10 digits and valid checksum sub checkvalidisbn { - use strict; + use strict; my ($q)=@_ ; # Input: ISBN number my $isbngood = 0; # Return: true or false @@ -86,20 +130,24 @@ sub checkvalidisbn { if (length($q)==10) { my $checksum=substr($q,9,1); my $isbn=substr($q,0,9); - my $i; + my $i; my $c=0; - for ($i=0; $i<9; $i++) { + for ($i=0; $i<9; $i++) { my $digit=substr($q,$i,1); $c+=$digit*(10-$i); } $c=$c%11; # % is the modulus function ($c==10) && ($c='X'); + # FIXME - $isbngood = $c eq $checksum; if ($c eq $checksum) { $isbngood=1; } else { $isbngood=0; } } else { + # FIXME - Put "return 0 if $length($q) != 10" near the + # top, so we don't have to indent the rest of the function + # as much. $isbngood=0; } # if length good @@ -107,5 +155,19 @@ sub checkvalidisbn { } # sub checkvalidisbn - END { } # module clean-up code here (global destructor) + +1; +__END__ + +=back + +=head1 AUTHOR + +Koha Developement team + +=head1 SEE ALSO + +L. + +=cut diff --git a/C4/Print.pm b/C4/Print.pm index 4ff242cecb..a604bd4b86 100644 --- a/C4/Print.pm +++ b/C4/Print.pm @@ -27,36 +27,91 @@ use vars qw($VERSION @ISA @EXPORT); # set the version for version checking $VERSION = 0.01; +=head1 NAME + +C4::Print - FIXME + +=head1 SYNOPSIS + + use C4::Print; + +=head1 DESCRIPTION + +FIXME + +=head1 FUNCTIONS + +=over 2 + +=cut + @ISA = qw(Exporter); -@EXPORT = qw(&remoteprint &printreserve &printslip); +@EXPORT = qw(&remoteprint &printslip); + +=item remoteprint + + &remoteprint($env, $items, $borrower); + +Prints the list of items in C<$items> to a printer. + +C<$env> is a reference-to-hash. C<$env-E{queue}> specifies the +queue to print to; if it is empty or has the special value C, +C<&remoteprint> will print to the file F. + +C<$borrower> is a reference-to-hash giving information about a patron. +This may be gotten from C<&getpatroninformation>. The patron's name +will be printed in the output. + +C<$items> is a reference-to-list, where each element is a +reference-to-hash describing a borrowed item. C<$items> may be gotten +from C<¤tissues>. +=cut +#' +# FIXME - It'd be nifty if this could generate pretty PostScript. sub remoteprint { my ($env,$items,$borrower)=@_; #open (FILE,">/tmp/olwen"); #print FILE "queue $env->{'queue'}"; #close FILE; #debug_msg($env,"In print"); - my $file=time; + my $file=time; # FIXME - Not used my $queue = $env->{'queue'}; + # FIXME - If 'queue' is undefined or empty, then presumably it should + # mean "use the default queue", whatever the default is. Presumably + # the default depends on the physical location of the machine. + # FIXME - Perhaps "print to file" should be a supported option. Just + # set the queue to "file" (or " file", if real queues aren't allowed + # to have spaces in them). Or perhaps if $queue eq "" and + # $env->{file} ne "", then that should mean "print to $env->{file}". if ($queue eq "" || $queue eq 'nulllp') { open (PRINTER,">/tmp/kohaiss"); - } else { + } else { + # FIXME - This assumes that 'lpr' exists, and works as expected. + # This is a reasonable assumption, but only because every other + # printing package has a wrapper script called 'lpr'. It'd still + # be better to be able to customize this. open(PRINTER, "| lpr -P $queue") or die "Couldn't write to queue:$queue!\n"; - } + } # print $queue; #open (FILE,">/tmp/$file"); my $i=0; - my $brdata = $env->{'brdata'}; + my $brdata = $env->{'brdata'}; # FIXME - Not used + # FIXME - This is HLT-specific. Put this stuff in a customizable + # site-specific file somewhere. print PRINTER "Horowhenua Library Trust\r\n"; # print PRINTER "$brdata->{'branchname'}\r\n"; - print PRINTER "Phone: 368-1953\r\n"; - print PRINTER "Fax: 367-9218\r\n"; + print PRINTER "Phone: 368-1953\r\n"; + print PRINTER "Fax: 367-9218\r\n"; print PRINTER "Email: renewals\@library.org.nz\r\n\r\n\r\n"; print PRINTER "$borrower->{'cardnumber'}\r\n"; print PRINTER "$borrower->{'title'} $borrower->{'initials'} $borrower->{'surname'}\r\n"; + # FIXME - Use for ($i = 0; $items->[$i]; $i++) + # Or better yet, foreach $item (@{$items}) while ($items->[$i]){ # print $i; my $itemdata = $items->[$i]; + # FIXME - This is just begging for a Perl format. print PRINTER "$i $itemdata->{'title'}\r\n"; print PRINTER "$itemdata->{'barcode'}"; print PRINTER " "x15; @@ -66,12 +121,23 @@ sub remoteprint { print PRINTER "\r\n\r\n\r\n\r\n\r\n\r\n\r\n"; if ($env->{'printtype'} eq "docket"){ #print chr(27).chr(105); - } + } close PRINTER; #system("lpr /tmp/$file"); } +=item printslip + + &printslip($env, $text) +Prints the string C<$text> to a printer. C<$env-E{queue}> +specifies the queue to print to. + +If C<$env-E{queue}> is empty or set to C, C<&printslip> +will print to the file F. + +=cut +#' sub printslip { my($env, $slip)=@_; my $printer = $env->{'printer'}; @@ -85,5 +151,20 @@ sub printslip { } END { } # module clean-up code here (global destructor) - - + +1; +__END__ + +=back + +=head1 AUTHOR + +Koha Developement team + +=head1 SEE ALSO + +L. + +L + +=cut -- 2.39.5