C4/Format.pm

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