Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Re: Binary data structure to moose class.

by tobyink (Abbot)
on Jan 02, 2013 at 16:07 UTC ( #1011298=note: print w/ replies, xml ) Need Help??


in reply to Binary data structure to moose class.

One of the core ideas behind Moose is that of metaprogramming. That is; don't write programs - write programs which write programs.

For example, rather than defining our attributes the old-fashioned way, like:

sub some_attribute { my $self = shift; $self->{some_attribute} = shift if @_; return $self->{some_attribute}; }

We just write:

has some_attribute => (is => 'rw');

The has function is a "program which writes programs". It makes our sub some_attribute for us!

So the solution is to write something that does the same sort of job as has, but has some domain-specific knowledge about grabbing raw data, unpacking it, etc. Here's an example (untested):

{ package Binary::Humax::HmtData; use DateTime; use Moose; has raw_data_block => ( is => 'rw', isa => 'Str', required => 1, ); # Shortcut function for defining attributes # sub _my_has { my ($name, %spec) = @_; my $meta = __PACKAGE__->meta; # Default attribute to 'rw' $spec{is} //= 'rw'; # Set up lazy builder if (my $unpack = delete $spec{unpack}) { $spec{lazy} //= 1; $spec{builder} //= "_build_$name"; if (my $postprocess = delete $spec{postprocess}) { $meta->add_method($spec{builder}, sub { my $self = shift; local $_ = unpack($unpack, $self->raw_data_block); $postprocess->(); }); } else { $meta->add_method($spec{builder}, sub { my $self = shift; return unpack($unpack, $self->raw_data_block); }); } } $meta->add_attribute($name, \%spec); } # Now use that shortcut to define each attribute. # _my_has last_play => (isa => 'Int', unpack => '@5 S'); _my_has chan_num => (isa => 'Int', unpack => '@17 S'); _my_has start_time => ( isa => 'DateTime', unpack => '@5 S', postprocess => sub { DateTime->from_epoch(epoch => $_, time_zone => 'GMT'); }, ); _my_has file_name => (isa => 'Str', unpack => '@33 A512'); # Create an alternative constructor which wraps "new". # sub new_from_file { my ($class, $filename) = @_; open my $fh, '>', $filename; my $slurp = do { local $/ = <$fh> }; return $class->new(r); } } # # USAGE # my $hmt_data = Binary::Humax::HmtData->new_from_file($path_name); my $field = $hmt_data->start_time;

"Secondly, when complete, I plan to upload the module to CPAN. Have I chosen a good name for it, or should it live in a different name space?"

No, it seems like a bad name. You're putting it in "Binary" because it's a binary file format. But presumably end users of your module won't care whether it's a binary file format, a text-based one, or XML-based; they don't care about the file format at all, because they've downloaded your module to abstract those sort of details away, haven't they?

I would have thought something in the "TV" namespace more fitting.

UPDATE:; we can go even "more meta" by replacing our has workalike with an attribute trait. This has the advantage of allowing introspection of each attribute to read back its "unpack" code.

{ package Binary::Humax::HmtData::Trait::Attribute; use Moose::Role; has unpack => (is => 'ro', isa => 'Str'); has postprocess => (is => 'ro', isa => 'CodeRef'); before _process_options => sub { my ($meta, $name, $spec) = @_; if ($spec->{unpack}) { $spec->{lazy} //= 1; $spec->{builder} //= "_build_$name"; $spec->{is} //= 'rw'; } }; after attach_to_class => sub { my $attr = shift; my $class = $attr->associated_class; my $unpack = $attr->unpack or return; if (my $postprocess = $attr->postprocess) { $class->add_method($attr->builder, sub { my $self = shift; local $_ = unpack($unpack, $self->raw_data_block); $postprocess->(); }); } else { $class->add_method($attr->builder, sub { my $self = shift; return unpack($unpack, $self->raw_data_block); }); } }; } { package Binary::Humax::HmtData; use DateTime; use Moose; use constant MAGIC => 'Binary::Humax::HmtData::Trait::Attribute'; has raw_data_block => ( is => 'rw', isa => 'Str', required => 1, ); has last_play => ( traits => [ MAGIC ], isa => 'Int', unpack => '@5 S', ); has chan_num => ( traits => [ MAGIC ], isa => 'Int', unpack => '@17 S', ); has start_time => ( traits => [ MAGIC ], isa => 'DateTime', unpack => '@5 S', postprocess => sub { DateTime->from_epoch(epoch => $_, time_zone => 'GMT'); }, ); has file_name => ( traits => [ MAGIC ], isa => 'Str', unpack => '@33 A512', ); } # Attribute introspection print Binary::Humax::HmtData->meta->get_attribute('start_time')->unpac +k, "\n";

The slight ugliness with this method is that the attribute trait has some knowledge of the class it's being applied to - it knows that the class has a raw_data_block attribute. With a little more work that problem could be eliminated.

perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'


Comment on Re: Binary data structure to moose class.
Select or Download Code
Replies are listed 'Best First'.
Re^2: Binary data structure to moose class.
by tobyink (Abbot) on Jan 02, 2013 at 21:05 UTC

    OK, here's a massively generalized version of the above:

    use 5.010; use strict; use warnings; BEGIN { package Trait::Attribute::Derived; no thanks; use MooseX::Role::Parameterized; use List::MoreUtils 'any'; use namespace::autoclean; use base do { package Trait::Attribute::Derived::__CLASS_METHODS__; use Sub::Install 'install_sub'; use namespace::autoclean; my @saved; sub make_trait { my ($pkg, %args) = @_; push @saved, $pkg->meta->generate_role(parameters => \%arg +s); return $saved[-1]->name; } sub import { my $pkg = shift; my $caller = caller; while (@_) { my $name = shift; my $trait = $pkg->make_trait(%{+shift}); install_sub { into => $caller, as => $name, code => sub () { $trait }, } } } __PACKAGE__; }; parameter processor => (is => 'ro', required => 1, isa => 'Code +Ref'); parameter fields => (is => 'ro', required => 1, isa => 'Hash +Ref'); parameter is => (is => 'ro', default => 'ro', isa => 'Str' +); parameter source => (is => 'ro', required => 1, isa => 'Str' +); role { my $p = shift; my @fields = keys %{ $p->fields }; has postprocessor => (is => 'ro', isa => 'CodeRef'); for my $attr (@fields) { has $attr => (is => 'ro', isa => $p->fields->{$attr}); } before _process_options => sub { my ($meta, $name, $spec) = @_; $spec->{is} //= $p->is; $spec->{lazy} //= 1; $spec->{builder} //= "_build_$name"; }; after attach_to_class => sub { my $attr = shift; my $class = $attr->associated_class; return if $class->has_method($attr->builder); my $source = $p->source; my $processor = $p->processor; my $postprocess = $attr->postprocessor; my %data = map { ; $_ => $attr->$_ } @fields; $class->add_method($attr->builder, sub { my $self = shift; local %_ = %data; local $_ = $self->$source; $_ = $self->$processor($_, +{%data}); return $_ unless $postprocess; return $self->$postprocess($_, +{%data}); }); }; }; }; { package Person; use Moose; use Trait::Attribute::Derived Split => { source => 'full_name', fields => { segment => 'Num' }, processor => sub { (split)[$_{segment}] }, }; has full_name => (is => 'ro', isa => 'Str'); has first_name => (traits => [Split], segment => +0); has initial => (traits => [Split], segment => +0, postprocessor + => sub { substr $_, 0, 1 }); has last_name => (traits => [Split], segment => -1); } my $bob = Person->new(full_name => 'Robert Redford'); say $bob->first_name; say $bob->initial; say $bob->last_name;

    If you can understand that and how to apply it to your problem, then you're a true metahacker! :-)

    Update: this is now on CPAN as Trait::Attribute::Derived.

    perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'
Re^2: Binary data structure to moose class.
by chrestomanci (Priest) on Jan 04, 2013 at 18:14 UTC

    Thank you tobyink, that looks like the solution I was looking for, especialy the second code example you posted. though it will take a bit of experementaion to understand how it works.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (18)
As of 2015-07-29 12:53 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (263 votes), past polls