C4/Format.pm

   1 package C4::Format;
   2
   3 # $Id$
   4
   5 # Copyright 2000-2002 Katipo Communications
   6 #
   7 # This file is part of Koha.
   8 #
   9 # Koha is free software; you can redistribute it and/or modify it under the
  10 # terms of the GNU General Public License as published by the Free Software
  11 # Foundation; either version 2 of the License, or (at your option) any later
  12 # version.
  13 #
  14 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  15 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  16 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License along with
  19 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  20 # Suite 330, Boston, MA  02111-1307 USA
  21
  22 use strict;
  23 require Exporter;
  24
  25
  26 use vars qw($VERSION @ISA @EXPORT);
  27
  28 # set the version for version checking
  29 $VERSION = 0.01;
  30
  31 =head1 NAME
  32
  33 C4::Format - Functions for pretty-printing strings and numbers
  34
  35 =head1 SYNOPSIS
  36
  37   use C4::Format;
  38
  39 =head1 DESCRIPTION
  40
  41 These functions return pretty-printed versions of strings and numbers.
  42
  43 =head1 FUNCTIONS
  44
  45 =over 2
  46
  47 =cut
  48
  49 @ISA = qw(Exporter);
  50 @EXPORT = qw(&fmtstr &fmtdec);
  51
  52 =item fmtstr
  53
  54   $str = &fmtstr($env, $string, $format);
  55
  56 Returns C<$string>, padded with space to a given length.
  57
  58 C<$format> is either C<Ln> or C<Rn>, where I<n> is a positive integer.
  59 C<$str> will be either left-padded or right-padded, respectively.
  60
  61 C<&fmtstr> is almost equivalent to
  62
  63   sprintf("%-n.ns", $string);
  64
  65 or
  66
  67   sprintf("%n.ns", $string);
  68
  69 The only difference is that if I<n> is less than the length of
  70 C<$string>, then C<&fmtstr> will return the last I<n> characters of
  71 C<$string>, whereas C<sprintf> will return the first I<n> characters.
  72
  73 C<$env> is ignored.
  74
  75 =cut
  76 #'
  77 sub fmtstr {
  78   # format (space pad) a string
  79   # $fmt is Ln.. or Rn.. where n is the length
  80   my ($env,$strg,$fmt)=@_;
  81   my $align = substr($fmt,0,1);
  82   my $lenst = substr($fmt,1,length($fmt)-1);
  83   if ($align eq"R" ) {
  84      $strg = substr((" "x$lenst).$strg,0-$lenst,$lenst);
  85   } elsif  ($align eq "C" ) {
  86      $strg =
  87        substr((" "x(($lenst/2)-(length($strg)/2))).$strg.(" "x$lenst),0,$lenst);
  88   } else {
  89      $strg = substr($strg.(" "x$lenst),0,$lenst);
  90   }
  91   return ($strg);
  92 }
  93
  94 =item fmtdec
  95
  96   $str = &fmtdec($env, $number, $format)
  97
  98 Returns a pretty-printed version of C<$number>.
  99
 100 C<$format> specifies how to print the number. It is of the form
 101
 102   [$][,]n[m]
 103
 104 where I<n> and I<m> are digits, specifying the number of digits to use
 105 before and after the decimal, respectively. Thus,
 106
 107   &fmtdec(undef, 123.456, "42")
 108
 109 will return
 110
 111   " 123.45"
 112
 113 If I<n> is smaller than the size of the integer part, only the last
 114 I<n> digits will be returned. If I<m> is greater than the number of
 115 digits after the decimal in C<$number>, the result will be
 116 right-padded with zeros.
 117
 118 If C<$format> has a leading dollar sign, the number is assumed to be a
 119 monetary amount. C<$str> will have a dollar sign prepended to the
 120 value.
 121
 122 If C<$format> has a comma after the optional dollar sign, the integer
 123 part will be split into three-digit groups separated by commas.
 124
 125 C<$env> is effectively ignored.
 126
 127 =cut
 128 #'
 129 # FIXME - This is all terribly provincial, not at all
 130 # internationalized. I'm pretty sure there's already something out
 131 # there that'll figure out the current locale, look up the local
 132 # currency symbol (and whether it goes on the left or right), figure
 133 # out how numbers are grouped (commas, periods, or what? And how many
 134 # digits per group?), and will print the whole thing prettily.
 135 # But I can't find it just now. Maybe POSIX::setlocale() or
 136 # perllocale(1) might help.
 137 # FIXME - Bug:
 138 #       fmtdec(undef, 12345.6, ',82') prints "     345.60"
 139 #       fmtdec(undef, 12345.6, '$,82') prints ".60"
 140 sub fmtdec {
 141   # format a decimal
 142   # $fmt is [$][,]n[m]
 143   my ($env,$numb,$fmt)=@_;
 144
 145   # FIXME - Use $fmt =~ /^(\$)?(,)?(\d)(\d)?$/ instead of this mess of
 146   # substr()s.
 147
 148   # See if there's a leading dollar sign.
 149   my $curr = substr($fmt,0,1);
 150   if ($curr eq "\$") {
 151     $fmt = substr($fmt,1,length($fmt)-1);
 152   };
 153   # See if there's a leading comma
 154   my $comma = substr($fmt,0,1);
 155   if ($comma eq ",") {
 156     $fmt = substr($fmt,1,length($fmt)-1);
 157   };
 158   # See whether one number was given, or two.
 159   my $right;
 160   my $left = substr($fmt,0,1);
 161   if (length($fmt) == 1) {
 162     $right = 0;
 163   } else {
 164     $right = substr($fmt,1,1);
 165   }
 166   # See if $numb is a floating-point number.
 167   my $fnumb = "";
 168   my $tempint = "";
 169   my $tempdec = "";
 170   # FIXME - Use
 171   #     $numb =~ /(\d+)\.(\d+)/;
 172   #     $tempint = $1 + 0;
 173   #     $tempdec = $2;
 174   if (index($numb,".") == 0 ){
 175      $tempint = 0;
 176      $tempdec = substr($numb,1,length($numb)-1);
 177   } else {
 178      if (index($numb,".") > 0) {
 179        my $decpl = index($numb,".");
 180        $tempint = substr($numb,0,$decpl);
 181        $tempdec = substr($numb,$decpl+1,length($numb)-1-$decpl);
 182      } else {
 183        $tempint = $numb;
 184        $tempdec = 0;
 185      }
 186      # If a comma was specified, then comma-separate the integer part
 187      # FIXME - From the Perl Cookbook (ISBN 1-56592-243-3), sec. 2.1.7:
 188      #  sub commify {
 189      #          my $test = reverse $_[0];
 190      #          $text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
 191      #          return scalar reverse $text;
 192      #  }
 193      if ($comma eq ",") {
 194         while (length($tempdec) > 3) {
 195            $fnumb = ",".substr($tempint,-3,3).$fnumb;
 196            substr($tempint,-3,3) = "";
 197         }
 198         $fnumb = substr($tempint,-3,3).$fnumb;
 199      } else {
 200         $fnumb = $tempint;
 201      }
 202   }
 203   # If a dollar sign was specified, prepend a dollar sign and
 204   # right-justify the number
 205   if ($curr eq "\$") {
 206      $fnumb = fmtstr($env,$curr.$fnumb,"R".$left+1);
 207   } else {
 208      if ($left==0) {
 209         $fnumb = "";
 210      } else {
 211         $fnumb = fmtstr($env,$fnumb,"R".$left);
 212      }
 213   }
 214   # Right-pad the decimal part to the given number of digits.
 215   if ($right > 0) {
 216      $tempdec .= "0"x$right;
 217      $tempdec = substr($tempdec,0,$right);
 218      $fnumb .= ".".$tempdec;
 219   }
 220   return $fnumb;        # FIXME - Shouldn't return a list.
 221 }
 222
 223 1;
 224 __END__
 225
 226 =back
 227
 228 =head1 AUTHOR
 229
 230 Koha Developement team <info@koha.org>
 231
 232 =cut