File Coverage

blib/lib/Venus/Role/Serializable.pm

Criterion	Covered	Total	%
statement	67	73	91.7
branch	25	30	83.3
condition	8	18	44.4
subroutine	8	9	88.8
pod	1	3	33.3
total	109	133	81.9

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

=head1 AUTHORS

Awncorp, C

=cut

=head1 LICENSE

Copyright (C) 2000, Al Newkirk.

This program is free software, you can redistribute it and/or modify it under
the terms of the Apache license version 2.0.

=cut