| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Algorithm::HyperLogLog; | 
| 2 | 7 |  |  | 7 |  | 908399 | use strict; | 
|  | 7 |  |  |  |  | 17 |  | 
|  | 7 |  |  |  |  | 245 |  | 
| 3 | 7 |  |  | 7 |  | 39 | use warnings; | 
|  | 7 |  |  |  |  | 13 |  | 
|  | 7 |  |  |  |  | 189 |  | 
| 4 | 7 |  |  | 7 |  | 141 | use 5.008008; | 
|  | 7 |  |  |  |  | 37 |  | 
|  | 7 |  |  |  |  | 292 |  | 
| 5 | 7 |  |  | 7 |  | 37 | use Carp qw(croak); | 
|  | 7 |  |  |  |  | 14 |  | 
|  | 7 |  |  |  |  | 11353 |  | 
| 6 |  |  |  |  |  |  |  | 
| 7 |  |  |  |  |  |  | our $VERSION = '0.23'; | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | our $PERL_ONLY; | 
| 10 |  |  |  |  |  |  | if ( !defined $PERL_ONLY ) { | 
| 11 |  |  |  |  |  |  | $PERL_ONLY = $ENV{PERL_HLL_PUREPERL} ? 1 : 0; | 
| 12 |  |  |  |  |  |  | } | 
| 13 |  |  |  |  |  |  |  | 
| 14 |  |  |  |  |  |  | if ( !exists $INC{'Algorithm/HyperLogLog/PP.pm'} ) { | 
| 15 |  |  |  |  |  |  | if ( !$PERL_ONLY ) { | 
| 16 |  |  |  |  |  |  | require XSLoader; | 
| 17 |  |  |  |  |  |  | $PERL_ONLY = !eval { XSLoader::load( __PACKAGE__, $VERSION ); }; | 
| 18 |  |  |  |  |  |  | } | 
| 19 |  |  |  |  |  |  | if ($PERL_ONLY) { | 
| 20 |  |  |  |  |  |  | require 'Algorithm/HyperLogLog/PP.pm'; | 
| 21 |  |  |  |  |  |  | } | 
| 22 |  |  |  |  |  |  | } | 
| 23 |  |  |  |  |  |  |  | 
| 24 |  |  |  |  |  |  | sub new_from_file { | 
| 25 | 4 |  |  | 4 | 1 | 3451 | my ( $class, $filename ) = @_; | 
| 26 | 4 | 50 |  |  |  | 254 | open my $fh, '<', $filename or die $!; | 
| 27 | 4 |  |  | 0 |  | 24 | my $on_error = sub { close $fh; croak "Invalid dump file($filename)"; }; | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 28 |  |  |  |  |  |  |  | 
| 29 | 4 |  |  |  |  | 37 | binmode $fh; | 
| 30 | 4 |  |  |  |  | 9 | my ( @dumpdata, $buf, $readed ); | 
| 31 |  |  |  |  |  |  |  | 
| 32 |  |  |  |  |  |  | # Read register size data | 
| 33 | 4 |  |  |  |  | 111 | $readed = read( $fh, $buf, 1 ); | 
| 34 | 4 | 50 |  |  |  | 16 | $on_error->() if $readed != 1; | 
| 35 | 4 |  |  |  |  | 24 | my $k = unpack 'C', $buf; | 
| 36 |  |  |  |  |  |  |  | 
| 37 |  |  |  |  |  |  | # Read register content data | 
| 38 | 4 |  |  |  |  | 11 | my $m = 2**$k; | 
| 39 | 4 |  |  |  |  | 382 | $readed = read $fh, $buf, $m; | 
| 40 | 4 | 50 |  |  |  | 16 | $on_error->() if $readed != $m; | 
| 41 | 4 |  |  |  |  | 65 | close $fh; | 
| 42 | 4 |  |  |  |  | 23184 | @dumpdata = unpack 'C*', $buf; | 
| 43 | 4 |  |  |  |  | 5097 | my $self = $class->_new_from_dump( $k, \@dumpdata ); | 
| 44 | 4 |  |  |  |  | 1749 | return $self; | 
| 45 |  |  |  |  |  |  | } | 
| 46 |  |  |  |  |  |  |  | 
| 47 |  |  |  |  |  |  | sub dump_to_file { | 
| 48 | 4 |  |  | 4 | 1 | 10435 | my ( $self, $filename ) = @_; | 
| 49 | 4 |  |  |  |  | 37 | my $k        = log( $self->register_size ) / log(2);    # Calculate log2(register_size) | 
| 50 | 4 |  |  |  |  | 6941 | my $dumpdata = $self->_dump_register(); | 
| 51 | 4 | 50 |  |  |  | 381 | open my $fh, '>', $filename or die $!; | 
| 52 | 4 |  |  |  |  | 15 | binmode $fh; | 
| 53 | 4 |  |  |  |  | 27 | my $buf = pack 'C', $k; | 
| 54 | 4 |  |  |  |  | 81 | print $fh $buf; | 
| 55 | 4 |  |  |  |  | 12922 | $buf = pack 'C*', @$dumpdata; | 
| 56 | 4 |  |  |  |  | 789 | print $fh $buf; | 
| 57 | 4 |  |  |  |  | 1373 | close $fh; | 
| 58 |  |  |  |  |  |  | } | 
| 59 |  |  |  |  |  |  |  | 
| 60 |  |  |  |  |  |  | sub XS { | 
| 61 | 4 |  |  | 4 | 1 | 1155 | !$PERL_ONLY; | 
| 62 |  |  |  |  |  |  | } | 
| 63 |  |  |  |  |  |  |  | 
| 64 |  |  |  |  |  |  | 1; | 
| 65 |  |  |  |  |  |  | __END__ |