@@ -1,37 +1,43 @@
-Revision history for Perl extension Number::Bytes::Human.
-
-0.07 Thu Mar 5 2007
- - nothing new here
- - META.yml is automatically generated by EUMM
- - minor edits of the docs
- - added a test for POD coverage
-
-0.06 Thu Oct 26 2006
- - Martin Ward pointed to me:
- * [FIX] the SI prefix for bytes in base 1024 is still 'B',
- not 'iB'
- * floppy disk manufacturers count in units of 1024000 (for
- their "1.44 MB" disks) [NEW OPTION: bs => 1024000]
- - in the OO code, indirect notation "new Number::Bytes::Human"
- was replaced by "Number::Bytes::Human->new"
-
-0.05 Wed Oct 25 2006
- - nothing new here
- - added taint checking to tests "#!perl -T\n"
-
-0.04 Tue Oct 5 2005
- - now default suffix for kilobytes (base 1000) is 'k', not 'K'
- - now 'suffixes' option support 1024, 1000, si_1024, and si_1000
-
-0.03 Tue Oct 4 2005
- - some idle changes, like fixing 'si' option behavior
- - added new test "t/06si.t"
- - the (yet) undocumented option 'unit'
- - a test script "t/07unit.t"
-
-0.02 Tue Oct 4 2005
- - 0.02 release follows, because META.yml and Changes
- were forgotten
-
-0.01 Tue Oct 4 2005
- - 0.01 release reaches CPAN
+Revision history for Perl extension Number::Bytes::Human.
+
+0.09 Fri Mar 01 2013
+ - Add parse_bytes
+
+0.08 Fri Feb 22 2013
+ - fix bug #81477 (precision support) with patch from Matthew Vale
+
+0.07 Thu Mar 5 2007
+ - nothing new here
+ - META.yml is automatically generated by EUMM
+ - minor edits of the docs
+ - added a test for POD coverage
+
+0.06 Thu Oct 26 2006
+ - Martin Ward pointed to me:
+ * [FIX] the SI prefix for bytes in base 1024 is still 'B',
+ not 'iB'
+ * floppy disk manufacturers count in units of 1024000 (for
+ their "1.44 MB" disks) [NEW OPTION: bs => 1024000]
+ - in the OO code, indirect notation "new Number::Bytes::Human"
+ was replaced by "Number::Bytes::Human->new"
+
+0.05 Wed Oct 25 2006
+ - nothing new here
+ - added taint checking to tests "#!perl -T\n"
+
+0.04 Tue Oct 5 2005
+ - now default suffix for kilobytes (base 1000) is 'k', not 'K'
+ - now 'suffixes' option support 1024, 1000, si_1024, and si_1000
+
+0.03 Tue Oct 4 2005
+ - some idle changes, like fixing 'si' option behavior
+ - added new test "t/06si.t"
+ - the (yet) undocumented option 'unit'
+ - a test script "t/07unit.t"
+
+0.02 Tue Oct 4 2005
+ - 0.02 release follows, because META.yml and Changes
+ were forgotten
+
+0.01 Tue Oct 4 2005
+ - 0.01 release reaches CPAN
@@ -1,576 +1,755 @@
-
-package Number::Bytes::Human;
-
-use strict;
-use warnings;
-
-our $VERSION = '0.07';
-
-require Exporter;
-our @ISA = qw(Exporter);
-our @EXPORT_OK = qw(format_bytes);
-
-require POSIX;
-use Carp qw(croak carp);
-
-#my $DEFAULT_BLOCK = 1024;
-#my $DEFAULT_ZERO = '0';
-#my $DEFAULT_ROUND_STYLE = 'ceil';
-my %DEFAULT_SUFFIXES = (
- 1024 => ['', 'K', 'M', 'G', 'T', 'P', 'E', 'Z', 'Y'],
- 1000 => ['', 'k', 'M', 'G', 'T', 'P', 'E', 'Z', 'Y'],
- 1024000 => ['', 'M', 'T', 'E', 'Y'],
- si_1024 => ['B', 'KiB', 'MiB', 'GiB', 'TiB', 'PiB', 'EiB', 'ZiB', 'YiB'],
- si_1000 => ['B', 'kB', 'MB', 'GB', 'TB', 'PB', 'EB', 'ZB', 'YB'],
-);
-my @DEFAULT_PREFIXES = @{$DEFAULT_SUFFIXES{1024}};
-
-sub _default_suffixes {
- my $set = shift || 1024;
- if (exists $DEFAULT_SUFFIXES{$set}) {
- return @{$DEFAULT_SUFFIXES{$set}} if wantarray;
- return [ @{$DEFAULT_SUFFIXES{$set}} ];
- }
- croak "unknown suffix set '$set'";
-}
-
-my %ROUND_FUNCTIONS = (
- ceil => \&POSIX::ceil,
- floor => \&POSIX::floor,
- #round => sub { shift }, # FIXME
- #trunc => sub { int shift } # FIXME
-
- # what about 'ceiling'?
-);
-
-sub _round_function {
- my $style = shift;
- if (exists $ROUND_FUNCTIONS{$style}) {
- return $ROUND_FUNCTIONS{$style}
- }
- croak "unknown round style '$style'";
-}
-
-# options
-# block | block_size | base | bs => 1024 | 1000
-# base_1024 | block_1024 | 1024 => $true
-# base_1000 | block_1000 | 1000 => $true
-#
-# round_function => \&
-# round_style => 'ceiling', 'round', 'floor', 'trunc'
-#
-# suffixes => 1024 | 1000 | si_1024 | si_1000 | 1024000 | \@
-# si => 1
-# unit => string (eg., 'B' | 'bps' | 'b')
-#
-# zero => '0' (default) | '-' | '0%S' | undef
-#
-#
-# supress_point_zero | no_point_zero =>
-# b_to_i => 1
-# to_s => \&
-#
-# allow_minus => 0 | 1
-# too_large => string
-# quiet => 1 (supresses "too large number" warning)
-
-
-
-# PROBABLY CRAP:
-# precision =>
-
-# parsed options
-# BLOCK => 1024 | 1020
-# ROUND_STYLE => 'ceil', 'round', 'floor', 'trunc'
-# ROUND_FUNCTION => \&
-# SUFFIXES => \@
-# ZERO =>
-
-
-=begin private
-
- $options = _parse_args($seed, $args)
- $options = _parse_args($seed, arg1 => $val1, ...)
-
-$seed is undef or a hashref
-$args is a hashref
-
-=end private
-
-=cut
-
-sub _parse_args {
- my $seed = shift;
- my %args;
-
- my %options;
- unless (defined $seed) { # use defaults
- $options{BLOCK} = 1024;
- $options{ROUND_STYLE} = 'ceil';
- $options{ROUND_FUNCTION} = _round_function($options{ROUND_STYLE});
- $options{ZERO} = '0';
- #$options{SUFFIXES} = # deferred to the last minute when we know BLOCK, seek [**]
- }
- # else { %options = %$seed } # this is set if @_!=0, down below
-
- if (@_==0) { # quick return for default values (no customized args)
- return (defined $seed) ? $seed : \%options;
- } elsif (@_==1 && ref $_[0]) { # \%args
- %args = %{$_[0]};
- } else { # arg1 => $val1, arg2 => $val2
- %args = @_;
- }
-
- # this is done here so this assignment/copy doesn't happen if @_==0
- %options = %$seed unless %options;
-
-# block | block_size | base | bs => 1024 | 1000
-# block_1024 | base_1024 | 1024 => $true
-# block_1000 | base_1000 | 1024 => $true
- if ($args{block} ||
- $args{block_size} ||
- $args{base} ||
- $args{bs}
- ) {
- my $block = $args{block} ||
- $args{block_size} ||
- $args{base} ||
- $args{bs};
- unless ($block==1000 || $block==1024 || $block==1_024_000) {
- croak "invalid base: $block (should be 1024, 1000 or 1024000)";
- }
- $options{BLOCK} = $block;
-
- } elsif ($args{block_1024} ||
- $args{base_1024} ||
- $args{1024}) {
-
- $options{BLOCK} = 1024;
- } elsif ($args{block_1000} ||
- $args{base_1000} ||
- $args{1000}) {
-
- $options{BLOCK} = 1000;
- }
-
-# round_function => \&
-# round_style => 'ceil' | 'floor' | 'round' | 'trunc'
- if ($args{round_function}) {
- unless (ref $args{round_function} eq 'CODE') {
- croak "round function ($args{round_function}) should be a code ref";
- }
- $options{ROUND_FUNCTION} = $args{round_function};
- $options{ROUND_STYLE} = $args{round_style} || 'unknown';
- } elsif ($args{round_style}) {
- $options{ROUND_FUNCTION} = _round_function($args{round_style});
- $options{ROUND_STYLE} = $args{round_style};
- }
-
-# suffixes => 1024 | 1000 | si_1024 | si_1000 | 1024000 | \@
- if ($args{suffixes}) {
- if (ref $args{suffixes} eq 'ARRAY') {
- $options{SUFFIXES} = $args{suffixes};
- } elsif ($args{suffixes} =~ /^(si_)?(1000|1024)$/) {
- $options{SUFFIXES} = _default_suffixes($args{suffixes});
- } else {
- croak "suffixes ($args{suffixes}) should be 1024, 1000, si_1024, si_1000, 1024000 or an array ref";
- }
- } elsif ($args{si}) {
- my $set = ($options{BLOCK}==1024) ? 'si_1024' : 'si_1000';
- $options{SUFFIXES} = _default_suffixes($set);
- } elsif (defined $args{unit}) {
- my $suff = $args{unit};
- $options{SUFFIXES} = [ map { "$_$suff" } @DEFAULT_PREFIXES ];
- }
-
-# zero => undef | string
- if (exists $args{zero}) {
- $options{ZERO} = $args{zero};
- if (defined $options{ZERO}) {
- $options{ZERO} =~ s/%S/$options{SUFFIXES}->[0]/g
- }
- }
-
-# quiet => 1
- if ($args{quiet}) {
- $options{QUIET} = 1;
- }
-
- if (defined $seed) {
- %$seed = %options;
- return $seed;
- }
- return \%options
-}
-
-# NOTE. _format_bytes() SHOULD not change $options - NEVER.
-
-sub _format_bytes {
- my $bytes = shift;
- return undef unless defined $bytes;
- my $options = shift;
- my %options = %$options;
-
- local *human_round = $options{ROUND_FUNCTION};
-
- return $options{ZERO} if ($bytes==0 && defined $options{ZERO});
-
- my $block = $options{BLOCK};
-
- # if a suffix set was not specified, pick a default [**]
- my @suffixes = $options{SUFFIXES} ? @{$options{SUFFIXES}} : _default_suffixes($block);
-
- # WHAT ABOUT NEGATIVE NUMBERS: -1K ?
- my $sign = '';
- if ($bytes<0) {
- $bytes = -$bytes;
- $sign = '-';
- }
- return $sign . human_round($bytes) . $suffixes[0] if $bytes<$block;
-
-# return "$sign$bytes" if $bytes<$block;
-
- my $x = $bytes;
- my $suffix;
- foreach (@suffixes) {
- $suffix = $_, last if human_round($x) < $block;
- $x /= $block;
- }
- unless (defined $suffix) { # number >= $block*($block**@suffixes) [>= 1E30, that's huge!]
- unless ($options{QUIET}) {
- my $pow = @suffixes+1;
- carp "number too large (>= $block**$pow)"
- }
- $suffix = $suffixes[-1];
- $x *= $block;
- }
- # OPTION: return "Inf"
-
- my $num;
- if ($x < 10.0) {
- $num = sprintf("%.1f", human_round($x*10)/10);
- } else {
- $num = sprintf("%d", human_round($x));
- }
-
- "$sign$num$suffix"
-
-}
-
-# convert byte count (file size) to human readable format
-sub format_bytes {
- my $bytes = shift;
- my $options = _parse_args(undef, @_);
- #use YAML; print Dump $options;
- return _format_bytes($bytes, $options);
-}
-
-### the OO way
-
-# new()
-sub new {
- my $proto = shift;
- my $class = ref $proto || $proto;
- my $opts = _parse_args(undef, @_);
- return bless $opts, $class;
-}
-
-# set_options()
-sub set_options {
- my $self = shift;
- return $self->_parse_args(@_);
-}
-
-# format()
-sub format {
- my $self = shift;
- my $bytes = shift;
- return _format_bytes($bytes, $self);
-}
-
-
-# the solution by COG in Filesys::DiskUsage
-# convert size to human readable format
-#sub _convert {
-# defined (my $size = shift) || return undef;
-# my $config = {@_};
-# $config->{human} || return $size;
-# my $block = $config->{'Human-readable'} ? 1000 : 1024;
-# my @args = qw/B K M G/;
-#
-# while (@args && $size > $block) {
-# shift @args;
-# $size /= $block;
-# }
-#
-# if ($config->{'truncate-readable'} > 0) {
-# $size = sprintf("%.$config->{'truncate-readable'}f",$size);
-# }
-#
-# "$size$args[0]";
-#}
-#
-# not exact: 1024 => 1024B instead of 1K
-# not nicely formatted => 1.00 instead of 1K
-
-1;
-
-__END__
-
-=head1 NAME
-
-Number::Bytes::Human - Convert byte count to human readable format
-
-=head1 SYNOPSIS
-
- use Number::Bytes::Human qw(format_bytes);
- $size = format_bytes(0); # '0'
- $size = format_bytes(2*1024); # '2.0K'
-
- $size = format_bytes(1_234_890, bs => 1000); # '1.3M'
- $size = format_bytes(1E9, bs => 1000); # '1.0G'
-
- # the OO way
- $human = Number::Bytes::Human->new(bs => 1000, si => 1);
- $size = $human->format(1E7); # '10MB'
- $human->set_options(zero => '-');
- $size = $human->format(0); # '-'
-
-=head1 DESCRIPTION
-
-THIS IS ALPHA SOFTWARE: THE DOCUMENTATION AND THE CODE WILL SUFFER
-CHANGES SOME DAY (THANKS, GOD!).
-
-This module provides a formatter which turns byte counts
-to usual readable format, like '2.0K', '3.1G', '100B'.
-It was inspired in the C<-h> option of Unix
-utilities like C<du>, C<df> and C<ls> for "human-readable" output.
-
-From the FreeBSD man page of C<df>: http://www.freebsd.org/cgi/man.cgi?query=df
-
- "Human-readable" output. Use unit suffixes: Byte, Kilobyte,
- Megabyte, Gigabyte, Terabyte and Petabyte in order to reduce the
- number of digits to four or fewer using base 2 for sizes.
-
- byte B
- kilobyte K = 2**10 B = 1024 B
- megabyte M = 2**20 B = 1024 * 1024 B
- gigabyte G = 2**30 B = 1024 * 1024 * 1024 B
- terabyte T = 2**40 B = 1024 * 1024 * 1024 * 1024 B
-
- petabyte P = 2**50 B = 1024 * 1024 * 1024 * 1024 * 1024 B
- exabyte E = 2**60 B = 1024 * 1024 * 1024 * 1024 * 1024 * 1024 B
- zettabyte Z = 2**70 B = 1024 * 1024 * 1024 * 1024 * 1024 * 1024 * 1024 B
- yottabyte Y = 2**80 B = 1024 * 1024 * 1024 * 1024 * 1024 * 1024 * 1024 * 1024 B
-
-I have found this link to be quite useful:
-
- http://www.t1shopper.com/tools/calculate/
-
-If you feel like a hard-drive manufacturer, you can start
-counting bytes by powers of 1000 (instead of the generous 1024).
-Just use C<< bs => 1000 >>.
-
-But if you are a floppy disk manufacturer and want to start
-counting in units of 1024000 (for your "1.44 MB" disks)?
-Then use C<< bs => 1_024_000 >>.
-
-If you feel like a purist academic, you can force the use of
-metric prefixes
-according to the Dec 1998 standard by the IEC. Never mind the units for base 1000
-are C<('B', 'kB', 'MB', 'GB', 'TB', 'PB', 'EB', 'ZB', 'YB')> and,
-even worse, the ones for base 1024 are
-C<('B', 'KiB', 'MiB', 'GiB', 'TiB', 'PiB', 'EiB', 'ZiB', 'YiB')>
-with the horrible names: bytes, kibibytes, mebibytes, etc.
-All you have to do is to use C<< si => 1 >>. Ain't that beautiful
-the SI system? Read about it:
-
- http://physics.nist.gov/cuu/Units/binary.html
-
-You can try a pure Perl C<"ls -lh">-inspired command with the one-liner, er, two-liner:
-
- $ perl -MNumber::Bytes::Human=format_bytes \
- -e 'printf "%5s %s\n", format_bytes(-s), $_ for @ARGV' *
-
-Why to write such a module? Because if people can write such things
-in C, it can be written much easier in Perl and then reused,
-refactored, abused. And then, when it is much improved, some
-brave soul can port it back to C (if only for the warm feeling
-of painful programming).
-
-=head2 OBJECTS
-
-An alternative to the functional style of this module
-is the OO fashion. This is useful for avoiding the
-unnecessary parsing of the arguments over and over
-if you have to format lots of numbers
-
-
- for (@sizes) {
- my $fmt_size = format_bytes($_, @args);
- ...
- }
-
-versus
-
- my $human = Number::Format::Bytes->new(@args);
- for (@sizes) {
- my $fmt_size = $human->format($_);
- ...
- }
-
-for TODO
-[TODO] MAKE IT JUST A MATTER OF STYLE: memoize _parse_args()
-$seed == undef
-
-=head2 FUNCTIONS
-
-=over 4
-
-=item B<format_bytes>
-
- $h_size = format_bytes($size, @options);
-
-Turns a byte count (like 1230) to a readable format like '1.3K'.
-You have a bunch of options to play with. See the section
-L</"OPTIONS"> to know the details.
-
-=back
-
-=head2 METHODS
-
-=over 4
-
-=item B<new>
-
- $h = Number::Bytes::Human->new(@options);
-
-The constructor. For details on the arguments, see the section
-L</"OPTIONS">.
-
-=item B<format>
-
- $h_size = $h->format($size);
-
-Turns a byte count (like 1230) to a readable format like '1.3K'.
-The statements
-
- $h = Number::Bytes::Human->new(@options);
- $h_size = $h->format($size);
-
-are equivalent to C<$h_size = format_bytes($size, @options)>,
-with only one pass for the option arguments.
-
-=item B<set_options>
-
- $h->set_options(@options);
-
-To alter the options of a C<Number::Bytes::Human> object.
-See L</"OPTIONS">.
-
-=back
-
-=head2 OPTIONS
-
-=over 4
-
-=item BASE
-
- block | base | block_size | bs => 1000 | 1024 | 1024000
- base_1024 | block_1024 | 1024 => 1
- base_1000 | block_1000 | 1000 => 1
-
-The base to be used: 1024 (default), 1000 or 1024000.
-
-Any other value throws an exception.
-
-=item SUFFIXES
-
- suffixes => 1000 | 1024 | 1024000 | si_1000 | si_1024 | $arrayref
-
-By default, the used suffixes stand for '', 'K', 'M', ...
-for base 1024 and '', 'k', 'M', ... for base 1000
-(which are indeed the usual metric prefixes with implied unit
-as bytes, 'B'). For the weird 1024000 base, suffixes are
-'', 'M', 'T', etc.
-
-=item ZERO
-
- zero => string | undef
-
-The string C<0> maps to ('0' by default). If C<undef>, the general case is used.
-The string may contain '%S' in which case the suffix for byte is used.
-
- format_bytes(0, zero => '-') => '-'
-
-=item METRIC SYSTEM
-
- si => 1
-
-=item ROUND
-
- round_function => $coderef
- round_style => 'ceil' | 'floor'
-
-=item TO_S
-
-=item QUIET
-
- quiet => 1
-
-Suppresses the warnings emitted. Currently, the only case is
-when the number is large than C<$base**(@suffixes+1)>.
-
-=back
-
-=head2 EXPORT
-
-It is alright to import C<format_bytes>, but nothing is exported by default.
-
-=head1 DIAGNOSTICS
-
- "unknown round style '$style'";
-
- "invalid base: $block (should be 1024, 1000 or 1024000)";
-
- "round function ($args{round_function}) should be a code ref";
-
- "suffixes ($args{suffixes}) should be 1000, 1024, 1024000 or an array ref";
-
- "negative numbers are not allowed" (??)
-
-=head1 TO DO
-
-A function C<parse_bytes>
-
- parse_bytes($str, $options)
-
-which transforms '1k' to 1000, '1K' to 1024, '1MB' to 1E6,
-'1M' to 1024*1024, etc. (like gnu du).
-
- $str =~ /^\s*(\d*\.?\d*)\s*(\S+)/ # $num $suffix
-
-=head1 SEE ALSO
-
-F<lib/human.c> and F<lib/human.h> in GNU coreutils.
-
-The C<_convert()> solution by COG in Filesys::DiskUsage.
-
-=head1 BUGS
-
-Please report bugs via CPAN RT L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Number-Bytes-Human>
-or L<mailto://bug-Number-Bytes-Human@rt.cpan.org>. I will not be able to close the bug
-as BestPractical ignore my claims that I cannot log in, but I will answer anyway.
-
-=head1 AUTHOR
-
-Adriano R. Ferreira, E<lt>ferreira@cpan.orgE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2005-2007 by Adriano R. Ferreira
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
+package Number::Bytes::Human;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.09';
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(format_bytes parse_bytes);
+
+require POSIX;
+use Carp qw(croak carp);
+
+#my $DEFAULT_BLOCK = 1024;
+#my $DEFAULT_ZERO = '0';
+#my $DEFAULT_ROUND_STYLE = 'ceil';
+my %DEFAULT_SUFFIXES = (
+ 1024 => ['', 'K', 'M', 'G', 'T', 'P', 'E', 'Z', 'Y'],
+ 1000 => ['', 'k', 'M', 'G', 'T', 'P', 'E', 'Z', 'Y'],
+ 1024000 => ['', 'M', 'T', 'E', 'Y'],
+ si_1024 => ['B', 'KiB', 'MiB', 'GiB', 'TiB', 'PiB', 'EiB', 'ZiB', 'YiB'],
+ si_1000 => ['B', 'kB', 'MB', 'GB', 'TB', 'PB', 'EB', 'ZB', 'YB'],
+);
+my @DEFAULT_PREFIXES = @{$DEFAULT_SUFFIXES{1024}};
+
+sub _default_suffixes {
+ my $set = shift || 1024;
+ if (exists $DEFAULT_SUFFIXES{$set}) {
+ return @{$DEFAULT_SUFFIXES{$set}} if wantarray;
+ return [ @{$DEFAULT_SUFFIXES{$set}} ];
+ }
+ croak "unknown suffix set '$set'";
+}
+
+my %ROUND_FUNCTIONS = (
+ ceil => sub { return POSIX::ceil($_[0] * (10 ** $_[1])) / 10**$_[1]; },
+ floor => sub { return POSIX::floor($_[0] * (10 ** $_[1])) / 10**$_[1]; },
+ round => sub { return sprintf( "%." . ( $_[1] || 0 ) . "f", $_[0] ); },
+ trunc => sub { return sprintf( "%d", $_[0] * (10 ** $_[1])) / 10**$_[1]; },
+ # what about 'ceiling'?
+);
+
+sub _round_function {
+ my $style = shift;
+ if (exists $ROUND_FUNCTIONS{$style}) {
+ return $ROUND_FUNCTIONS{$style}
+ }
+ croak "unknown round style '$style'";
+}
+
+# options
+# block | block_size | base | bs => 1024 | 1000
+# base_1024 | block_1024 | 1024 => $true
+# base_1000 | block_1000 | 1000 => $true
+#
+# round_function => \&
+# round_style => 'ceiling', 'round', 'floor', 'trunc'
+#
+# suffixes => 1024 | 1000 | si_1024 | si_1000 | 1024000 | \@
+# si => 1
+# unit => string (eg., 'B' | 'bps' | 'b')
+#
+# zero => '0' (default) | '-' | '0%S' | undef
+#
+#
+# supress_point_zero | no_point_zero =>
+# b_to_i => 1
+# to_s => \&
+#
+# allow_minus => 0 | 1
+# too_large => string
+# quiet => 1 (supresses "too large number" warning)
+
+
+
+# PROBABLY CRAP:
+# precision => integer
+
+# parsed options
+# BLOCK => 1024 | 1000
+# ROUND_STYLE => 'ceil', 'round', 'floor', 'trunc'
+# ROUND_FUNCTION => \&
+# SUFFIXES => \@
+# ZERO =>
+# SI => undef | 1 Parse SI compatible
+
+
+=begin private
+
+ $options = _parse_args($seed, $args)
+ $options = _parse_args($seed, arg1 => $val1, ...)
+
+$seed is undef or a hashref
+$args is a hashref
+
+=end private
+
+=cut
+
+sub _parse_args {
+ my $seed = shift;
+ my %args;
+
+ my %options;
+ unless (defined $seed) { # use defaults
+ $options{BLOCK} = 1024;
+ $options{ROUND_STYLE} = 'ceil';
+ $options{ROUND_FUNCTION} = _round_function($options{ROUND_STYLE});
+ $options{ZERO} = '0';
+ $options{SI} = undef;
+ $options{PRECISION} = 1;
+ $options{PRECISION_CUTOFF} = 1;
+ #$options{SUFFIXES} = # deferred to the last minute when we know BLOCK, seek [**]
+ $options{UNIT} = undef;
+ }
+ # else { %options = %$seed } # this is set if @_!=0, down below
+
+ if (@_==0) { # quick return for default values (no customized args)
+ return (defined $seed) ? $seed : \%options;
+ } elsif (@_==1 && ref $_[0]) { # \%args
+ %args = %{$_[0]};
+ } else { # arg1 => $val1, arg2 => $val2
+ %args = @_;
+ }
+
+ # this is done here so this assignment/copy doesn't happen if @_==0
+ %options = %$seed unless %options;
+
+# block | block_size | base | bs => 1024 | 1000
+# block_1024 | base_1024 | 1024 => $true
+# block_1000 | base_1000 | 1024 => $true
+ if ($args{block} ||
+ $args{block_size} ||
+ $args{base} ||
+ $args{bs}
+ ) {
+ my $block = $args{block} ||
+ $args{block_size} ||
+ $args{base} ||
+ $args{bs};
+ unless ($block==1000 || $block==1024 || $block==1_024_000) {
+ croak "invalid base: $block (should be 1024, 1000 or 1024000)";
+ }
+ $options{BLOCK} = $block;
+
+ } elsif ($args{block_1024} ||
+ $args{base_1024} ||
+ $args{1024}) {
+
+ $options{BLOCK} = 1024;
+ } elsif ($args{block_1000} ||
+ $args{base_1000} ||
+ $args{1000}) {
+
+ $options{BLOCK} = 1000;
+ }
+
+# round_function => \&
+# round_style => 'ceil' | 'floor' | 'round' | 'trunc'
+ if ($args{round_function}) {
+ unless (ref $args{round_function} eq 'CODE') {
+ croak "round function ($args{round_function}) should be a code ref";
+ }
+ $options{ROUND_FUNCTION} = $args{round_function};
+ $options{ROUND_STYLE} = $args{round_style} || 'unknown';
+ } elsif ($args{round_style}) {
+ $options{ROUND_FUNCTION} = _round_function($args{round_style});
+ $options{ROUND_STYLE} = $args{round_style};
+ }
+
+# SI compatibility (mostly for parsing)
+ if ($args{si}) {
+ $options{SI} = 1;
+ }
+
+# suffixes => 1024 | 1000 | si_1024 | si_1000 | 1024000 | \@
+ if ($args{suffixes}) {
+ if (ref $args{suffixes} eq 'ARRAY') {
+ $options{SUFFIXES} = $args{suffixes};
+ } elsif ($args{suffixes} =~ /^(si_)?(1000|1024)$/) {
+ $options{SUFFIXES} = _default_suffixes($args{suffixes});
+ } else {
+ croak "suffixes ($args{suffixes}) should be 1024, 1000, si_1024, si_1000, 1024000 or an array ref";
+ }
+ }
+ if (defined $args{unit}) {
+ $options{UNIT} = $args{unit};
+ }
+
+# zero => undef | string
+ if (exists $args{zero}) {
+ $options{ZERO} = $args{zero};
+ if (defined $options{ZERO}) {
+ $options{ZERO} =~ s/%S/$options{SUFFIXES}->[0]/g
+ }
+ }
+
+# precision => <integer>
+ if (exists $args{precision} and $args{precision} =~ /\A\d+\z/) {
+ $options{PRECISION} = $args{precision};
+ }
+
+# precision_cutoff => <intenger>
+ if (exists $args{precision_cutoff} and ($args{precision_cutoff} =~ /\A\d+\z/ or $args{precision_cutoff} = '-1')) {
+ $options{PRECISION_CUTOFF} = $args{precision_cutoff};
+ }
+
+# quiet => 1
+ if ($args{quiet}) {
+ $options{QUIET} = 1;
+ }
+
+ if (defined $seed) {
+ %$seed = %options;
+ return $seed;
+ }
+ return \%options
+}
+
+# NOTE. _format_bytes() SHOULD not change $options - NEVER.
+
+sub _format_bytes {
+ my $bytes = shift;
+ return undef unless defined $bytes;
+ my $options = shift;
+ my %options = %$options;
+
+ local *human_round = $options{ROUND_FUNCTION};
+
+ return $options{ZERO} if ($bytes==0 && defined $options{ZERO});
+
+ my $block = $options{BLOCK};
+
+ # if a suffix set was not specified, pick a default [**]
+ my @suffixes = $options{SUFFIXES} ? @{$options{SUFFIXES}} : _default_suffixes( ($options{SI} ? 'si_' : '') . $block);
+
+ # WHAT ABOUT NEGATIVE NUMBERS: -1K ?
+ my $sign = '';
+ if ($bytes<0) {
+ $bytes = -$bytes;
+ $sign = '-';
+ }
+
+ my $suffix = $suffixes[0];
+ my $x = $bytes;
+ my $magnitude = 0;
+ if($bytes >= $block) {
+ # return "$sign$bytes" if $bytes<$block;
+ do {
+ $x /= $block;
+ $magnitude++;
+ } while ( human_round($x, $options{PRECISION}) >= $block );
+ if($magnitude >= (0 + @suffixes)) {
+ carp "number too large (>= $block**$magnitude)" unless ($options{QUIET});
+ }
+ $suffix = $suffixes[$magnitude];
+ }
+ #$x = human_round( $x, $options{PRECISION} );
+
+ $x = _precision_cutoff($x, $options);
+ #reasses encase the precision_cutoff caused the value to cross the block size
+ if($x >= $block) {
+ $x /= $block;
+ $magnitude++;
+ if($magnitude >= (0 + @suffixes)) {
+ carp "number too large (>= $block**$magnitude)" unless ($options{QUIET});
+ }
+ $suffix = $suffixes[$magnitude];
+ $x = _precision_cutoff($x, $options);
+ }
+
+ my $unit = $options{UNIT} || '';
+
+ return $sign . $x . $suffix . $unit;
+
+}
+
+sub _precision_cutoff {
+ my $bytes = shift;
+ my $options = shift;
+ my %options = %$options;
+ if ( $options{PRECISION_CUTOFF} != -1 and ( length( sprintf( "%d", $bytes ) ) > $options{PRECISION_CUTOFF} ) ) {
+ $bytes = sprintf( "%d", human_round( $bytes, 0 ) );
+ } else {
+ $bytes = sprintf( "%." . $options{PRECISION} . "f", human_round( $bytes, $options{PRECISION} ) );
+ }
+ return $bytes;
+}
+
+sub _parse_bytes {
+ my $human = shift;
+ my $options = shift;
+ my %options = %$options;
+
+ return 0 if( exists $options{ZERO} && ((!defined $options{ZERO} && !defined $human) || (defined $human && $human eq $options{ZERO})) );
+ return undef unless defined $human;
+
+ my %suffix_mult;
+ my %suffix_block;
+ my $m;
+
+ if( $options{SUFFIXES} ) {
+ $m = 1;
+ foreach my $s (@{$options{SUFFIXES}}) {
+ $suffix_mult{$s} = $m;
+ $suffix_block{$s} = $options{BLOCK};
+ $m *= $suffix_block{$s};
+ }
+ } else {
+ if( !defined $options{SI} || $options{SI} == 1 ) {
+ # If SI compatibility has been set BLOCK is ignored as it is infered from the unit
+ $m = 1;
+ foreach my $s (@{$DEFAULT_SUFFIXES{si_1000}}) {
+ $suffix_mult{$s} = $m;
+ $suffix_block{$s} = 1000;
+ $m *= $suffix_block{$s};
+ }
+
+ $m = 1;
+ foreach my $s (@{$DEFAULT_SUFFIXES{si_1024}}) {
+ $suffix_mult{$s} = $m;
+ $suffix_block{$s} = 1024;
+ $m *= $suffix_block{$s};
+ }
+ }
+
+ # The regular suffixes are only taken into account in default mode without specifically asking for SI compliance
+ if( !defined $options{SI} ) {
+ $m = 1;
+ foreach my $s (_default_suffixes( $options{BLOCK} )) {
+ $suffix_mult{$s} = $m;
+ $suffix_block{$s} = $options{BLOCK};
+ $m *= $suffix_block{$s};
+ }
+ }
+ }
+
+ my ($sign, $int, $frac, $unit) = ($human =~ /^\s*(-?)\s*(\d*)(?:\.(\d*))?\s*(\D*)$/);
+
+ $frac ||= 0;
+
+# print STDERR "S: $sign I: $int F: $frac U: $unit\n";
+
+
+ my $mult;
+ my $block;
+ my $u = $options{UNIT} || '';
+ foreach my $s (keys %suffix_block) {
+ if( $unit =~ /^${s}${u}$/i ) {
+ $mult = ($sign eq '-' ? -1 : 1) * $suffix_mult{$s};
+ $block = $suffix_block{$s};
+ last;
+ }
+ }
+
+ if( !defined $mult ) {
+ carp "Could not parse human readable byte value '$human'";
+use Data::Dumper;
+print STDERR Dumper( %suffix_block );
+ return undef;
+ }
+
+ my $bytes = int( ($int + ($frac / $block)) * $mult );
+
+ return $bytes;
+}
+
+
+# convert byte count (file size) to human readable format
+sub format_bytes {
+ my $bytes = shift;
+ my $options = _parse_args(undef, @_);
+ #use YAML; print Dump $options;
+ return _format_bytes($bytes, $options);
+}
+
+# convert human readable format to byte count (file size)
+sub parse_bytes {
+ my $human = shift;
+ my $options = _parse_args(undef, @_);
+ #use YAML; print Dump $options;
+ return _parse_bytes($human, $options);
+}
+
+### the OO way
+
+# new()
+sub new {
+ my $proto = shift;
+ my $class = ref $proto || $proto;
+ my $opts = _parse_args(undef, @_);
+ return bless $opts, $class;
+}
+
+# set_options()
+sub set_options {
+ my $self = shift;
+ return $self->_parse_args(@_);
+}
+
+# format()
+sub format {
+ my $self = shift;
+ my $bytes = shift;
+ return _format_bytes($bytes, $self);
+}
+
+# parse()
+sub parse {
+ my $self = shift;
+ my $human = shift;
+ return _parse_bytes($human, $self);
+}
+
+# the solution by COG in Filesys::DiskUsage
+# convert size to human readable format
+#sub _convert {
+# defined (my $size = shift) || return undef;
+# my $config = {@_};
+# $config->{human} || return $size;
+# my $block = $config->{'Human-readable'} ? 1000 : 1024;
+# my @args = qw/B K M G/;
+#
+# while (@args && $size > $block) {
+# shift @args;
+# $size /= $block;
+# }
+#
+# if ($config->{'truncate-readable'} > 0) {
+# $size = sprintf("%.$config->{'truncate-readable'}f",$size);
+# }
+#
+# "$size$args[0]";
+#}
+#
+# not exact: 1024 => 1024B instead of 1K
+# not nicely formatted => 1.00 instead of 1K
+
+1;
+
+__END__
+
+=head1 NAME
+
+Number::Bytes::Human - Convert byte count to human readable format
+
+=head1 SYNOPSIS
+
+ use Number::Bytes::Human qw(format_bytes parse_bytes);
+ $size = format_bytes(0); # '0'
+ $size = format_bytes(2*1024); # '2.0K'
+
+ $size = format_bytes(1_234_890, bs => 1000); # '1.3M'
+ $size = format_bytes(1E9, bs => 1000); # '1.0G'
+
+ my $bytes = parse_bytes('1.0K'); # 1024
+ my $bytes = parse_bytes('1.0KB'); # 1000, SI unit
+ my $bytes = parse_bytes('1.0KiB'); # 1024, SI unit
+
+ # the OO way
+ $human = Number::Bytes::Human->new(bs => 1000, si => 1);
+ $size = $human->format(1E7); # '10MB'
+
+ $bytes = $human->parse('10MB'); # 10*1000*1000
+ $bytes = $human->parse('10MiB'); # 10*1024*1024
+ $bytes = $human->parse('10M'); # Error, no SI unit
+
+ $human->set_options(zero => '-');
+ $size = $human->format(0); # '-'
+ $bytes = $human->parse('-'); # 0
+
+ $human = Number::Bytes::Human->new(bs => 1000, round_style => 'round', precision => 2);
+ $size = $human->format(10240000); # '10.24MB'
+
+=head1 DESCRIPTION
+
+THIS IS ALPHA SOFTWARE: THE DOCUMENTATION AND THE CODE WILL SUFFER
+CHANGES SOME DAY (THANKS, GOD!).
+
+This module provides a formatter which turns byte counts
+to usual readable format, like '2.0K', '3.1G', '100B'.
+It was inspired in the C<-h> option of Unix
+utilities like C<du>, C<df> and C<ls> for "human-readable" output.
+
+From the FreeBSD man page of C<df>: http://www.freebsd.org/cgi/man.cgi?query=df
+
+ "Human-readable" output. Use unit suffixes: Byte, Kilobyte,
+ Megabyte, Gigabyte, Terabyte and Petabyte in order to reduce the
+ number of digits to four or fewer using base 2 for sizes.
+
+ byte B
+ kilobyte K = 2**10 B = 1024 B
+ megabyte M = 2**20 B = 1024 * 1024 B
+ gigabyte G = 2**30 B = 1024 * 1024 * 1024 B
+ terabyte T = 2**40 B = 1024 * 1024 * 1024 * 1024 B
+
+ petabyte P = 2**50 B = 1024 * 1024 * 1024 * 1024 * 1024 B
+ exabyte E = 2**60 B = 1024 * 1024 * 1024 * 1024 * 1024 * 1024 B
+ zettabyte Z = 2**70 B = 1024 * 1024 * 1024 * 1024 * 1024 * 1024 * 1024 B
+ yottabyte Y = 2**80 B = 1024 * 1024 * 1024 * 1024 * 1024 * 1024 * 1024 * 1024 B
+
+I have found this link to be quite useful:
+
+ http://www.t1shopper.com/tools/calculate/
+
+If you feel like a hard-drive manufacturer, you can start
+counting bytes by powers of 1000 (instead of the generous 1024).
+Just use C<< bs => 1000 >>.
+
+But if you are a floppy disk manufacturer and want to start
+counting in units of 1024000 (for your "1.44 MB" disks)?
+Then use C<< bs => 1_024_000 >>.
+
+If you feel like a purist academic, you can force the use of
+metric prefixes
+according to the Dec 1998 standard by the IEC. Never mind the units for base 1000
+are C<('B', 'kB', 'MB', 'GB', 'TB', 'PB', 'EB', 'ZB', 'YB')> and,
+even worse, the ones for base 1024 are
+C<('B', 'KiB', 'MiB', 'GiB', 'TiB', 'PiB', 'EiB', 'ZiB', 'YiB')>
+with the horrible names: bytes, kibibytes, mebibytes, etc.
+All you have to do is to use C<< si => 1 >>. Ain't that beautiful
+the SI system? Read about it:
+
+ http://physics.nist.gov/cuu/Units/binary.html
+
+You can try a pure Perl C<"ls -lh">-inspired command with the one-liner, er, two-liner:
+
+ $ perl -MNumber::Bytes::Human=format_bytes \
+ -e 'printf "%5s %s\n", format_bytes(-s), $_ for @ARGV' *
+
+Why to write such a module? Because if people can write such things
+in C, it can be written much easier in Perl and then reused,
+refactored, abused. And then, when it is much improved, some
+brave soul can port it back to C (if only for the warm feeling
+of painful programming).
+
+It is also possible to parse human readable formatted bytes. The
+automatic format detection recognizes SI units with the blocksizes
+of 1000 and 1024 respectively and additionally the customary K / M / G etc. with
+blocksize 1024. When si => 1 is added to the options only SI units
+are recognized. Explicitly specifying a blocksize changes it
+for all detected units.
+
+=head2 OBJECTS
+
+An alternative to the functional style of this module
+is the OO fashion. This is useful for avoiding the
+unnecessary parsing of the arguments over and over
+if you have to format lots of numbers
+
+
+ for (@sizes) {
+ my $fmt_size = format_bytes($_, @args);
+ ...
+ }
+
+versus
+
+ my $human = Number::Format::Bytes->new(@args);
+ for (@sizes) {
+ my $fmt_size = $human->format($_);
+ ...
+ }
+
+for TODO
+[TODO] MAKE IT JUST A MATTER OF STYLE: memoize _parse_args()
+$seed == undef
+
+=head2 FUNCTIONS
+
+=over 4
+
+=item B<format_bytes>
+
+ $h_size = format_bytes($size, @options);
+
+Turns a byte count (like 1230) to a readable format like '1.3K'.
+You have a bunch of options to play with. See the section
+L</"OPTIONS"> to know the details.
+
+=item B<parse_bytes>
+
+ $size = parse_bytes($h_size, @options);
+
+Turns a human readable byte count into a number of the equivalent bytes.
+
+=back
+
+=head2 METHODS
+
+=over 4
+
+=item B<new>
+
+ $h = Number::Bytes::Human->new(@options);
+
+The constructor. For details on the arguments, see the section
+L</"OPTIONS">.
+
+=item B<format>
+
+ $h_size = $h->format($size);
+
+Turns a byte count (like 1230) to a readable format like '1.3K'.
+The statements
+
+ $h = Number::Bytes::Human->new(@options);
+ $h_size = $h->format($size);
+
+are equivalent to C<$h_size = format_bytes($size, @options)>,
+with only one pass for the option arguments.
+
+=item B<parse>
+
+ $size = $h->parse($h_size)
+
+Turns a human readable byte count into the number of bytes.
+The statements
+
+ $h = Number::Bytes::Human->new(@options);
+ $size = $h->format($h_size);
+
+are equivalent to C<$size = parse_bytes($h_size, @options)>,
+with only one pass for the option arguments.
+
+=item B<set_options>
+
+ $h->set_options(@options);
+
+To alter the options of a C<Number::Bytes::Human> object.
+See L</"OPTIONS">.
+
+=back
+
+=head2 OPTIONS
+
+=over 4
+
+=item BASE
+
+ block | base | block_size | bs => 1000 | 1024 | 1024000
+ base_1024 | block_1024 | 1024 => 1
+ base_1000 | block_1000 | 1000 => 1
+
+The base to be used: 1024 (default), 1000 or 1024000.
+
+Any other value throws an exception.
+
+=item SUFFIXES
+
+ suffixes => 1000 | 1024 | 1024000 | si_1000 | si_1024 | $arrayref
+
+By default, the used suffixes stand for '', 'K', 'M', ...
+for base 1024 and '', 'k', 'M', ... for base 1000
+(which are indeed the usual metric prefixes with implied unit
+as bytes, 'B'). For the weird 1024000 base, suffixes are
+'', 'M', 'T', etc.
+
+=item ZERO
+
+ zero => string | undef
+
+The string C<0> maps to ('0' by default). If C<undef>, the general case is used.
+The string may contain '%S' in which case the suffix for byte is used.
+
+ format_bytes(0, zero => '-') => '-'
+
+=item METRIC SYSTEM
+
+ si => 1
+
+=item ROUND
+
+ round_function => $coderef
+ round_style => 'ceil' | 'floor' | 'round' | 'trunc'
+
+=item TO_S
+
+=item QUIET
+
+ quiet => 1
+
+Suppresses the warnings emitted. Currently, the only case is
+when the number is large than C<$base**(@suffixes+1)>.
+
+=item PRECISION
+
+ precision => <integer>
+
+default = 1
+sets the precicion of digits, only apropreacte for round_style 'round' or if you
+want to accept it in as the second parameter to your custome round_function.
+
+=item PRECISION_CUTOFF
+
+ precision_cutoff => <integer>
+
+default = 1
+when the number of digits exceeds this number causes the precision to be cutoff
+(was default behaviour in 0.07 and below)
+
+=back
+
+=head2 EXPORT
+
+It is alright to import C<format_bytes> and C<parse_bytes>, but nothing is exported by default.
+
+=head1 DIAGNOSTICS
+
+ "unknown round style '$style'";
+
+ "invalid base: $block (should be 1024, 1000 or 1024000)";
+
+ "round function ($args{round_function}) should be a code ref";
+
+ "suffixes ($args{suffixes}) should be 1000, 1024, 1024000 or an array ref";
+
+ "negative numbers are not allowed" (??)
+
+=head1 TO DO
+
+A function C<parse_bytes>
+
+ parse_bytes($str, $options)
+
+which transforms '1k' to 1000, '1K' to 1024, '1MB' to 1E6,
+'1M' to 1024*1024, etc. (like gnu du).
+
+ $str =~ /^\s*(\d*\.?\d*)\s*(\S+)/ # $num $suffix
+
+=head1 SEE ALSO
+
+F<lib/human.c> and F<lib/human.h> in GNU coreutils.
+
+The C<_convert()> solution by COG in Filesys::DiskUsage.
+
+=head1 BUGS
+
+Please report bugs via CPAN RT L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Number-Bytes-Human>
+or L<mailto://bug-Number-Bytes-Human@rt.cpan.org>. I will not be able to close the bug
+as BestPractical ignore my claims that I cannot log in, but I will answer anyway.
+
+=head1 AUTHOR
+
+Adriano R. Ferreira, E<lt>ferreira@cpan.orgE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2005-2007 by Adriano R. Ferreira
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
@@ -1,22 +1,24 @@
--- #YAML:1.0
-name: Number-Bytes-Human
-version: 0.07
-abstract: Convert byte count to human readable format
-license: perl
-generated_by: ExtUtils::MakeMaker version 6.32
-distribution_type: module
-requires:
- Carp: 0
- POSIX: 0
- Test::More: 0
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.2.html
- version: 1.2
+name: Number-Bytes-Human
+version: 0.09
+abstract: Convert byte count to human readable format
author:
- A. R. Ferreira <ferreira@cpan.org>
-
-recommends:
- Test::Pod: 1.18
- #bignum: 0
-no_index: ~
-installdirs: site
+license: perl
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
+requires:
+ Carp: 0
+ POSIX: 0
+ Test::More: 0
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.55_02
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
@@ -1,4 +1,4 @@
-
+#!/usr/bin/perl
use 5.006;
use ExtUtils::MakeMaker;
@@ -20,7 +20,7 @@ WriteMakefile(
POSIX => 0,
Carp => 0,
Test::More => 0,
- },
+ },
($] >= 5.005 ?
(ABSTRACT_FROM => 'Human.pm', # retrieve abstract from module
AUTHOR => 'A. R. Ferreira <ferreira@cpan.org>',
@@ -1,14 +1,14 @@
-Number::Bytes::Human 0.07
-
-* we need a real README
-* finish docs
-* write parse_bytes
-* include memoizing
-* write a benchmark: unmemoized vs. memoized vs. object
-
-What I update when releasing
-* Human.pm $VERSION
-* README first line
-* META.yml version
-* add new entries to Changes
-
+Number::Bytes::Human 0.09
+
+* we need a real README
+* finish docs
+* include memoizing
+* write a benchmark: unmemoized vs. memoized vs. object
+* add test cases for rounding
+
+What I update when releasing
+* Human.pm $VERSION
+* README first line
+* META.yml version
+* add new entries to Changes
+
@@ -1,13 +1,13 @@
#!perl -T
-use Test::More tests => 27;
+use Test::More tests => 50;
-use_ok('Number::Bytes::Human', 'format_bytes');
+use_ok('Number::Bytes::Human', 'format_bytes', 'parse_bytes');
-our @TESTS = (
+our @TESTS_EXACT = (
'0' => '0',
- '1' => '1',
- '-1' => '-1',
+ '1' => '1.0', #'1', mafoo - with the default being precision 1 with cutoff digits 1
+ '-1' => '-1.0', #'-1', mafoo - with the default being precision 1 with cutoff digits 1
'10' => '10',
'100' => '100',
'400' => '400',
@@ -19,13 +19,10 @@ our @TESTS = (
'1<<10' => '1.0K',
'1023' => '1023',
'1024' => '1.0K',
- '1025' => '1.1K',
'2048' => '2.0K',
'10*1024' => '10K',
- '10*1024+1' => '11K',
'500*1024' => '500K',
'1023*1024' => '1023K',
- '1023*1024+1' => '1.0M',
'1024*1024' => '1.0M',
'2**30' => '1.0G',
'2**80' => '1.0Y',
@@ -33,10 +30,23 @@ our @TESTS = (
#'1025*2**80' => '1025Y', # TODO
);
-is(format_bytes(undef), undef, "undef is undef");
+our @TESTS_ROUND = (
+ '1025' => '1.1K',
+ '10*1024+1' => '11K',
+ '1023*1024+1' => '1.0M',
+);
-while (my ($exp, $expected) = splice @TESTS, 0, 2) {
+# Format tests
+@TESTS_ALL = (@TESTS_EXACT, @TESTS_ROUND);
+is(format_bytes(undef), undef, "undef is undef");
+while (my ($exp, $expected) = splice @TESTS_ALL, 0, 2) {
$num = eval $exp;
is(format_bytes($num), $expected, "$exp is $expected");
}
+# Parse tests
+is(parse_bytes(undef), undef, "undef is undef");
+while (my ($exp, $expected) = splice @TESTS_EXACT, 0, 2) {
+ $num = eval $exp;
+ is(parse_bytes($expected), $num, "parsing $expected should result in $num");
+}
@@ -3,7 +3,7 @@
use Test::More;
if (eval 'require bignum') {
- plan tests => 4;
+ plan tests => 5;
} else {
plan skip_all => 'bignum is not available';
}
@@ -11,12 +11,12 @@ if (eval 'require bignum') {
# this script tests format_bytes() with large (very large) numbers
-use_ok('Number::Bytes::Human', 'format_bytes');
+use_ok('Number::Bytes::Human', 'format_bytes', 'parse_bytes');
our @TESTS = (
'2**80', 2**80, '1.0Y',
- '1023*2**80', 1023*(2**80), '1023Y',
- '1024*2**80', 1024*(2**80), '1024Y' # TODO
+ '1023*(2**80)', 1023*(2**80), '1023Y',
+ #'1024*(2**80)', 1024*(2**80), '1024Y' # should fail number is to large
);
@@ -24,4 +24,5 @@ our @TESTS = (
while (my ($exp, $num, $expected) = splice @TESTS, 0, 3) {
is(format_bytes($num), $expected, "$exp is $expected");
+ is(parse_bytes($expected), $num, "parsing $expected should result in $num");
}
@@ -1,13 +1,13 @@
#!perl -T
-use Test::More tests => 17;
+use Test::More tests => 32;
-use_ok('Number::Bytes::Human', 'format_bytes');
+use_ok('Number::Bytes::Human', 'format_bytes', 'parse_bytes');
-our @TESTS = (
+our @TESTS_EXACT = (
'0' => '0',
- '1' => '1',
- '-1' => '-1',
+ '1' => '1.0', #'1', mafoo - with the default being precision 1 with cutoff digits 1
+ '-1' => '-1.0', #'-1', mafoo - with the default being precision 1 with cutoff digits 1
'10' => '10',
'100' => '100',
'400' => '400',
@@ -15,17 +15,27 @@ our @TESTS = (
'600' => '600',
'900' => '900',
'1000' => '1.0k',
- '1001' => '1.1k',
'2000' => '2.0k',
'10*1000' => '10k',
'500*1000' => '500k',
'1000*1000' => '1.0M',
);
-is(format_bytes(undef), undef, "undef is undef");
+our @TESTS_ROUND = (
+ '1001' => '1.1k',
+);
-while (my ($exp, $expected) = splice @TESTS, 0, 2) {
+# Format tests
+@TESTS_ALL = (@TESTS_EXACT, @TESTS_ROUND);
+is(format_bytes(undef), undef, "undef is undef");
+while (my ($exp, $expected) = splice @TESTS_ALL, 0, 2) {
$num = eval $exp;
is(format_bytes($num, bs => 1000), $expected, "$exp is $expected");
}
+# Parse tests
+is(parse_bytes(undef), undef, "undef is undef");
+while (my ($exp, $expected) = splice @TESTS_EXACT, 0, 2) {
+ $num = eval $exp;
+ is(parse_bytes($expected, bs => 1000), $num, "parsing $expected should result in $num");
+}
@@ -1,8 +1,8 @@
#!perl -T
-use Test::More tests => 6;
+use Test::More tests => 11;
-use_ok('Number::Bytes::Human', 'format_bytes');
+use_ok('Number::Bytes::Human', 'format_bytes', 'parse_bytes');
is(format_bytes(0), '0', "0 turns to '0' by default");
is(format_bytes(0, zero => '-'), '-', "0 turns to '-'");
@@ -10,5 +10,10 @@ is(format_bytes(0, zero => '*'), '*', "0 turns to '*'");
is(format_bytes(0, zero => '0%S', suffixes => [ 'B' ]), '0B', "0 turns to '0B'");
# zero => undef
-is(format_bytes(0, zero => undef, suffixes => [ ' B' ]), '0 B', "0 turns to '0 B'");
+is(format_bytes(0, zero => undef, suffixes => [ ' B' ]), '0.0 B', "0 turns to '0.0 B'"); #'0 B', wrong with the default being precision 1 with cutoff digits 1 and zero being undef
+is(parse_bytes(undef, zero => undef), 0, "undef maps to 0"); # undef maps to 0 if zero is to be recognized as undef
+is(parse_bytes('0'), 0, "0 turns to '0' by default");
+is(parse_bytes('-', zero => '-'), 0, "0 turns to '-'");
+is(parse_bytes('*', zero => '*'), 0, "0 turns to '*'");
+is(parse_bytes('0B', zero => '0%S', suffixes => [ 'B' ]), 0, "0 turns to '0B'");
@@ -1,9 +1,10 @@
#!perl -T
-use Test::More tests => 6;
+use Test::More tests => 20;
-use_ok('Number::Bytes::Human', 'format_bytes');
+use_ok('Number::Bytes::Human', 'format_bytes', 'parse_bytes');
+# Checks for format_bytes
is(format_bytes(0, si => 1), '0', "0 still turns to '0' on SI with base 1024");
is(format_bytes(0, si => 1, bs => 1000), '0', "0 still turns to '0' on SI with base 1000");
@@ -12,4 +13,20 @@ is(format_bytes(10E6, si => 1, bs => 1000), '10MB', "10E6 turns to '10MB' on SI
is(format_bytes(1000, si => 1), '1000B', "1000 turns to '1000B' on SI with base 1024");
+# Checks for parse_bytes
+is(parse_bytes('0'), 0, "'0' still turns to 0");
+is(parse_bytes('0', si => 1), 0, "'0' still turns to 0 with SI only enabled");
+is(parse_bytes('0', si => 1, bs => 1000), 0, "'0' still turns to 0 with SI only enabled and base 1000");
+is(parse_bytes('1.0K'), 1024, "'1.0K' turns to 1024");
+is(parse_bytes('1.0K', bs => 1000), 1000, "'1.0K' turns to 1000 with base 1000");
+is(parse_bytes('1.0kB'), 1000, "'1.0kB' turns to 1000");
+is(parse_bytes('1.0kB', si => 1), 1000, "'1.0kB' turns to 1000 with SI only enabled");
+is(parse_bytes('1.0KiB'), 1024, "'1.0KiB' turns to 1024");
+is(parse_bytes('1.0KiB', si => 1), 1024, "'1.0kB' turns to 1024 with SI only enabled");
+is(parse_bytes('10MB'), 10E6, "10MB turns to 10E6 on SI with base 1000");
+is(parse_bytes('10MB', si => 1), 10E6, "10MB turns to 10E6 on SI");
+is(parse_bytes('10MiB', si => 1), 10*1024*1024, "10MB turns to 10*1024^2 on SI");
+
+is(parse_bytes('1000B'), 1000, "'1000B' turns to 1000");
+is(parse_bytes('1000B', si => 1), 1000, "'1000B' turns to 1000 even when accepting only SI units");
@@ -1,9 +1,15 @@
#!perl -T
-use Test::More tests => 4;
+use Test::More tests => 7;
-use_ok('Number::Bytes::Human', 'format_bytes');
+use_ok('Number::Bytes::Human', 'format_bytes', 'parse_bytes');
+# Checks for format_bytes
is(format_bytes(0, bs => 1000, unit => 'bps'), '0', "0 is still '0'");
is(format_bytes(200, bs => 1000, unit => 'bps'), '200bps', "200 is '200bps'");
-is(format_bytes(2000, bs => 1000, unit => 'bps'), '2.0Kbps', "2000 is '2.0Kbps'");
+is(format_bytes(2000, bs => 1000, unit => 'bps'), '2.0kbps', "2000 is '2.0kbps'");
+
+# Checks for parse_bytes
+is(parse_bytes('0', bs => 1000, unit => 'bps'), 0, "'0' is still 0");
+is(parse_bytes('200bps', bs => 1000, unit => 'bps'), 200, "'200bps' is 200");
+is(parse_bytes('2.0Kbps', bs => 1000, unit => 'bps'), 2000, "'2.0Kbps' is 2000");
@@ -1,13 +1,13 @@
#!perl -T
-use Test::More tests => 14;
+use Test::More tests => 27;
-use_ok('Number::Bytes::Human', 'format_bytes');
+use_ok('Number::Bytes::Human', 'format_bytes', 'parse_bytes');
our @TESTS = (
'0' => '0',
- '1' => '1',
- '-1' => '-1',
+ '1' => '1.0', #'1', wrong with the default being precision 1 with cutoff digits 1
+ '-1' => '-1.0', #'-1', wrong with the default being precision 1 with cutoff digits 1
'10' => '10',
'100' => '100',
'400' => '400',
@@ -16,14 +16,15 @@ our @TESTS = (
'1_000_000' => '1000000',
'1_024_000' => '1.0M',
'1_024_001' => '1.1M',
-# '1.44*1_024_001' => '1.44M', # TODO
+# '1.44*1_024_001' => '1.44M', # TODO - Mafoo, only if you did format_bytes( 1.44 * 1_024_001, bs => 1_024_000, precision => 2, precision_cutoff => -1, round_style => 'round' )
'1_024_000*1_024_000' => '1.0T',
);
is(format_bytes(undef), undef, "undef is undef");
+is(parse_bytes(undef), undef, "undef is undef");
while (my ($exp, $expected) = splice @TESTS, 0, 2) {
$num = eval $exp;
- is(format_bytes($num, bs => 1_024_000), $expected, "$exp is $expected");
+ is(format_bytes($num, bs => 1_024_000), $expected, "$exp is '$expected'");
+ is(parse_bytes($expected, bs => 1_024_000), $num, "'$expected' is $expected");
}
-
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 28;
+use Test::More tests => 30;
# script for testing the internal sub &_parse_args()
@@ -118,11 +118,11 @@ is_deeply(
## OPTION si
is_deeply(
_parse_args({}, { si => 1, bs => 1000 }),
- { BLOCK => 1000, SUFFIXES => [ qw(B kB MB GB TB PB EB ZB YB) ] }, "si => 1, bs => 1000 works");
+ { SI => 1, BLOCK => 1000 }, "si => 1, bs => 1000 works");
is_deeply(
_parse_args({}, { si => 1, bs => 1024 }),
- { BLOCK => 1024, SUFFIXES => [ qw(B KiB MiB GiB TiB PiB EiB ZiB YiB) ] }, "si => 1, bs => 1024 works");
+ { SI => 1, BLOCK => 1024 }, "si => 1, bs => 1024 works");
## option ZERO
@@ -132,6 +132,17 @@ is_deeply(
is_deeply(
_parse_args({ SUFFIXES => [ 'X' ]}, { zero => '0%S' }),
- { ZERO => '0X', SUFFIXES => [ 'X' ] },
+ { ZERO => '0X', SUFFIXES => [ 'X' ] },
"zero => '0%S' works");
+## option PRECISION
+
+is_deeply(
+ _parse_args({}, { precision => '2' }),
+ { PRECISION => '2' }, "precision => '2' works");
+
+## option PRECISION_CUTOFF
+
+is_deeply(
+ _parse_args({}, { precision_cutoff => '-1' }),
+ { PRECISION_CUTOFF => '-1' }, "precision_cutoff => '-1' works");
@@ -1,6 +1,6 @@
#!perl -T
-use Test::More tests => 5;
+use Test::More tests => 7;
use_ok('Number::Bytes::Human');
@@ -10,8 +10,9 @@ my $human = Number::Bytes::Human->new(bs => 1000, si => 1);
isa_ok($human, 'Number::Bytes::Human');
is($human->format(1E7), '10MB');
+is($human->parse('10MB'), 1E7);
is($human->set_options(zero => '-'), $human);
-
is($human->format(0), '-');
+is($human->parse('-'), 0);
diff --git a/var/tmp/source/FERREIRA/Number-Bytes-Human-0.07/Number-Bytes-Human-0.07/t/98pod-coverage.t b/var/tmp/source/DAGOBERT/Number-Bytes-Human-0.09/Number-Bytes-Human-0.09/t/98pod-coverage.t
old mode 100644
new mode 100755