package Venus::Role::Serializable; use 5.018; use strict; use warnings; use Venus::Role 'with'; # METHODS sub serialize { my ($self) = @_; if ( Scalar::Util::blessed($self) && $self->isa('Venus::Core') && $self->can('DOES') && $self->DOES('Venus::Role::Valuable')) { return deconstruct($self, $self->value); } if (UNIVERSAL::isa($self, 'ARRAY')) { return deconstruct($self, [@{$self}]); } if (UNIVERSAL::isa($self, 'CODE')) { return sub{goto \&$self}; } if (UNIVERSAL::isa($self, 'HASH')) { return deconstruct($self, {%{$self}}); } if (UNIVERSAL::isa($self, 'REF')) { return deconstruct($self, ${$self}); } if (UNIVERSAL::isa($self, 'REGEXP')) { return qr/$self/; } if (UNIVERSAL::isa($self, 'SCALAR')) { return deconstruct($self, ${$self}); } require Venus::Throw; my $throw = Venus::Throw->new(join('::', map ucfirst, ref($self), 'error')); $throw->name('on.serialize'); $throw->message("Can't serialize the object: $self"); $throw->stash(self => $self); $throw->error; } sub deconstruct { my ($self, $value) = @_; require Scalar::Util; if ( Scalar::Util::blessed($value) && $value->isa('Venus::Core') && $value->can('DOES') && $value->DOES('Venus::Role::Serializable')) { return $value->serialize; } if (UNIVERSAL::isa($value, 'CODE')) { return sub{goto \&$value}; } if (UNIVERSAL::isa($value, 'REF')) { return deconstruct($self, ${$value}); } if (UNIVERSAL::isa($value, 'REGEXP')) { return qr/$value/; } if (UNIVERSAL::isa($value, 'SCALAR')) { return deconstruct($self, ${$value}); } if (UNIVERSAL::isa($value, 'HASH')) { my $result = {}; for my $key (keys %{$value}) { $result->{$key} = deconstruct($self, $value->{$key}); } return $result; } if (UNIVERSAL::isa($value, 'ARRAY')) { my $result = []; for my $key (keys @{$value}) { $result->[$key] = deconstruct($self, $value->[$key]); } return $result; } if (Scalar::Util::blessed($value)) { require Venus::Throw; my $throw = Venus::Throw->new(join('::', map ucfirst, ref($self), 'error')); $throw->name('on.serialize.deconstruct'); $throw->message("Can't serialize properties in the object: $self"); $throw->stash(self => $self); $throw->error; } return $value; } # EXPORTS sub EXPORT { ['serialize'] } 1; =head1 NAME Venus::Role::Serializable - Serializable Role =cut =head1 ABSTRACT Serializable Role for Perl 5 =cut =head1 SYNOPSIS package Example; use Venus::Class; with 'Venus::Role::Serializable'; attr 'test'; package main; my $example = Example->new(test => 123); # $example->serialize; # {test => 123} =cut =head1 DESCRIPTION This package provides a mechanism for serializing objects or the return value of a dispatched method call. =cut =head1 METHODS This package provides the following methods: =cut =head2 serialize serialize(Str | CodeRef $code, Any @args) (Any) The serialize method serializes the invocant or the return value of a dispatched method call, and returns the result. I> =over 4 =item serialize example 1 package Example1; use Venus::Class 'with'; with 'Venus::Role::Serializable'; sub ARGS { (@_[1..$#_]) } sub DATA { [@_[1..$#_]] } package main; my $example1 = Example1->new(1..4); # bless([1..4], 'Example1') # my $result = $example1->serialize; # [1..4] =back =over 4 =item serialize example 2 package Example2; use Venus::Class 'with'; with 'Venus::Role::Serializable'; sub ARGS { (@_[1..$#_]) } sub DATA { sub{[@_[1..$#_]]} } package main; my $example2 = Example2->new(1..4); # bless(sub{[1..4]}, 'Example2') # my $result = $example2->serialize; # sub{...} =back =over 4 =item serialize example 3 package Example3; use Venus::Class 'with'; with 'Venus::Role::Serializable'; sub ARGS { (@_[1..$#_]) } sub DATA { qr{@{[join '', @_[1..$#_]]}}; } package main; my $example3 = Example3->new(1..4); # bless(qr/1234/, 'Example3') # my $result = $example3->serialize; # qr/1234/u =back =over 4 =item serialize example 4 package Example4; use Venus::Class 'with'; with 'Venus::Role::Serializable'; sub ARGS { (@_[1..$#_]) } sub DATA { \join '', @_[1..$#_] } package main; my $example4 = Example4->new(1..4); # bless(\'1234', 'Example4') # my $result = $example4->serialize; # "1234" =back =over 4 =item serialize example 5 package Example5; use Venus::Class 'with'; with 'Venus::Role::Serializable'; sub ARGS { (@_[1..$#_]) } sub DATA { \(my $ref = \join '', @_[1..$#_]) } package main; my $example5 = Example5->new(1..4); # bless(do{\(my $ref = \'1234')}, 'Example5') # my $result = $example5->serialize; # "1234" =back =over 4 =item serialize example 6 package Example6; use Venus::Class 'base'; base 'Venus::Array'; package main; my $example6 = Example6->new([1..4]); # bless(..., 'Example6') # my $result = $example6->serialize; # [1..4] =back =over 4 =item serialize example 7 package Example7; use Venus::Class 'base'; base 'Venus::Path'; package main; my $example7 = Example7->new('/path/to/somewhere'); # bless(..., 'Example7') # my $result = $example7->serialize; # "/path/to/somewhere" =back =over 4 =item serialize example 8 package Example8; use Venus::Class 'with'; with 'Venus::Role::Serializable'; with 'Venus::Role::Valuable'; package main; my $example8 = Example8->new(value => 123); # bless(..., 'Example8') # my $result = $example8->serialize; # 123 =back =over 4 =item serialize example 9 package Example9; use Venus::Class 'base', 'with'; base 'IO::Handle'; with 'Venus::Role::Serializable'; package main; my $example9 = Example9->new; # bless(..., 'Example9') # my $result = $example9->serialize; # Exception! (isa Venus::Error) is "on.serialize" =back =over 4 =item serialize example 10 package Example10; use Venus::Class 'attr', 'with'; with 'Venus::Role::Serializable'; attr 'test'; package main; use IO::Handle; my $example10 = Example10->new(test => IO::Handle->new); # bless(..., 'Example10') # my $result = $example10->serialize; # Exception! (isa Venus::Error) is "on.serialize.deconstruct" =back =cut