FS/FS/UI/bytecount.pm

   1 package FS::UI::bytecount;
   2
   3 use strict;
   4 use vars qw($DEBUG $me @ISA @EXPORT_OK);
   5 use Exporter;
   6 use FS::Conf;
   7 use Number::Format 1.50;
   8
   9 @ISA = qw( Exporter );
  10
  11 @EXPORT_OK = qw( bytecount_unexact parse_bytecount display_bytecount );
  12
  13 $DEBUG = 0;
  14 $me = '[FS::UID::bytecount]';
  15
  16 =head1 NAME
  17
  18 FS::UI::bytecount - Subroutines for parsing and displaying byte counters
  19
  20 =head1 SYNOPSIS
  21
  22   use FS::UI::bytecount;
  23
  24 =head1 SUBROUTINES
  25
  26 =over 4
  27
  28 =item bytecount_unexact COUNT
  29
  30 Returns a two decimal place value for COUNT followed by bytes, Kbytes, Mbytes,
  31 or GBytes as appropriate.
  32
  33 =cut
  34
  35 sub bytecount_unexact {
  36   my $bc = shift;
  37   return("$bc bytes")
  38     if ($bc < 1000);
  39   return(sprintf("%.2f Kbytes", $bc/1024))
  40     if ($bc < 1048576);
  41   return(sprintf("%.2f Mbytes", $bc/1048576))
  42     if ($bc < 1073741824);
  43   return(sprintf("%.2f Gbytes", $bc/1073741824));
  44 }
  45
  46 =item parse_bytecount AMOUNT
  47
  48 Accepts a number (digits and a decimal point) possibly followed by k, m, g, or
  49 t (and an optional 'b') in either case.  Returns a pure number representing
  50 the input or the input itself if unparsable.  Discards commas as noise.
  51
  52 =cut
  53
  54 sub parse_bytecount {
  55   my $bc = shift;
  56   return $bc if (($bc =~ tr/.//) > 1);
  57   $bc =~ /^\s*([,\d.]*)\s*([kKmMgGtT]?)[bB]?\s*$/ or return $bc;
  58   my $base = $1;
  59   $base =~ tr/,//d;
  60   return $bc unless length $base;
  61   my $exponent = index ' kmgt', lc($2);
  62   return $bc if ($exponent < 0 && $2);
  63   $exponent = 0 if ($exponent < 0);
  64   return int($base * 1024 ** $exponent);  #bytecounts are integer values
  65 }
  66
  67 =item display_bytecount AMOUNT
  68
  69 Converts a pure number to a value followed possibly followed by k, m, g, or
  70 t via Number::Format
  71
  72 =cut
  73
  74 sub display_bytecount {
  75   my $bc = shift;
  76   return $bc unless ($bc =~ /^(\d+)$/);
  77   my $conf = new FS::Conf;
  78   my $f = new Number::Format;
  79   my $precision = ( $conf->exists('datavolume-significantdigits') &&
  80                     $conf->config('datavolume-significantdigits') =~ /^\s*\d+\s*$/ )
  81                 ? $conf->config('datavolume-significantdigits')
  82                 : 3;
  83   my $unit = $conf->exists('datavolume-forcemegabytes') ? 'M' : 'A';
  84
  85   return $f->format_bytes($bc, precision => $precision, unit => $unit);
  86 }
  87
  88 =back
  89
  90 =head1 BUGS
  91
  92 Fly
  93
  94 =head1 SEE ALSO
  95
  96 L<Number::Format>
  97
  98 =cut
  99
 100 1;
 101