← Back to branch summary

~ubuntu-branches/ubuntu/utopic/libnumber-bytes-human-perl/utopic

« back to all changes in this revision

Viewing changes to Human.pm

  • Committer: Package Import Robot
  • Author(s): Florian Schlichting, Salvatore Bonaccorso, Florian Schlichting
  • Date: 2013-04-04 22:28:47 UTC
  • mfrom: (1.1.1)
  • Revision ID: package-import@ubuntu.com-20130404222847-gxc4euw7ld0lumz4
Tags: 0.09-1
[ Salvatore Bonaccorso ]
* Change Vcs-Git to canonical URI (git://anonscm.debian.org)
* Change search.cpan.org based URIs to metacpan.org based URIs

[ Florian Schlichting ]
* Import Upstream version 0.09
* Document new functionality in short and long description
* Bump Standards-Version to 3.9.4 (use copyright-format 1.0)
* Bump copyright years
* Email change: Florian Schlichting -> fsfs@debian.org

Show diffs side-by-side

added added

removed removed

Lines of Context:
Human.pm
1
 
 
2
 
package Number::Bytes::Human;
3
 
 
4
 
use strict;
5
 
use warnings;
6
 
 
7
 
our $VERSION = '0.07';
8
 
 
9
 
require Exporter;
10
 
our @ISA = qw(Exporter);
11
 
our @EXPORT_OK = qw(format_bytes);
12
 
 
13
 
require POSIX;
14
 
use Carp qw(croak carp);
15
 
 
16
 
#my $DEFAULT_BLOCK = 1024;
17
 
#my $DEFAULT_ZERO = '0';
18
 
#my $DEFAULT_ROUND_STYLE = 'ceil';
19
 
my %DEFAULT_SUFFIXES = (
20
 
  1024 => ['', 'K', 'M', 'G', 'T', 'P', 'E', 'Z', 'Y'],
21
 
  1000 => ['', 'k', 'M', 'G', 'T', 'P', 'E', 'Z', 'Y'],
22
 
  1024000 => ['', 'M', 'T', 'E', 'Y'],
23
 
  si_1024 => ['B', 'KiB', 'MiB', 'GiB', 'TiB', 'PiB', 'EiB', 'ZiB', 'YiB'],
24
 
  si_1000 => ['B', 'kB', 'MB', 'GB', 'TB', 'PB', 'EB', 'ZB', 'YB'],
25
 
);
26
 
my @DEFAULT_PREFIXES = @{$DEFAULT_SUFFIXES{1024}};
27
 
 
28
 
sub _default_suffixes {
29
 
  my $set = shift || 1024;
30
 
  if (exists $DEFAULT_SUFFIXES{$set}) {
31
 
    return @{$DEFAULT_SUFFIXES{$set}} if wantarray;
32
 
    return [ @{$DEFAULT_SUFFIXES{$set}} ];
33
 
  }
34
 
  croak "unknown suffix set '$set'";
35
 
}
36
 
 
37
 
my %ROUND_FUNCTIONS = (
38
 
  ceil => \&POSIX::ceil,
39
 
  floor => \&POSIX::floor,
40
 
  #round => sub { shift }, # FIXME
41
 
  #trunc => sub { int shift } # FIXME
42
 
 
43
 
  # what about 'ceiling'?
44
 
);
45
 
 
46
 
sub _round_function {
47
 
  my $style = shift;
48
 
  if (exists $ROUND_FUNCTIONS{$style}) {
49
 
    return $ROUND_FUNCTIONS{$style}
50
 
  }
51
 
  croak "unknown round style '$style'";
52
 
}
53
 
 
54
 
# options
55
 
#   block | block_size | base | bs => 1024 | 1000
56
 
#   base_1024 | block_1024 | 1024 => $true
57
 
#   base_1000 | block_1000 | 1000 => $true
58
 
#
59
 
#   round_function => \&
60
 
#   round_style => 'ceiling', 'round', 'floor', 'trunc'
61
 
#
62
 
#   suffixes => 1024 | 1000 | si_1024 | si_1000 | 1024000 | \@
63
 
#   si => 1
64
 
#   unit => string (eg., 'B' | 'bps' | 'b')
65
 
#
66
 
#   zero => '0' (default) | '-' | '0%S' | undef
67
 
#
68
 
#   
69
 
#   supress_point_zero | no_point_zero =>
70
 
#   b_to_i => 1
71
 
#   to_s => \&
72
 
#
73
 
#   allow_minus => 0 | 1
74
 
#   too_large => string
75
 
#   quiet => 1 (supresses "too large number" warning)
76
 
 
77
 
 
78
 
 
79
 
#  PROBABLY CRAP:
80
 
#   precision =>
81
 
 
82
 
# parsed options
83
 
#   BLOCK => 1024 | 1020
84
 
#   ROUND_STYLE => 'ceil', 'round', 'floor', 'trunc'
85
 
#   ROUND_FUNCTION => \&
86
 
#   SUFFIXES => \@
87
 
#   ZERO =>
88
 
 
89
 
 
90
 
=begin private 
91
 
 
92
 
  $options = _parse_args($seed, $args)
93
 
  $options = _parse_args($seed, arg1 => $val1, ...)
94
 
 
95
 
$seed is undef or a hashref
96
 
$args is a hashref
97
 
 
98
 
=end private
99
 
 
100
 
=cut
101
 
 
102
 
sub _parse_args {
103
 
  my $seed = shift;
104
 
  my %args;
105
 
 
106
 
  my %options;
107
 
  unless (defined $seed) { # use defaults
108
 
    $options{BLOCK} = 1024;
109
 
    $options{ROUND_STYLE} = 'ceil';
110
 
    $options{ROUND_FUNCTION} = _round_function($options{ROUND_STYLE});
111
 
    $options{ZERO} = '0';
112
 
    #$options{SUFFIXES} = # deferred to the last minute when we know BLOCK, seek [**]
113
 
  } 
114
 
  # else { %options = %$seed } # this is set if @_!=0, down below
115
 
 
116
 
  if (@_==0) { # quick return for default values (no customized args)
117
 
    return (defined $seed) ? $seed : \%options;
118
 
  } elsif (@_==1 && ref $_[0]) { # \%args
119
 
    %args = %{$_[0]};
120
 
  } else { # arg1 => $val1, arg2 => $val2
121
 
    %args = @_;
122
 
  }
123
 
 
124
 
  # this is done here so this assignment/copy doesn't happen if @_==0
125
 
  %options = %$seed unless %options; 
126
 
 
127
 
# block | block_size | base | bs => 1024 | 1000
128
 
# block_1024 | base_1024 | 1024 => $true
129
 
# block_1000 | base_1000 | 1024 => $true
130
 
  if ($args{block} ||
131
 
      $args{block_size} ||
132
 
      $args{base} ||
133
 
      $args{bs}
134
 
    ) {
135
 
    my $block = $args{block} ||
136
 
                $args{block_size} ||
137
 
                $args{base} ||
138
 
                $args{bs};
139
 
    unless ($block==1000 || $block==1024 || $block==1_024_000) {
140
 
      croak "invalid base: $block (should be 1024, 1000 or 1024000)";
141
 
    }
142
 
    $options{BLOCK} = $block;
143
 
    
144
 
  } elsif ($args{block_1024} ||
145
 
           $args{base_1024}  ||
146
 
           $args{1024}) {
147
 
 
148
 
    $options{BLOCK} = 1024;
149
 
  } elsif ($args{block_1000} ||
150
 
           $args{base_1000}  ||
151
 
           $args{1000}) {
152
 
 
153
 
    $options{BLOCK} = 1000;
154
 
  }
155
 
 
156
 
# round_function => \&
157
 
# round_style => 'ceil' | 'floor' | 'round' | 'trunc'
158
 
  if ($args{round_function}) {
159
 
    unless (ref $args{round_function} eq 'CODE') {
160
 
      croak "round function ($args{round_function}) should be a code ref";
161
 
    }
162
 
    $options{ROUND_FUNCTION} = $args{round_function};
163
 
    $options{ROUND_STYLE} = $args{round_style} || 'unknown';
164
 
  } elsif ($args{round_style}) {
165
 
    $options{ROUND_FUNCTION} = _round_function($args{round_style});
166
 
    $options{ROUND_STYLE} = $args{round_style};
167
 
  }
168
 
 
169
 
# suffixes => 1024 | 1000 | si_1024 | si_1000 | 1024000 | \@
170
 
  if ($args{suffixes}) {
171
 
    if (ref $args{suffixes} eq 'ARRAY') {
172
 
      $options{SUFFIXES} = $args{suffixes};
173
 
    } elsif ($args{suffixes} =~ /^(si_)?(1000|1024)$/) {
174
 
      $options{SUFFIXES} = _default_suffixes($args{suffixes});
175
 
    } else {
176
 
      croak "suffixes ($args{suffixes}) should be 1024, 1000, si_1024, si_1000, 1024000 or an array ref";
177
 
    }
178
 
  } elsif ($args{si}) {
179
 
    my $set = ($options{BLOCK}==1024) ? 'si_1024' : 'si_1000';
180
 
    $options{SUFFIXES} = _default_suffixes($set);
181
 
  } elsif (defined $args{unit}) {
182
 
    my $suff = $args{unit};
183
 
    $options{SUFFIXES} = [ map  { "$_$suff" } @DEFAULT_PREFIXES ];
184
 
  }
185
 
 
186
 
# zero => undef | string
187
 
  if (exists $args{zero}) {
188
 
    $options{ZERO} = $args{zero};
189
 
    if (defined $options{ZERO}) {
190
 
      $options{ZERO} =~ s/%S/$options{SUFFIXES}->[0]/g 
191
 
    }
192
 
  }
193
 
 
194
 
# quiet => 1
195
 
  if ($args{quiet}) {
196
 
    $options{QUIET} = 1;
197
 
  }
198
 
 
199
 
  if (defined $seed) {
200
 
    %$seed = %options;
201
 
    return $seed;
202
 
  }
203
 
  return \%options
204
 
}
205
 
 
206
 
# NOTE. _format_bytes() SHOULD not change $options - NEVER.
207
 
 
208
 
sub _format_bytes {
209
 
  my $bytes = shift;
210
 
  return undef unless defined $bytes;
211
 
  my $options = shift;
212
 
  my %options = %$options;
213
 
 
214
 
  local *human_round = $options{ROUND_FUNCTION};
215
 
 
216
 
  return $options{ZERO} if ($bytes==0 && defined $options{ZERO});
217
 
 
218
 
  my $block = $options{BLOCK};
219
 
 
220
 
  # if a suffix set was not specified, pick a default [**]
221
 
  my @suffixes = $options{SUFFIXES} ? @{$options{SUFFIXES}} : _default_suffixes($block);
222
 
 
223
 
  # WHAT ABOUT NEGATIVE NUMBERS: -1K ?
224
 
  my $sign = '';
225
 
  if ($bytes<0) {
226
 
     $bytes = -$bytes;
227
 
     $sign = '-';
228
 
  }
229
 
  return $sign . human_round($bytes) . $suffixes[0] if $bytes<$block;
230
 
 
231
 
#  return "$sign$bytes" if $bytes<$block;
232
 
 
233
 
  my $x = $bytes;
234
 
  my $suffix;
235
 
  foreach (@suffixes) {
236
 
    $suffix = $_, last if human_round($x) < $block;
237
 
    $x /= $block;
238
 
  }
239
 
  unless (defined $suffix) { # number >= $block*($block**@suffixes) [>= 1E30, that's huge!]
240
 
      unless ($options{QUIET}) {
241
 
        my $pow = @suffixes+1; 
242
 
        carp "number too large (>= $block**$pow)"
243
 
      }
244
 
      $suffix = $suffixes[-1];
245
 
      $x *= $block;
246
 
  }
247
 
  # OPTION: return "Inf"
248
 
 
249
 
  my $num;
250
 
  if ($x < 10.0) {
251
 
    $num = sprintf("%.1f", human_round($x*10)/10); 
252
 
  } else {
253
 
    $num = sprintf("%d", human_round($x));
254
 
  }
255
 
 
256
 
  "$sign$num$suffix"
257
 
 
258
 
}
259
 
 
260
 
# convert byte count (file size) to human readable format
261
 
sub format_bytes {
262
 
  my $bytes = shift;
263
 
  my $options = _parse_args(undef, @_);
264
 
  #use YAML; print Dump $options;
265
 
  return _format_bytes($bytes, $options);
266
 
}
267
 
 
268
 
### the OO way
269
 
 
270
 
# new()
271
 
sub new {
272
 
  my $proto = shift;
273
 
  my $class = ref $proto || $proto;
274
 
  my $opts = _parse_args(undef, @_);
275
 
  return bless $opts, $class;
276
 
}
277
 
 
278
 
# set_options()
279
 
sub set_options {
280
 
  my $self = shift;
281
 
  return $self->_parse_args(@_);
282
 
}
283
 
 
284
 
# format()
285
 
sub format {
286
 
  my $self = shift;
287
 
  my $bytes = shift;
288
 
  return _format_bytes($bytes, $self);
289
 
}
290
 
 
291
 
 
292
 
# the solution by COG in Filesys::DiskUsage 
293
 
# convert size to human readable format
294
 
#sub _convert {
295
 
#  defined (my $size = shift) || return undef;
296
 
#  my $config = {@_};
297
 
#  $config->{human} || return $size;
298
 
#  my $block = $config->{'Human-readable'} ? 1000 : 1024;
299
 
#  my @args = qw/B K M G/;
300
 
#
301
 
#  while (@args && $size > $block) {
302
 
#    shift @args;
303
 
#    $size /= $block;
304
 
#  }
305
 
#
306
 
#  if ($config->{'truncate-readable'} > 0) {
307
 
#    $size = sprintf("%.$config->{'truncate-readable'}f",$size);
308
 
#  }
309
 
#
310
 
#  "$size$args[0]";
311
 
#}
312
 
#
313
 
# not exact: 1024 => 1024B instead of 1K
314
 
# not nicely formatted => 1.00 instead of 1K
315
 
 
316
 
1;
317
 
 
318
 
__END__
319
 
 
320
 
=head1 NAME
321
 
 
322
 
Number::Bytes::Human - Convert byte count to human readable format
323
 
 
324
 
=head1 SYNOPSIS
325
 
 
326
 
  use Number::Bytes::Human qw(format_bytes);
327
 
  $size = format_bytes(0); # '0'
328
 
  $size = format_bytes(2*1024); # '2.0K'
329
 
 
330
 
  $size = format_bytes(1_234_890, bs => 1000); # '1.3M'
331
 
  $size = format_bytes(1E9, bs => 1000); # '1.0G'
332
 
 
333
 
  # the OO way
334
 
  $human = Number::Bytes::Human->new(bs => 1000, si => 1);
335
 
  $size = $human->format(1E7); # '10MB'
336
 
  $human->set_options(zero => '-');
337
 
  $size = $human->format(0); # '-'
338
 
 
339
 
=head1 DESCRIPTION
340
 
 
341
 
THIS IS ALPHA SOFTWARE: THE DOCUMENTATION AND THE CODE WILL SUFFER
342
 
CHANGES SOME DAY (THANKS, GOD!).
343
 
 
344
 
This module provides a formatter which turns byte counts
345
 
to usual readable format, like '2.0K', '3.1G', '100B'.
346
 
It was inspired in the C<-h> option of Unix
347
 
utilities like C<du>, C<df> and C<ls> for "human-readable" output.
348
 
 
349
 
From the FreeBSD man page of C<df>: http://www.freebsd.org/cgi/man.cgi?query=df
350
 
 
351
 
  "Human-readable" output.  Use unit suffixes: Byte, Kilobyte,
352
 
  Megabyte, Gigabyte, Terabyte and Petabyte in order to reduce the
353
 
  number of digits to four or fewer using base 2 for sizes.
354
 
 
355
 
  byte      B
356
 
  kilobyte  K = 2**10 B = 1024 B
357
 
  megabyte  M = 2**20 B = 1024 * 1024 B
358
 
  gigabyte  G = 2**30 B = 1024 * 1024 * 1024 B
359
 
  terabyte  T = 2**40 B = 1024 * 1024 * 1024 * 1024 B
360
 
 
361
 
  petabyte  P = 2**50 B = 1024 * 1024 * 1024 * 1024 * 1024 B
362
 
  exabyte   E = 2**60 B = 1024 * 1024 * 1024 * 1024 * 1024 * 1024 B
363
 
  zettabyte Z = 2**70 B = 1024 * 1024 * 1024 * 1024 * 1024 * 1024 * 1024 B
364
 
  yottabyte Y = 2**80 B = 1024 * 1024 * 1024 * 1024 * 1024 * 1024 * 1024 * 1024 B
365
 
 
366
 
I have found this link to be quite useful:
367
 
 
368
 
  http://www.t1shopper.com/tools/calculate/
369
 
 
370
 
If you feel like a hard-drive manufacturer, you can start
371
 
counting bytes by powers of 1000 (instead of the generous 1024).
372
 
Just use C<< bs => 1000 >>.
373
 
 
374
 
But if you are a floppy disk manufacturer and want to start
375
 
counting in units of 1024000 (for your "1.44 MB" disks)?
376
 
Then use C<< bs => 1_024_000 >>.
377
 
 
378
 
If you feel like a purist academic, you can force the use of
379
 
metric prefixes
380
 
according to the Dec 1998 standard by the IEC. Never mind the units for base 1000
381
 
are C<('B', 'kB', 'MB', 'GB', 'TB', 'PB', 'EB', 'ZB', 'YB')> and,
382
 
even worse, the ones for base 1024 are
383
 
C<('B', 'KiB', 'MiB', 'GiB', 'TiB', 'PiB', 'EiB', 'ZiB', 'YiB')>
384
 
with the horrible names: bytes, kibibytes, mebibytes, etc.
385
 
All you have to do is to use C<< si => 1 >>. Ain't that beautiful
386
 
the SI system? Read about it:
387
 
 
388
 
  http://physics.nist.gov/cuu/Units/binary.html
389
 
 
390
 
You can try a pure Perl C<"ls -lh">-inspired command with the one-liner, er, two-liner:
391
 
 
392
 
  $ perl -MNumber::Bytes::Human=format_bytes \
393
 
         -e 'printf "%5s %s\n", format_bytes(-s), $_ for @ARGV' *
394
 
 
395
 
Why to write such a module? Because if people can write such things
396
 
in C, it can be written much easier in Perl and then reused,
397
 
refactored, abused. And then, when it is much improved, some
398
 
brave soul can port it back to C (if only for the warm feeling
399
 
of painful programming).
400
 
 
401
 
=head2 OBJECTS
402
 
 
403
 
An alternative to the functional style of this module
404
 
is the OO fashion. This is useful for avoiding the 
405
 
unnecessary parsing of the arguments over and over
406
 
if you have to format lots of numbers 
407
 
 
408
 
 
409
 
  for (@sizes) {
410
 
    my $fmt_size = format_bytes($_, @args);
411
 
    ...
412
 
  }
413
 
 
414
 
versus
415
 
 
416
 
  my $human = Number::Format::Bytes->new(@args);
417
 
  for (@sizes) {
418
 
    my $fmt_size = $human->format($_);
419
 
    ...
420
 
  }
421
 
 
422
 
for TODO
423
 
[TODO] MAKE IT JUST A MATTER OF STYLE: memoize _parse_args()
424
 
$seed == undef
425
 
 
426
 
=head2 FUNCTIONS
427
 
 
428
 
=over 4
429
 
 
430
 
=item B<format_bytes>
431
 
 
432
 
  $h_size = format_bytes($size, @options);
433
 
 
434
 
Turns a byte count (like 1230) to a readable format like '1.3K'.
435
 
You have a bunch of options to play with. See the section
436
 
L</"OPTIONS"> to know the details.
437
 
 
438
 
=back
439
 
 
440
 
=head2 METHODS
441
 
 
442
 
=over 4
443
 
 
444
 
=item B<new>
445
 
 
446
 
  $h = Number::Bytes::Human->new(@options);
447
 
 
448
 
The constructor. For details on the arguments, see the section
449
 
L</"OPTIONS">.
450
 
 
451
 
=item B<format>
452
 
 
453
 
  $h_size = $h->format($size);
454
 
 
455
 
Turns a byte count (like 1230) to a readable format like '1.3K'.
456
 
The statements 
457
 
 
458
 
  $h = Number::Bytes::Human->new(@options);
459
 
  $h_size = $h->format($size);
460
 
 
461
 
are equivalent to C<$h_size = format_bytes($size, @options)>,
462
 
with only one pass for the option arguments.
463
 
 
464
 
=item B<set_options>
465
 
 
466
 
  $h->set_options(@options);
467
 
 
468
 
To alter the options of a C<Number::Bytes::Human> object.
469
 
See L</"OPTIONS">.
470
 
 
471
 
=back
472
 
 
473
 
=head2 OPTIONS
474
 
 
475
 
=over 4 
476
 
 
477
 
=item BASE
478
 
 
479
 
  block | base | block_size | bs => 1000 | 1024 | 1024000
480
 
  base_1024 | block_1024 | 1024 => 1
481
 
  base_1000 | block_1000 | 1000 => 1
482
 
 
483
 
The base to be used: 1024 (default), 1000 or 1024000.
484
 
 
485
 
Any other value throws an exception.
486
 
 
487
 
=item SUFFIXES
488
 
 
489
 
  suffixes => 1000 | 1024 | 1024000 | si_1000 | si_1024 | $arrayref 
490
 
 
491
 
By default, the used suffixes stand for '', 'K', 'M', ... 
492
 
for base 1024 and '', 'k', 'M', ... for base 1000
493
 
(which are indeed the usual metric prefixes with implied unit
494
 
as bytes, 'B'). For the weird 1024000 base, suffixes are
495
 
'', 'M', 'T', etc.
496
 
 
497
 
=item ZERO
498
 
 
499
 
  zero => string | undef
500
 
 
501
 
The string C<0> maps to ('0' by default). If C<undef>, the general case is used.
502
 
The string may contain '%S' in which case the suffix for byte is used.
503
 
 
504
 
  format_bytes(0, zero => '-') => '-'
505
 
 
506
 
=item METRIC SYSTEM
507
 
 
508
 
  si => 1
509
 
 
510
 
=item ROUND
511
 
 
512
 
  round_function => $coderef
513
 
  round_style => 'ceil' | 'floor'
514
 
 
515
 
=item TO_S
516
 
 
517
 
=item QUIET
518
 
 
519
 
  quiet => 1
520
 
 
521
 
Suppresses the warnings emitted. Currently, the only case is
522
 
when the number is large than C<$base**(@suffixes+1)>.
523
 
 
524
 
=back
525
 
 
526
 
=head2 EXPORT
527
 
 
528
 
It is alright to import C<format_bytes>, but nothing is exported by default.
529
 
 
530
 
=head1 DIAGNOSTICS
531
 
 
532
 
  "unknown round style '$style'";
533
 
 
534
 
  "invalid base: $block (should be 1024, 1000 or 1024000)";
535
 
 
536
 
  "round function ($args{round_function}) should be a code ref";
537
 
 
538
 
  "suffixes ($args{suffixes}) should be 1000, 1024, 1024000 or an array ref";
539
 
 
540
 
  "negative numbers are not allowed" (??)
541
 
 
542
 
=head1 TO DO
543
 
 
544
 
A function C<parse_bytes>
545
 
 
546
 
  parse_bytes($str, $options)
547
 
 
548
 
which transforms '1k' to 1000, '1K' to 1024, '1MB' to 1E6,
549
 
'1M' to 1024*1024, etc. (like gnu du).
550
 
 
551
 
  $str =~ /^\s*(\d*\.?\d*)\s*(\S+)/ # $num $suffix
552
 
 
553
 
=head1 SEE ALSO
554
 
 
555
 
F<lib/human.c> and F<lib/human.h> in GNU coreutils.
556
 
 
557
 
The C<_convert()> solution by COG in Filesys::DiskUsage.
558
 
 
559
 
=head1 BUGS
560
 
 
561
 
Please report bugs via CPAN RT L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Number-Bytes-Human>
562
 
or L<mailto://bug-Number-Bytes-Human@rt.cpan.org>. I will not be able to close the bug
563
 
as BestPractical ignore my claims that I cannot log in, but I will answer anyway.
564
 
 
565
 
=head1 AUTHOR
566
 
 
567
 
Adriano R. Ferreira, E<lt>ferreira@cpan.orgE<gt>
568
 
 
569
 
=head1 COPYRIGHT AND LICENSE
570
 
 
571
 
Copyright (C) 2005-2007 by Adriano R. Ferreira
572
 
 
573
 
This library is free software; you can redistribute it and/or modify
574
 
it under the same terms as Perl itself.
575
 
 
576
 
=cut
 
1
package Number::Bytes::Human;
 
2
 
 
3
use strict;
 
4
use warnings;
 
5
 
 
6
our $VERSION = '0.09';
 
7
 
 
8
require Exporter;
 
9
our @ISA = qw(Exporter);
 
10
our @EXPORT_OK = qw(format_bytes parse_bytes);
 
11
 
 
12
require POSIX;
 
13
use Carp qw(croak carp);
 
14
 
 
15
#my $DEFAULT_BLOCK = 1024;
 
16
#my $DEFAULT_ZERO = '0';
 
17
#my $DEFAULT_ROUND_STYLE = 'ceil';
 
18
my %DEFAULT_SUFFIXES = (
 
19
  1024 => ['', 'K', 'M', 'G', 'T', 'P', 'E', 'Z', 'Y'],
 
20
  1000 => ['', 'k', 'M', 'G', 'T', 'P', 'E', 'Z', 'Y'],
 
21
  1024000 => ['', 'M', 'T', 'E', 'Y'],
 
22
  si_1024 => ['B', 'KiB', 'MiB', 'GiB', 'TiB', 'PiB', 'EiB', 'ZiB', 'YiB'],
 
23
  si_1000 => ['B', 'kB', 'MB', 'GB', 'TB', 'PB', 'EB', 'ZB', 'YB'],
 
24
);
 
25
my @DEFAULT_PREFIXES = @{$DEFAULT_SUFFIXES{1024}};
 
26
 
 
27
sub _default_suffixes {
 
28
  my $set = shift || 1024;
 
29
  if (exists $DEFAULT_SUFFIXES{$set}) {
 
30
    return @{$DEFAULT_SUFFIXES{$set}} if wantarray;
 
31
    return [ @{$DEFAULT_SUFFIXES{$set}} ];
 
32
  }
 
33
  croak "unknown suffix set '$set'";
 
34
}
 
35
 
 
36
my %ROUND_FUNCTIONS = (
 
37
  ceil => sub { return POSIX::ceil($_[0] * (10 ** $_[1])) / 10**$_[1]; },
 
38
  floor => sub { return POSIX::floor($_[0] * (10 ** $_[1])) / 10**$_[1]; },
 
39
  round => sub { return sprintf( "%." . ( $_[1] || 0 ) . "f", $_[0] ); },
 
40
  trunc => sub { return sprintf( "%d", $_[0] * (10 ** $_[1])) / 10**$_[1]; },
 
41
  # what about 'ceiling'?
 
42
);
 
43
 
 
44
sub _round_function {
 
45
  my $style = shift;
 
46
  if (exists $ROUND_FUNCTIONS{$style}) {
 
47
    return $ROUND_FUNCTIONS{$style}
 
48
  }
 
49
  croak "unknown round style '$style'";
 
50
}
 
51
 
 
52
# options
 
53
#   block | block_size | base | bs => 1024 | 1000
 
54
#   base_1024 | block_1024 | 1024 => $true
 
55
#   base_1000 | block_1000 | 1000 => $true
 
56
#
 
57
#   round_function => \&
 
58
#   round_style => 'ceiling', 'round', 'floor', 'trunc'
 
59
#
 
60
#   suffixes => 1024 | 1000 | si_1024 | si_1000 | 1024000 | \@
 
61
#   si => 1
 
62
#   unit => string (eg., 'B' | 'bps' | 'b')
 
63
#
 
64
#   zero => '0' (default) | '-' | '0%S' | undef
 
65
#
 
66
#
 
67
#   supress_point_zero | no_point_zero =>
 
68
#   b_to_i => 1
 
69
#   to_s => \&
 
70
#
 
71
#   allow_minus => 0 | 1
 
72
#   too_large => string
 
73
#   quiet => 1 (supresses "too large number" warning)
 
74
 
 
75
 
 
76
 
 
77
#  PROBABLY CRAP:
 
78
#   precision => integer
 
79
 
 
80
# parsed options
 
81
#   BLOCK => 1024 | 1000
 
82
#   ROUND_STYLE => 'ceil', 'round', 'floor', 'trunc'
 
83
#   ROUND_FUNCTION => \&
 
84
#   SUFFIXES => \@
 
85
#   ZERO =>
 
86
#   SI => undef | 1                     Parse SI compatible
 
87
 
 
88
 
 
89
=begin private
 
90
 
 
91
  $options = _parse_args($seed, $args)
 
92
  $options = _parse_args($seed, arg1 => $val1, ...)
 
93
 
 
94
$seed is undef or a hashref
 
95
$args is a hashref
 
96
 
 
97
=end private
 
98
 
 
99
=cut
 
100
 
 
101
sub _parse_args {
 
102
  my $seed = shift;
 
103
  my %args;
 
104
 
 
105
  my %options;
 
106
  unless (defined $seed) { # use defaults
 
107
    $options{BLOCK} = 1024;
 
108
    $options{ROUND_STYLE} = 'ceil';
 
109
    $options{ROUND_FUNCTION} = _round_function($options{ROUND_STYLE});
 
110
    $options{ZERO} = '0';
 
111
    $options{SI} = undef;
 
112
    $options{PRECISION} = 1;
 
113
    $options{PRECISION_CUTOFF} = 1;
 
114
    #$options{SUFFIXES} = # deferred to the last minute when we know BLOCK, seek [**]
 
115
    $options{UNIT} = undef;
 
116
  }
 
117
  # else { %options = %$seed } # this is set if @_!=0, down below
 
118
 
 
119
  if (@_==0) { # quick return for default values (no customized args)
 
120
    return (defined $seed) ? $seed : \%options;
 
121
  } elsif (@_==1 && ref $_[0]) { # \%args
 
122
    %args = %{$_[0]};
 
123
  } else { # arg1 => $val1, arg2 => $val2
 
124
    %args = @_;
 
125
  }
 
126
 
 
127
  # this is done here so this assignment/copy doesn't happen if @_==0
 
128
  %options = %$seed unless %options;
 
129
 
 
130
# block | block_size | base | bs => 1024 | 1000
 
131
# block_1024 | base_1024 | 1024 => $true
 
132
# block_1000 | base_1000 | 1024 => $true
 
133
  if ($args{block} ||
 
134
      $args{block_size} ||
 
135
      $args{base} ||
 
136
      $args{bs}
 
137
    ) {
 
138
    my $block = $args{block} ||
 
139
                $args{block_size} ||
 
140
                $args{base} ||
 
141
                $args{bs};
 
142
    unless ($block==1000 || $block==1024 || $block==1_024_000) {
 
143
      croak "invalid base: $block (should be 1024, 1000 or 1024000)";
 
144
    }
 
145
    $options{BLOCK} = $block;
 
146
 
 
147
  } elsif ($args{block_1024} ||
 
148
           $args{base_1024}  ||
 
149
           $args{1024}) {
 
150
 
 
151
    $options{BLOCK} = 1024;
 
152
  } elsif ($args{block_1000} ||
 
153
           $args{base_1000}  ||
 
154
           $args{1000}) {
 
155
 
 
156
    $options{BLOCK} = 1000;
 
157
  }
 
158
 
 
159
# round_function => \&
 
160
# round_style => 'ceil' | 'floor' | 'round' | 'trunc'
 
161
  if ($args{round_function}) {
 
162
    unless (ref $args{round_function} eq 'CODE') {
 
163
      croak "round function ($args{round_function}) should be a code ref";
 
164
    }
 
165
    $options{ROUND_FUNCTION} = $args{round_function};
 
166
    $options{ROUND_STYLE} = $args{round_style} || 'unknown';
 
167
  } elsif ($args{round_style}) {
 
168
    $options{ROUND_FUNCTION} = _round_function($args{round_style});
 
169
    $options{ROUND_STYLE} = $args{round_style};
 
170
  }
 
171
 
 
172
# SI compatibility (mostly for parsing)
 
173
  if ($args{si}) {
 
174
    $options{SI} = 1;
 
175
  }
 
176
 
 
177
# suffixes => 1024 | 1000 | si_1024 | si_1000 | 1024000 | \@
 
178
  if ($args{suffixes}) {
 
179
    if (ref $args{suffixes} eq 'ARRAY') {
 
180
      $options{SUFFIXES} = $args{suffixes};
 
181
    } elsif ($args{suffixes} =~ /^(si_)?(1000|1024)$/) {
 
182
      $options{SUFFIXES} = _default_suffixes($args{suffixes});
 
183
    } else {
 
184
      croak "suffixes ($args{suffixes}) should be 1024, 1000, si_1024, si_1000, 1024000 or an array ref";
 
185
    }
 
186
  }
 
187
  if (defined $args{unit}) {
 
188
    $options{UNIT} = $args{unit};
 
189
  }
 
190
 
 
191
# zero => undef | string
 
192
  if (exists $args{zero}) {
 
193
    $options{ZERO} = $args{zero};
 
194
    if (defined $options{ZERO}) {
 
195
      $options{ZERO} =~ s/%S/$options{SUFFIXES}->[0]/g
 
196
    }
 
197
  }
 
198
 
 
199
# precision => <integer>
 
200
  if (exists $args{precision} and $args{precision} =~ /\A\d+\z/) {
 
201
    $options{PRECISION} = $args{precision};
 
202
  }
 
203
 
 
204
# precision_cutoff => <intenger>
 
205
  if (exists $args{precision_cutoff} and ($args{precision_cutoff} =~ /\A\d+\z/ or $args{precision_cutoff} = '-1')) {
 
206
    $options{PRECISION_CUTOFF} = $args{precision_cutoff};
 
207
  }
 
208
 
 
209
# quiet => 1
 
210
  if ($args{quiet}) {
 
211
    $options{QUIET} = 1;
 
212
  }
 
213
 
 
214
  if (defined $seed) {
 
215
    %$seed = %options;
 
216
    return $seed;
 
217
  }
 
218
  return \%options
 
219
}
 
220
 
 
221
# NOTE. _format_bytes() SHOULD not change $options - NEVER.
 
222
 
 
223
sub _format_bytes {
 
224
  my $bytes = shift;
 
225
  return undef unless defined $bytes;
 
226
  my $options = shift;
 
227
  my %options = %$options;
 
228
 
 
229
  local *human_round = $options{ROUND_FUNCTION};
 
230
 
 
231
  return $options{ZERO} if ($bytes==0 && defined $options{ZERO});
 
232
 
 
233
  my $block = $options{BLOCK};
 
234
 
 
235
  # if a suffix set was not specified, pick a default [**]
 
236
  my @suffixes = $options{SUFFIXES} ? @{$options{SUFFIXES}} : _default_suffixes( ($options{SI} ? 'si_' : '') . $block);
 
237
 
 
238
  # WHAT ABOUT NEGATIVE NUMBERS: -1K ?
 
239
  my $sign = '';
 
240
  if ($bytes<0) {
 
241
     $bytes = -$bytes;
 
242
     $sign = '-';
 
243
  }
 
244
 
 
245
  my $suffix = $suffixes[0];
 
246
  my $x = $bytes;
 
247
  my $magnitude = 0;
 
248
  if($bytes >= $block) {
 
249
  #  return "$sign$bytes" if $bytes<$block;
 
250
    do {
 
251
      $x /= $block;
 
252
      $magnitude++;
 
253
    } while ( human_round($x, $options{PRECISION}) >= $block );
 
254
    if($magnitude >= (0 + @suffixes)) {
 
255
      carp "number too large (>= $block**$magnitude)" unless ($options{QUIET});
 
256
    }
 
257
    $suffix = $suffixes[$magnitude];
 
258
  }
 
259
  #$x = human_round( $x, $options{PRECISION} );
 
260
 
 
261
  $x = _precision_cutoff($x, $options);
 
262
  #reasses encase the precision_cutoff caused the value to cross the block size
 
263
  if($x >= $block) {
 
264
    $x /= $block;
 
265
    $magnitude++;
 
266
    if($magnitude >= (0 + @suffixes)) {
 
267
      carp "number too large (>= $block**$magnitude)" unless ($options{QUIET});
 
268
    }
 
269
    $suffix = $suffixes[$magnitude];
 
270
    $x = _precision_cutoff($x, $options);
 
271
  }
 
272
 
 
273
  my $unit = $options{UNIT} || '';
 
274
 
 
275
  return $sign . $x . $suffix . $unit;
 
276
 
 
277
}
 
278
 
 
279
sub _precision_cutoff {
 
280
 my $bytes   = shift;
 
281
 my $options = shift;
 
282
 my %options = %$options;
 
283
 if ( $options{PRECISION_CUTOFF} != -1 and ( length( sprintf( "%d", $bytes ) ) > $options{PRECISION_CUTOFF} ) ) {
 
284
   $bytes = sprintf( "%d", human_round( $bytes, 0 ) );
 
285
 } else {
 
286
   $bytes = sprintf( "%." . $options{PRECISION} . "f", human_round( $bytes, $options{PRECISION} ) );
 
287
 }
 
288
 return $bytes;
 
289
}
 
290
 
 
291
sub _parse_bytes {
 
292
  my $human = shift;
 
293
  my $options = shift;
 
294
  my %options = %$options;
 
295
 
 
296
  return 0 if( exists $options{ZERO} && ((!defined $options{ZERO} && !defined $human) || (defined $human && $human eq $options{ZERO})) );
 
297
  return undef unless defined $human;
 
298
 
 
299
  my %suffix_mult;
 
300
  my %suffix_block;
 
301
  my $m;
 
302
 
 
303
  if( $options{SUFFIXES} ) {
 
304
    $m = 1;
 
305
    foreach my $s (@{$options{SUFFIXES}}) {
 
306
      $suffix_mult{$s} = $m;
 
307
      $suffix_block{$s} = $options{BLOCK};
 
308
      $m *= $suffix_block{$s};
 
309
    }
 
310
  } else {
 
311
    if( !defined $options{SI} || $options{SI} == 1 ) {
 
312
      # If SI compatibility has been set BLOCK is ignored as it is infered from the unit
 
313
      $m = 1;
 
314
      foreach my $s (@{$DEFAULT_SUFFIXES{si_1000}}) {
 
315
        $suffix_mult{$s} = $m;
 
316
        $suffix_block{$s} = 1000;
 
317
        $m *= $suffix_block{$s};
 
318
      }
 
319
    
 
320
      $m = 1;
 
321
      foreach my $s (@{$DEFAULT_SUFFIXES{si_1024}}) {
 
322
        $suffix_mult{$s} = $m;
 
323
        $suffix_block{$s} = 1024;
 
324
        $m *= $suffix_block{$s};
 
325
      }
 
326
    }
 
327
 
 
328
    # The regular suffixes are only taken into account in default mode without specifically asking for SI compliance
 
329
    if( !defined $options{SI} ) {
 
330
      $m = 1;
 
331
      foreach my $s (_default_suffixes( $options{BLOCK} )) {
 
332
        $suffix_mult{$s} = $m;
 
333
        $suffix_block{$s} = $options{BLOCK};
 
334
        $m *= $suffix_block{$s};
 
335
      }
 
336
    }
 
337
  }
 
338
 
 
339
  my ($sign, $int, $frac, $unit) = ($human =~ /^\s*(-?)\s*(\d*)(?:\.(\d*))?\s*(\D*)$/);
 
340
 
 
341
  $frac ||= 0;
 
342
 
 
343
#  print STDERR "S: $sign I: $int F: $frac U: $unit\n";
 
344
 
 
345
 
 
346
  my $mult;
 
347
  my $block;
 
348
  my $u = $options{UNIT} || '';
 
349
  foreach my $s (keys %suffix_block) {
 
350
    if( $unit =~ /^${s}${u}$/i ) {
 
351
      $mult = ($sign eq '-' ? -1 : 1) * $suffix_mult{$s};
 
352
      $block = $suffix_block{$s};
 
353
      last;
 
354
    }
 
355
  }
 
356
 
 
357
  if( !defined $mult ) {
 
358
    carp "Could not parse human readable byte value '$human'";
 
359
use Data::Dumper;
 
360
print STDERR Dumper( %suffix_block );
 
361
    return undef;
 
362
  }
 
363
 
 
364
  my $bytes = int( ($int + ($frac / $block)) * $mult );
 
365
 
 
366
  return $bytes;
 
367
}
 
368
 
 
369
 
 
370
# convert byte count (file size) to human readable format
 
371
sub format_bytes {
 
372
  my $bytes = shift;
 
373
  my $options = _parse_args(undef, @_);
 
374
  #use YAML; print Dump $options;
 
375
  return _format_bytes($bytes, $options);
 
376
}
 
377
 
 
378
# convert human readable format to byte count (file size)
 
379
sub parse_bytes {
 
380
  my $human = shift;
 
381
  my $options = _parse_args(undef, @_);
 
382
  #use YAML; print Dump $options;
 
383
  return _parse_bytes($human, $options);
 
384
}
 
385
 
 
386
### the OO way
 
387
 
 
388
# new()
 
389
sub new {
 
390
  my $proto = shift;
 
391
  my $class = ref $proto || $proto;
 
392
  my $opts = _parse_args(undef, @_);
 
393
  return bless $opts, $class;
 
394
}
 
395
 
 
396
# set_options()
 
397
sub set_options {
 
398
  my $self = shift;
 
399
  return $self->_parse_args(@_);
 
400
}
 
401
 
 
402
# format()
 
403
sub format {
 
404
  my $self = shift;
 
405
  my $bytes = shift;
 
406
  return _format_bytes($bytes, $self);
 
407
}
 
408
 
 
409
# parse()
 
410
sub parse {
 
411
  my $self = shift;
 
412
  my $human = shift;
 
413
  return _parse_bytes($human, $self);
 
414
}
 
415
 
 
416
# the solution by COG in Filesys::DiskUsage
 
417
# convert size to human readable format
 
418
#sub _convert {
 
419
#  defined (my $size = shift) || return undef;
 
420
#  my $config = {@_};
 
421
#  $config->{human} || return $size;
 
422
#  my $block = $config->{'Human-readable'} ? 1000 : 1024;
 
423
#  my @args = qw/B K M G/;
 
424
#
 
425
#  while (@args && $size > $block) {
 
426
#    shift @args;
 
427
#    $size /= $block;
 
428
#  }
 
429
#
 
430
#  if ($config->{'truncate-readable'} > 0) {
 
431
#    $size = sprintf("%.$config->{'truncate-readable'}f",$size);
 
432
#  }
 
433
#
 
434
#  "$size$args[0]";
 
435
#}
 
436
#
 
437
# not exact: 1024 => 1024B instead of 1K
 
438
# not nicely formatted => 1.00 instead of 1K
 
439
 
 
440
1;
 
441
 
 
442
__END__
 
443
 
 
444
=head1 NAME
 
445
 
 
446
Number::Bytes::Human - Convert byte count to human readable format
 
447
 
 
448
=head1 SYNOPSIS
 
449
 
 
450
  use Number::Bytes::Human qw(format_bytes parse_bytes);
 
451
  $size = format_bytes(0); # '0'
 
452
  $size = format_bytes(2*1024); # '2.0K'
 
453
 
 
454
  $size = format_bytes(1_234_890, bs => 1000); # '1.3M'
 
455
  $size = format_bytes(1E9, bs => 1000); # '1.0G'
 
456
 
 
457
  my $bytes = parse_bytes('1.0K');   # 1024
 
458
  my $bytes = parse_bytes('1.0KB');  # 1000, SI unit
 
459
  my $bytes = parse_bytes('1.0KiB'); # 1024, SI unit
 
460
 
 
461
  # the OO way
 
462
  $human = Number::Bytes::Human->new(bs => 1000, si => 1);
 
463
  $size = $human->format(1E7); # '10MB'
 
464
 
 
465
  $bytes = $human->parse('10MB');   # 10*1000*1000
 
466
  $bytes = $human->parse('10MiB');  # 10*1024*1024
 
467
  $bytes = $human->parse('10M');    # Error, no SI unit
 
468
 
 
469
  $human->set_options(zero => '-');
 
470
  $size = $human->format(0);    # '-'
 
471
  $bytes = $human->parse('-');  # 0
 
472
 
 
473
  $human = Number::Bytes::Human->new(bs => 1000, round_style => 'round', precision => 2);
 
474
  $size = $human->format(10240000); # '10.24MB'
 
475
 
 
476
=head1 DESCRIPTION
 
477
 
 
478
THIS IS ALPHA SOFTWARE: THE DOCUMENTATION AND THE CODE WILL SUFFER
 
479
CHANGES SOME DAY (THANKS, GOD!).
 
480
 
 
481
This module provides a formatter which turns byte counts
 
482
to usual readable format, like '2.0K', '3.1G', '100B'.
 
483
It was inspired in the C<-h> option of Unix
 
484
utilities like C<du>, C<df> and C<ls> for "human-readable" output.
 
485
 
 
486
From the FreeBSD man page of C<df>: http://www.freebsd.org/cgi/man.cgi?query=df
 
487
 
 
488
  "Human-readable" output.  Use unit suffixes: Byte, Kilobyte,
 
489
  Megabyte, Gigabyte, Terabyte and Petabyte in order to reduce the
 
490
  number of digits to four or fewer using base 2 for sizes.
 
491
 
 
492
  byte      B
 
493
  kilobyte  K = 2**10 B = 1024 B
 
494
  megabyte  M = 2**20 B = 1024 * 1024 B
 
495
  gigabyte  G = 2**30 B = 1024 * 1024 * 1024 B
 
496
  terabyte  T = 2**40 B = 1024 * 1024 * 1024 * 1024 B
 
497
 
 
498
  petabyte  P = 2**50 B = 1024 * 1024 * 1024 * 1024 * 1024 B
 
499
  exabyte   E = 2**60 B = 1024 * 1024 * 1024 * 1024 * 1024 * 1024 B
 
500
  zettabyte Z = 2**70 B = 1024 * 1024 * 1024 * 1024 * 1024 * 1024 * 1024 B
 
501
  yottabyte Y = 2**80 B = 1024 * 1024 * 1024 * 1024 * 1024 * 1024 * 1024 * 1024 B
 
502
 
 
503
I have found this link to be quite useful:
 
504
 
 
505
  http://www.t1shopper.com/tools/calculate/
 
506
 
 
507
If you feel like a hard-drive manufacturer, you can start
 
508
counting bytes by powers of 1000 (instead of the generous 1024).
 
509
Just use C<< bs => 1000 >>.
 
510
 
 
511
But if you are a floppy disk manufacturer and want to start
 
512
counting in units of 1024000 (for your "1.44 MB" disks)?
 
513
Then use C<< bs => 1_024_000 >>.
 
514
 
 
515
If you feel like a purist academic, you can force the use of
 
516
metric prefixes
 
517
according to the Dec 1998 standard by the IEC. Never mind the units for base 1000
 
518
are C<('B', 'kB', 'MB', 'GB', 'TB', 'PB', 'EB', 'ZB', 'YB')> and,
 
519
even worse, the ones for base 1024 are
 
520
C<('B', 'KiB', 'MiB', 'GiB', 'TiB', 'PiB', 'EiB', 'ZiB', 'YiB')>
 
521
with the horrible names: bytes, kibibytes, mebibytes, etc.
 
522
All you have to do is to use C<< si => 1 >>. Ain't that beautiful
 
523
the SI system? Read about it:
 
524
 
 
525
  http://physics.nist.gov/cuu/Units/binary.html
 
526
 
 
527
You can try a pure Perl C<"ls -lh">-inspired command with the one-liner, er, two-liner:
 
528
 
 
529
  $ perl -MNumber::Bytes::Human=format_bytes \
 
530
         -e 'printf "%5s %s\n", format_bytes(-s), $_ for @ARGV' *
 
531
 
 
532
Why to write such a module? Because if people can write such things
 
533
in C, it can be written much easier in Perl and then reused,
 
534
refactored, abused. And then, when it is much improved, some
 
535
brave soul can port it back to C (if only for the warm feeling
 
536
of painful programming).
 
537
 
 
538
It is also possible to parse human readable formatted bytes. The 
 
539
automatic format detection recognizes SI units with the blocksizes
 
540
of 1000 and 1024 respectively and additionally the customary K / M / G etc. with
 
541
blocksize 1024. When si => 1 is added to the options only SI units
 
542
are recognized. Explicitly specifying a blocksize changes it
 
543
for all detected units.
 
544
 
 
545
=head2 OBJECTS
 
546
 
 
547
An alternative to the functional style of this module
 
548
is the OO fashion. This is useful for avoiding the
 
549
unnecessary parsing of the arguments over and over
 
550
if you have to format lots of numbers
 
551
 
 
552
 
 
553
  for (@sizes) {
 
554
    my $fmt_size = format_bytes($_, @args);
 
555
    ...
 
556
  }
 
557
 
 
558
versus
 
559
 
 
560
  my $human = Number::Format::Bytes->new(@args);
 
561
  for (@sizes) {
 
562
    my $fmt_size = $human->format($_);
 
563
    ...
 
564
  }
 
565
 
 
566
for TODO
 
567
[TODO] MAKE IT JUST A MATTER OF STYLE: memoize _parse_args()
 
568
$seed == undef
 
569
 
 
570
=head2 FUNCTIONS
 
571
 
 
572
=over 4
 
573
 
 
574
=item B<format_bytes>
 
575
 
 
576
  $h_size = format_bytes($size, @options);
 
577
 
 
578
Turns a byte count (like 1230) to a readable format like '1.3K'.
 
579
You have a bunch of options to play with. See the section
 
580
L</"OPTIONS"> to know the details.
 
581
 
 
582
=item B<parse_bytes>
 
583
 
 
584
  $size = parse_bytes($h_size, @options);
 
585
 
 
586
Turns a human readable byte count into a number of the equivalent bytes.
 
587
 
 
588
=back
 
589
 
 
590
=head2 METHODS
 
591
 
 
592
=over 4
 
593
 
 
594
=item B<new>
 
595
 
 
596
  $h = Number::Bytes::Human->new(@options);
 
597
 
 
598
The constructor. For details on the arguments, see the section
 
599
L</"OPTIONS">.
 
600
 
 
601
=item B<format>
 
602
 
 
603
  $h_size = $h->format($size);
 
604
 
 
605
Turns a byte count (like 1230) to a readable format like '1.3K'.
 
606
The statements
 
607
 
 
608
  $h = Number::Bytes::Human->new(@options);
 
609
  $h_size = $h->format($size);
 
610
 
 
611
are equivalent to C<$h_size = format_bytes($size, @options)>,
 
612
with only one pass for the option arguments.
 
613
 
 
614
=item B<parse>
 
615
 
 
616
  $size = $h->parse($h_size)
 
617
 
 
618
Turns a human readable byte count into the number of bytes.
 
619
The statements
 
620
 
 
621
  $h = Number::Bytes::Human->new(@options);
 
622
  $size = $h->format($h_size);
 
623
 
 
624
are equivalent to C<$size = parse_bytes($h_size, @options)>,
 
625
with only one pass for the option arguments.
 
626
 
 
627
=item B<set_options>
 
628
 
 
629
  $h->set_options(@options);
 
630
 
 
631
To alter the options of a C<Number::Bytes::Human> object.
 
632
See L</"OPTIONS">.
 
633
 
 
634
=back
 
635
 
 
636
=head2 OPTIONS
 
637
 
 
638
=over 4
 
639
 
 
640
=item BASE
 
641
 
 
642
  block | base | block_size | bs => 1000 | 1024 | 1024000
 
643
  base_1024 | block_1024 | 1024 => 1
 
644
  base_1000 | block_1000 | 1000 => 1
 
645
 
 
646
The base to be used: 1024 (default), 1000 or 1024000.
 
647
 
 
648
Any other value throws an exception.
 
649
 
 
650
=item SUFFIXES
 
651
 
 
652
  suffixes => 1000 | 1024 | 1024000 | si_1000 | si_1024 | $arrayref
 
653
 
 
654
By default, the used suffixes stand for '', 'K', 'M', ...
 
655
for base 1024 and '', 'k', 'M', ... for base 1000
 
656
(which are indeed the usual metric prefixes with implied unit
 
657
as bytes, 'B'). For the weird 1024000 base, suffixes are
 
658
'', 'M', 'T', etc.
 
659
 
 
660
=item ZERO
 
661
 
 
662
  zero => string | undef
 
663
 
 
664
The string C<0> maps to ('0' by default). If C<undef>, the general case is used.
 
665
The string may contain '%S' in which case the suffix for byte is used.
 
666
 
 
667
  format_bytes(0, zero => '-') => '-'
 
668
 
 
669
=item METRIC SYSTEM
 
670
 
 
671
  si => 1
 
672
 
 
673
=item ROUND
 
674
 
 
675
  round_function => $coderef
 
676
  round_style => 'ceil' | 'floor' | 'round' | 'trunc'
 
677
 
 
678
=item TO_S
 
679
 
 
680
=item QUIET
 
681
 
 
682
  quiet => 1
 
683
 
 
684
Suppresses the warnings emitted. Currently, the only case is
 
685
when the number is large than C<$base**(@suffixes+1)>.
 
686
 
 
687
=item PRECISION
 
688
 
 
689
  precision => <integer>
 
690
 
 
691
default = 1
 
692
sets the precicion of digits, only apropreacte for round_style 'round' or if you
 
693
want to accept it in as the second parameter to your custome round_function.
 
694
 
 
695
=item PRECISION_CUTOFF
 
696
 
 
697
  precision_cutoff => <integer>
 
698
 
 
699
default = 1
 
700
when the number of digits exceeds this number causes the precision to be cutoff
 
701
(was default behaviour in 0.07 and below)
 
702
 
 
703
=back
 
704
 
 
705
=head2 EXPORT
 
706
 
 
707
It is alright to import C<format_bytes> and C<parse_bytes>, but nothing is exported by default.
 
708
 
 
709
=head1 DIAGNOSTICS
 
710
 
 
711
  "unknown round style '$style'";
 
712
 
 
713
  "invalid base: $block (should be 1024, 1000 or 1024000)";
 
714
 
 
715
  "round function ($args{round_function}) should be a code ref";
 
716
 
 
717
  "suffixes ($args{suffixes}) should be 1000, 1024, 1024000 or an array ref";
 
718
 
 
719
  "negative numbers are not allowed" (??)
 
720
 
 
721
=head1 TO DO
 
722
 
 
723
A function C<parse_bytes>
 
724
 
 
725
  parse_bytes($str, $options)
 
726
 
 
727
which transforms '1k' to 1000, '1K' to 1024, '1MB' to 1E6,
 
728
'1M' to 1024*1024, etc. (like gnu du).
 
729
 
 
730
  $str =~ /^\s*(\d*\.?\d*)\s*(\S+)/ # $num $suffix
 
731
 
 
732
=head1 SEE ALSO
 
733
 
 
734
F<lib/human.c> and F<lib/human.h> in GNU coreutils.
 
735
 
 
736
The C<_convert()> solution by COG in Filesys::DiskUsage.
 
737
 
 
738
=head1 BUGS
 
739
 
 
740
Please report bugs via CPAN RT L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Number-Bytes-Human>
 
741
or L<mailto://bug-Number-Bytes-Human@rt.cpan.org>. I will not be able to close the bug
 
742
as BestPractical ignore my claims that I cannot log in, but I will answer anyway.
 
743
 
 
744
=head1 AUTHOR
 
745
 
 
746
Adriano R. Ferreira, E<lt>ferreira@cpan.orgE<gt>
 
747
 
 
748
=head1 COPYRIGHT AND LICENSE
 
749
 
 
750
Copyright (C) 2005-2007 by Adriano R. Ferreira
 
751
 
 
752
This library is free software; you can redistribute it and/or modify
 
753
it under the same terms as Perl itself.
 
754
 
 
755
=cut