Ambrosia

 view release on metacpan or  search on metacpan

lib/Ambrosia/Assert.pm  view on Meta::CPAN

our %ASSERT = ();

sub import
{
    my $package = shift;
    return if eval{$package->can('assert')};

    assign(shift) if @_;

    no strict 'refs';
    my $package_instance = caller(0);
    if ( debug_mode($PROCESS_MAP{$$}, @_) )
    {
        *{"${package_instance}::assert"} = sub(&$) { goto &__assert; };
    }
    else
    {
        *{"${package_instance}::assert"} = sub(&$) {};
    }

}

lib/Ambrosia/DataProvider/DBIDriver.pm  view on Meta::CPAN

    $self->_cache = new Ambrosia::core::Nil();
    if ( defined $self->_handler )
    {
        eval
        {
            $self->_handler->{AutoCommit} or $self->_handler->rollback or die $self->_handler->errstr;
        };
        if ( $@ )
        {
            throw Ambrosia::error::Exception 'ERROR: at ' . __PACKAGE__ . ' in ' . caller() . ' [' . $@ . ']';
        }
    }
    return $self;
}

#!!TODO!! must return hash (cannot save "additional_action")
sub STORABLE_freeze
{
    my ($self, $cloning) = @_;
    return if $cloning;         # Regular default serialization

lib/Ambrosia/EntityDataModel.pm  view on Meta::CPAN

    else
    {
        my $id = shift();
        if ( defined $id )
        {
            return $proto . '_' . join '_', (ref $id ? @$id : $id);
        }
        else
        {
            die 'Bad usage get_cache_code: ' . $proto . '; '
                . join('; ', caller(0), "\n")
                . join('; ', caller(1), "\n")
                . join('; ', caller(2), "\n");
        }
    }
}

sub after_load
{
    @_;
}

sub list

lib/Ambrosia/Event.pm  view on Meta::CPAN

our $VERSION = 0.010;

sub import
{
    no strict 'refs';
    no warnings 'redefine';

    my $proto = shift;
    throw Ambrosia::error::Exception("'$proto' cannot inherit from sealed class '" . __PACKAGE__ . '\'.') if $proto ne __PACKAGE__;

    my $INSTANCE_CLASS = caller(0);

    foreach my $e ( @_ ) #@events )
    {
        *{"${INSTANCE_CLASS}::$e"} = sub()
        {
            #my $pack = ref $_[0];
            #$pack =~ s/::/_/sg;
            #attachHandler($pack . '_' . $e, $_[1]);
            attachHandler($_[0], $e, $_[1]);
            $_[0];

lib/Ambrosia/Logger.pm  view on Meta::CPAN

sub __debug
{
    my ($self, @msg) = @_;
    my $p = __PACKAGE__;
    my $x = 0;
    my ($package, $line, $subroutine);
    my @callers;
 
    while ( do { package DB; ($package, $line, $subroutine) = (caller($x++))[0, 2, 3] } )
    {
        my @arg = $subroutine !~ /^$p\:\:/ ? @DB::args : ('...');
        unshift @callers, "\t$subroutine"
            . ( $subroutine ne '(eval)' ? ('( '.(join ", ", @arg).' )'):'')
            . ' At ' . $package
            . ' line ' . $line;
    }
    push @msg, "\nstack frames = [\n", (join "\n", @callers), "\n]";
    $self->log_info_ex(@msg);
}

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

        inheritable => &__INHERITABLE,
    );

sub import
{
    my $proto = shift;

    assert {$proto eq __PACKAGE__} "'$proto' cannot be inherited from sealed class '" . __PACKAGE__ . '\'.';
    #throw Ambrosia::error::Exception("'$proto' cannot be inherited from sealed class '" . __PACKAGE__ . '\'.') if $proto ne __PACKAGE__;

    my $INSTANCE_CLASS = caller(0);
    unless ( eval { $INSTANCE_CLASS->isa('Ambrosia::core::Object') } )
    {
        @{$INSTANCE_CLASS . '::ISA'} = ();
        my $ISA = \@{$INSTANCE_CLASS . '::ISA'};
        unshift @$ISA, 'Ambrosia::core::Object';
    }

    $proto->export_to_level(1, $proto, @EXPORT);
}

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

        delete $params->{package};
        unless ( eval { $INSTANCE_CLASS->isa('Ambrosia::core::Object') } )
        {
            @{$INSTANCE_CLASS . '::ISA'} = ();
            my $ISA = \@{$INSTANCE_CLASS . '::ISA'};
            unshift @$ISA, 'Ambrosia::core::Object';
        }
    }
    else
    {
        $INSTANCE_CLASS = caller(0);
    }

    my $alias = {};
    if ( defined $params->{alias} )
    {
        $alias = $params->{alias};
        delete $params->{alias};
    }

    return if ${"$INSTANCE_CLASS\::__AMBROSIA_INSTANCE__"};

lib/Ambrosia/Utils/Container.pm  view on Meta::CPAN

    goto &__as_any;
    #unless ( exists $_[0]->{bool} )
    #{
    #    $_[0]->{bool} = '' . $_[0]->{code}->();
    #}
    #return $_[0]->{bool};
}

sub __as_string
{
#warn join ' ', grep $_, caller(0);
#warn join ' ', grep $_, caller(1);
#warn join ' ', grep $_, caller(2);
#warn join ' ', grep $_, caller(3);
#warn join ' ', grep $_, caller(4);
#warn join ' ', grep $_, caller(5);

    goto &__as_any;
    #unless ( exists $_[0]->{string} )
    #{
    #    $_[0]->{string} = '' . $_[0]->{code}->();
    #}
    #return $_[0]->{string};
}

sub __as_number

lib/Ambrosia/Utils/Enumeration.pm  view on Meta::CPAN

{
    my $proto = shift;

    my $style = shift or return; #property or flag
    my $field_name = shift;
    my %states_name = @_;

    assert {$proto eq __PACKAGE__} "'$proto' cannot be inherited from sealed class '" . __PACKAGE__ . '\'.';
    #throw Ambrosia::error::Exception("'$proto' cannot be inherited from sealed class '" . __PACKAGE__ . '\'.') if $proto ne __PACKAGE__;

    my $INSTANCE_CLASS = caller(0);

    if ( $style eq 'property' )
    {
        foreach my $f ( keys %states_name )
        {
            *{"${INSTANCE_CLASS}::SET_$f"} = sub() {
                    local $::__AMBROSIA_ACCESS_ALLOW = 1;
                    $_[0]->{$field_name} = $states_name{$f};
                    return $_[0];
                };

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

        return $obj;
    }
    croak 'Cannot create the object of ' . $package;
    return new Ambrosia::core::Nil;
}

sub load_class
{
    my $package = shift;

    assert {defined $package} 'Cannot load class without the package. Caller: ' . caller(0);

    eval
    {
        unless ( eval {$package->VERSION} )
        {
            if ( eval qq{require $package;} )
            {
                eval {$package->import};
            }
            else

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

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

lib/Ambrosia/error/Exception/Error.pm  view on Meta::CPAN

}

# Формирует стек вызова
sub _addFrames
{
    my $self = shift;
    my $p = __PACKAGE__;
    my $x = 0;
    my ($package, $line, $subroutine);
    
    while ( do { package DB; ($package, $line, $subroutine) = (caller($x++))[0, 2, 3] } )
    {# Do the quickest ones first.
        next if $package eq __PACKAGE__ or substr($subroutine, 0, 33) eq __PACKAGE__;
        my @arg = $subroutine !~ /^$p\:\:/ ? @DB::args : ('...');
        push @{ $self->{_frames} }, { 'callers' => [$line, $subroutine, $package], 'argums' => \@arg };
    }
}

sub frames
{
    my $self = shift;

lib/Ambrosia/error/Exception/Error.pm  view on Meta::CPAN

    return $msg;
}

sub stack
{
    return join("\n", reverse @{$_[0]->frames()}) . "\n";
}

sub as_string
{
#warn caller(0);
    my $self = shift;
    return $self->message() . "\n" . $self->stack();
}

sub code
{
    return $_[0]->{_error_code};
}

1;