package DeWeave::WBO;{
use Moose;
use namespace::autoclean;
use MooseX::Types::Moose qw(Int Str Num);
use JSON::Any;
use Try::Tiny;
use Log::Log4perl ':easy';
use Data::Dump 'pp';
has id => (
isa => Str,
required => 1,
is => 'ro',
);
has modified => (
isa => Num,
required => 1,
is => 'ro',
);
has sortindex => (
isa => Num,
required => 0,
is => 'ro',
);
has payload => (
traits => ['WBOInternal'],
isa => Str,
required => 1,
is => 'ro',
);
has ttl => (
isa => Int,
required => 0,
is => 'ro',
);
sub _debug_data {
my ($self,$msg,$data) = @_;
local $Log::Log4perl::caller_depth = $Log::Log4perl::caller_depth+1;
my %data_clean;my @keys_clean = grep {!/^_/} keys %$data;
@data_clean{@keys_clean} = @$data{@keys_clean};
DEBUG $msg, {
filter => \&pp,
value => \%data_clean,
};
}
sub from_json {
my ($class,$json,$crypt)=@_;
my $j = JSON::Any->new;
my $args = $j->decode($json);
$class->_debug_data('$args ',$args);
if (defined $args->{payload}) {
$args->{__crypt}=$crypt;
}
return $class->new($args);
}
around BUILDARGS => sub {
my $orig = shift;
my $class = shift;
my $args = $class->$orig(@_);
return $args unless defined $args->{payload};
my $j = JSON::Any->new;
my $extra_args = $j->decode($args->{payload});
@$args{keys %$extra_args} =
values %$extra_args;
delete @$args{grep {!defined $args->{$_}} keys %$args};
$class->_debug_data('buildargs: ',$args);
return $args;
};
sub as_string {
my ($self) = @_;
my $meta = $self->meta;
my $str = '';
for my $attribute ( $meta->get_all_attributes ) {
next if $attribute->does('DeWeave::WBO::Meta::Attribute::Internal');
next unless $attribute->has_value($self);
my $reader = $attribute->get_read_method;
$str .= sprintf "%s -> %s\n",
$attribute->name,
pp ($self->$reader);
}
return $str;
}
}
package DeWeave::WBO::Meta::Attribute::Internal;{
use Moose::Role;
}
package Moose::Meta::Attribute::Custom::Trait::WBOInternal;{
sub register_implementation { 'DeWeave::WBO::Meta::Attribute::Internal' }
}
1;
