view release on metacpan or  search on metacpan

lib/Ambrosia/core/Object.pm  view on Meta::CPAN

package Ambrosia::core::Object;
use strict;
use warnings;
use Carp;
use integer;

use XML::LibXML();
use Data::Serializer;

use overload '%{}' => \&__get_hash, fallback => 1;

use Ambrosia::error::Exceptions;
use Ambrosia::core::Nil;
use Ambrosia::Assert;

our $VERSION = 0.010;

unless ( $::__AMBROSIA_ACCESS_ALLOW )
{
    *__get_hash = sub {
        $_[0]->[1] ||= {};
        return $_[0]->[1] if $::__AMBROSIA_ACCESS_ALLOW;
        my $pkg = caller(0);

        my $self = shift;

        if ( $pkg eq ref $self || $self->isa($pkg) )
        {
            return $self->[1];
        }
        else
        {
            throw Ambrosia::error::Exception::AccessDenied("Access denied for $pkg in $self (@_); caller0: " . join ';', grep {$_} caller(0) );
        }
    };
}
else
{
    *__get_hash = sub { return $_[0]->[1] ||= {}; };
}

### constructor ###
sub new
{
    my $proto = shift;
    my $class = ref($proto) || $proto;

    if ($class->__AMBROSIA_IS_ABSTRACT__)
    {
        throw Ambrosia::error::Exception 'You cannot instance abstract class ' . $class;
    }

    my $self = bless [[]], $class;
    $self->_init(@_);
    return $self;
}

sub fields
{
    return ();
}

### run from new ###
sub _init
{
    my $self = shift;

    return $self unless scalar @_;
    my %params = @_ == 1 ? %{$_[0]} : @_;

    foreach ( keys %params )
    {
        if ( eval {$self->can($_)} )
        {
            $self->$_ = $params{$_};
        }
        else
        {
            croak 'Not found property ' . $_ . ' in ' . ref($self);
        }
    }

    return $self;
}

sub value
{
    my $self = shift;

    my %FLDS; @FLDS{$self->fields} = ();

    my @res = map { $self->$_ } @_ ? (grep {exists $FLDS{$_} || throw Ambrosia::error::Exception::AccessDenied 'value: access denied - ' . $_} @_) : $self->fields;
    return wantarray ? @res : \@res;
}

sub string_dump
{
    return Data::Serializer->new(serializer => 'Storable', compress => 1)->serialize($_[0]);
}

sub string_restore
{
    my $dump = shift;
    return new Ambrosia::core::Nil unless $dump;

    my $obj = Data::Serializer->new(serializer => 'Storable')->deserialize($dump);

    reflection( sub {
            if ( my $refObj = ref $_[0] )
            {
                Ambrosia::core::ClassFactory::load_class($refObj)
            }
        }, $obj );