Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Re^5: Compact data classes

by BrowserUk (Pope)
on Jun 23, 2013 at 05:38 UTC ( #1040313=note: print w/ replies, xml ) Need Help??


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.


Comment on Re^5: Compact data classes
Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1040313]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (2)
As of 2014-09-22 03:48 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (178 votes), past polls