C4/Format.pm

   1 package C4::Format; #assumes C4/Format
   2
   3 use strict;
   4 require Exporter;
   5
   6
   7 use vars qw($VERSION @ISA @EXPORT);
   8
   9 # set the version for version checking
  10 $VERSION = 0.01;
  11
  12 @ISA = qw(Exporter);
  13 @EXPORT = qw(&fmtstr &fmtdec);
  14
  15 sub fmtstr {
  16   # format (space pad) a string
  17   # $fmt is Ln.. or Rn.. where n is the length
  18   my ($env,$strg,$fmt)=@_;
  19   my $align = substr($fmt,0,1);
  20   my $lenst = substr($fmt,1,length($fmt)-1);
  21   if ($align eq"R" ) {
  22      $strg = substr((" "x$lenst).$strg,0-$lenst,$lenst);
  23   } elsif  ($align eq "C" ) {
  24      $strg =
  25        substr((" "x(($lenst/2)-(length($strg)/2))).$strg.(" "x$lenst),0,$lenst);
  26   } else {
  27      $strg = substr($strg.(" "x$lenst),0,$lenst);
  28   }
  29   return ($strg);
  30 }
  31
  32 sub fmtdec {
  33   # format a decimal
  34   # $fmt is [$][,]n[m]
  35   my ($env,$numb,$fmt)=@_;
  36   my $curr = substr($fmt,0,1);
  37   if ($curr eq "\$") {
  38     $fmt = substr($fmt,1,length($fmt)-1);
  39   };
  40   my $comma = substr($fmt,0,1);
  41   if ($comma eq ",") {
  42     $fmt = substr($fmt,1,length($fmt)-1);
  43   };
  44   my $right;
  45   my $left = substr($fmt,0,1);
  46   if (length($fmt) == 1) {
  47     $right = 0;
  48   } else {
  49     $right = substr($fmt,1,1);
  50   }
  51   my $fnumb = "";
  52   my $tempint = "";
  53   my $tempdec = "";
  54   if (index($numb,".") == 0 ){
  55      $tempint = 0;
  56      $tempdec = substr($numb,1,length($numb)-1);
  57   } else {
  58      if (index($numb,".") > 0) {
  59        my $decpl = index($numb,".");
  60        $tempint = substr($numb,0,$decpl);
  61        $tempdec = substr($numb,$decpl+1,length($numb)-1-$decpl);
  62      } else {
  63        $tempint = $numb;
  64        $tempdec = 0;
  65      }
  66      if ($comma eq ",") {
  67         while (length($tempdec) > 3) {
  68            $fnumb = ",".substr($tempint,-3,3).$fnumb;
  69            substr($tempint,-3,3) = "";
  70         }
  71         $fnumb = substr($tempint,-3,3).$fnumb;
  72      } else {
  73         $fnumb = $tempint;
  74      }
  75   }
  76   if ($curr eq "\$") {
  77      $fnumb = fmtstr($env,$curr.$fnumb,"R".$left+1);
  78   } else {
  79      if ($left==0) {
  80         $fnumb = "";
  81      } else {
  82         $fnumb = fmtstr($env,$fnumb,"R".$left);
  83      }
  84   }
  85   if ($right > 0) {
  86      $tempdec = $tempdec.("0"x$right);
  87      $tempdec = substr($tempdec,0,$right);
  88      $fnumb = $fnumb.".".$tempdec;
  89   }
  90   return ($fnumb);
  91 }
  92
  93 END { }       # module clean-up code here (global destructor)