Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??

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 reply to Re^5: Compact data classes by BrowserUk
in thread Compact data classes by creeble

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others studying the Monastery: (9)
    As of 2014-09-15 04:44 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      My favorite cookbook is:










      Results (145 votes), past polls