in reply to Re^4: Compact data classes
in thread Compact data classes
Try this. It fixes a potential bug and adds the ability to get greater compression for numeric fields. It needs more testing, diagnostics and documentation, but suck it and see if it satisfies.
#! perl -slw package Class::Struct::Compact2; use strict; use warnings; my $TEMPL_RE = qr[(?:[AaZ]\d*|[cCsSiIlLqQjJfFd][><]?)]; our @export = qw[ new ]; sub new { my( $class, $newClassName, $templ ) = ( shift, shift, shift ); $templ =~ m[^(?:\s*$TEMPL_RE)+\s*$] or die "Invalid template"; my @templs = split ' ', $templ; my @names = @_; die 'The number of templates and names does not match.' unless @te +mpls == @names; my( $n, @sizes, @offsets ) = 0; $sizes[ @sizes ] = $_, $offsets[ @offsets ] = $n, $n += $_ for map + length( pack $_, 0 ), @templs; my $package = <<EON; # line 1 \"sub_New\" package $newClassName; sub new { my \$class = shift; my \$self; if( \@_ == 1 ) { \$self = shift() // ''; } elsif( \@_ == @{[ scalar @templs ]} ) { \$self = pack '$templ', \@_; } return bless \\\$self, \$class } EON for my $field ( 0 .. $#names ) { $package .= <<EOA; # line 1 \"sub_$names[ $field ]\" sub ${newClassName}::${names[ $field ]} { my( \$self, \$newVal ) = \@_; substr( \$\$self, $offsets[ $field ], $sizes[ $field ] ) = pack '$ +templs[ $field ]', \$newVal if defined \$newVal; return unpack '$templs[ $field ]', substr( \$\$self, $offsets[ $fi +eld ], $sizes[ $field ] ); } EOA } # print $package; eval $package; return; } return 1 if caller; package main; use Time::HiRes qw[ time ]; use Devel::Size qw[ total_size ]; use Data::Dump qw[ pp ]; my @chars = ( 'a'..'z' ); sub dummy { my $n = shift; join '', @chars[ map int( rand @chars ), 1 .. $n ]; } my @fieldNames = ( qw[ SPString BString NPString SChar UChar SShort UShort SInt UInt ANInt UNInt SLong ULong SQuad UQuad SPFloat DPFloat NDouble ] ); our $N //= 15_000; our $FIELD //= 'BString'; our $SHOW //= 0; our $CHECK //= 0; Class::Struct::Compact2->new( 'Test', 'A15 a15 Z15 c C s S i I l L j J q Q f F d', @fieldNames ); printf "Class constructed: check mem: "; $CHECK and <>; my @db; push @db, Test->new( map( dummy( 15 ), 1 .. 3 ), map( int( rand 2**$_ ), (7)x2, (15)x2, (31)x6, (63)x2 ), rand() * 1e38, rand() * 1e308, rand() * 1e308 ) for 1 .. $N; printf "Instances created: check mem: "; $CHECK and <>; @db = sort{ $a->$FIELD cmp $b->$FIELD } @db; $SHOW and pp \@db; printf "Instances sorted: check mem: "; $CHECK and <>; print "total size: ", total_size \@db; print "object size:", total_size \$db[0]; my $start = time; for my $o ( 0, $#db ) { my @rec = map $db[ $o ]->$_, @fieldNames; print "@rec"; } printf "Took %15.12f s\n", time() - $start; __END__
With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
In Section
Seekers of Perl Wisdom