Initial revision
[wip/koha-chris_n.git] / C4 / Format.pm
1 package C4::Format; #asummes C4/Format
2
3 use strict;
4 require Exporter;
5
6
7 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
8   
9 # set the version for version checking
10 $VERSION = 0.01;
11     
12 @ISA = qw(Exporter);
13 @EXPORT = qw(&fmtstr &fmtdec);
14 %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
15                   
16 # your exported package globals go here,
17 # as well as any optionally exported functions
18
19 @EXPORT_OK   = qw($Var1 %Hashit);
20
21
22 # non-exported package globals go here
23 use vars qw(@more $stuff);
24         
25 # initalize package globals, first exported ones
26
27 my $Var1   = '';
28 my %Hashit = ();
29                     
30 # then the others (which are still accessible as $Some::Module::stuff)
31 my $stuff  = '';
32 my @more   = ();
33         
34 # all file-scoped lexicals must be created before
35 # the functions below that use them.
36                 
37 # file-private lexicals go here
38 my $priv_var    = '';
39 my %secret_hash = ();
40                             
41 # here's a file-private function as a closure,
42 # callable as &$priv_func;  it cannot be prototyped.
43 my $priv_func = sub {
44   # stuff goes here.
45 };
46                                                     
47 # make all your functions, whether exported or not;
48
49 sub fmtstr {
50   # format (space pad) a string
51   # $fmt is Ln.. or Rn.. where n is the length
52   my ($env,$strg,$fmt)=@_;
53   my $align = substr($fmt,0,1);
54   my $lenst = substr($fmt,1,length($fmt)-1);
55   if ($align eq"R" ) {
56      $strg = substr((" "x$lenst).$strg,0-$lenst,$lenst);
57   } elsif  ($align eq "C" ) {
58      $strg = 
59        substr((" "x(($lenst/2)-(length($strg)/2))).$strg.(" "x$lenst),0,$lenst);
60   } else {
61      $strg = substr($strg.(" "x$lenst),0,$lenst);
62   } 
63   return ($strg);
64 }
65
66 sub fmtdec {
67   # format a decimal
68   # $fmt is [$][,]n[m]
69   my ($env,$numb,$fmt)=@_;
70   my $curr = substr($fmt,0,1);
71   if ($curr eq "\$") {
72     $fmt = substr($fmt,1,length($fmt)-1);
73   };
74   my $comma = substr($fmt,0,1);
75   if ($comma eq ",") {
76     $fmt = substr($fmt,1,length($fmt)-1);
77   };
78   my $right;
79   my $left = substr($fmt,0,1);
80   if (length($fmt) == 1) {
81     $right = 0;
82   } else {
83     $right = substr($fmt,1,1);
84   }
85   my $fnumb = "";
86   my $tempint = "";
87   my $tempdec = "";
88   if (index($numb,".") == 0 ){
89      $tempint = 0;
90      $tempdec = substr($numb,1,length($numb)-1); 
91   } else {
92      if (index($numb,".") > 0) {
93        my $decpl = index($numb,".");
94        $tempint = substr($numb,0,$decpl);
95        $tempdec = substr($numb,$decpl+1,length($numb)-1-$decpl);
96      } else {
97        $tempint = $numb;
98        $tempdec = 0;
99      }
100      if ($comma eq ",") {
101         while (length($tempdec) > 3) {
102            $fnumb = ",".substr($tempint,-3,3).$fnumb;
103            substr($tempint,-3,3) = "";
104         }
105         $fnumb = substr($tempint,-3,3).$fnumb;
106      } else { 
107         $fnumb = $tempint; 
108      } 
109   }
110   if ($curr eq "\$") {
111      $fnumb = fmtstr($env,$curr.$fnumb,"R".$left+1);
112   } else {
113      if ($left==0) {
114         $fnumb = "";
115      } else {
116         $fnumb = fmtstr($env,$fnumb,"R".$left);
117      }
118   }   
119   if ($right > 0) {
120      $tempdec = $tempdec.("0"x$right);
121      $tempdec = substr($tempdec,0,$right);
122      $fnumb = $fnumb.".".$tempdec;
123   }
124   return ($fnumb);
125 }
126
127 END { }       # module clean-up code here (global destructor)