Ambrosia

 view release on metacpan or  search on metacpan

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

        sub instance
        {
            my $package = shift;
            my $key = shift;
            return $ACCESSOR{$key} ||= $package->new(@_);
        }
    
        sub accessor
        {
            no warnings;
            return __PACKAGE__->instance($PROCESS_MAP{$$} || throw Ambrosia::error::Exception::BadUsage("First access to Ambrosia::Addons::Accessor without assign to access."), @_);
        }
    }

    sub authenticate
    {
        my $self = shift;
        my $login = shift;
        my $passwd = shift;
        my $level = shift;

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

    $PROCESS_MAP{$$} = shift;
}

sub debug_mode
{
    my $key = shift or return 0;
    my $mode = shift;

    unless(defined $ASSERT{$key})
    {
        throw Ambrosia::error::Exception::BadParams 'First usage Ambrosia::Assert without initialize.' unless defined $mode;
        $ASSERT{$key} = lc($mode) eq 'debug';
    }
    return $ASSERT{$key};
}

1;

#########
# MUST WRITE IN MAIN
#########

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

sub create_object
{
    my $manager_info = controller->__last_manager = shift;

    if ( my $m = $manager_info->{manager} )
    {
        return Ambrosia::core::ClassFactory::create_object($m);
    }
    else
    {
        throw Ambrosia::error::Exception "Manager not defined.";
    }
}

sub _addEWM
{
    my $self  = shift;
    my $level = shift;
    my $msg   = shift;

    return undef unless $msg;

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

    __PACKAGE__->export_to_level(1, @EXPORT);
}

sub assign
{
    $PROCESS_MAP{$$} = shift;
}

sub new
{
    throw Ambrosia::error::Exception::BadUsage 'Cannot create object Config';
}

sub instance
{
    my $package = shift;
    my $key = shift;
    my $_config_data = shift;

    if ( $_config_data )
    {#start instance

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

        {
            $CONFIGS{$key}->{CONFIG_HASH} = 1; #$_config_data;
        }
        elsif(!ref $_config_data)
        {
            $CONFIGS{$key}->{CONFIG_FILE} = $_config_data;
            $CONFIGS{$key}->{LAST_ACCESS} = (stat $_config_data )[9];
        }
        else
        {
            throw Ambrosia::error::BadParams 'Bad config params: ' . $_config_data;
        }
    }
    elsif ( $CONFIGS{$key}->{CONFIG_FILE} )
    {#Если конфиг сформирован и дата последней модификации файла не менялась вернем объект config
        my $last_access = (stat $CONFIGS{$key}->{CONFIG_FILE} )[9];

        return $CONFIGS{$key}->{OBJECT}
            if  defined $CONFIGS{$key}->{OBJECT}
                && defined $CONFIGS{$key}->{LAST_ACCESS}
                && $CONFIGS{$key}->{LAST_ACCESS} == $last_access;

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

    $package =~ s|[\\\/]|::|g;

    $CONFIGS{$key}->{OBJECT} = $_config_data
        ? _create($package, $_config_data)
        : _error($package, $key);
    return $CONFIGS{$key}->{OBJECT};
}

sub config
{
    my $c = __PACKAGE__->instance(shift || $PROCESS_MAP{$$} || throw Ambrosia::error::Exception::BadUsage("First access to Ambrosia::Config without assign to config."));
    return $c;
}

sub _error
{
    my $package = shift;
    my $key = shift;

    my $ConfDump = '{';
    foreach ( keys %CONFIGS )
    {
        $ConfDump .= "\t$_ => $CONFIGS{$_}\n";
    }
    $ConfDump .= '}';

    warn "ErrorInConfig($$):\n\t\%CONFIGS=$ConfDump;\n\t" . ' %PROCESS_MAP=' . Dumper(\%PROCESS_MAP);
    throw Ambrosia::error::Exception::BadUsage("First access to Ambrosia::Config without create config object. [$package :: $key]")
}

sub _create
{
    my $package = shift;
    my $prm = shift;

    my $self;
    eval
    {

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

        {
            no strict 'refs';
            no warnings 'redefine';
            Ambrosia::core::ClassFactory::create($package, {public => [keys %$conf]});
            *{"$package\::DESTROY"} = sub {};
            ${"$package\::AUTOLOAD"} = '';
            *{"$package\::AUTOLOAD"} = sub : lvalue {
                my $this = shift;
                my $value = shift;
                my ($func) = our $AUTOLOAD =~ /(\w+)$/
                    or throw Ambrosia::error::Exception 'Error: cannot resolve AUTOLOAD: ' . $AUTOLOAD;
                *{$package . '::' . $func} = sub : lvalue { $_[0]->[1]->{$func} };
                $this->$func = $value;
            };

            $self = $package->new($conf);
        }
        elsif($conf)
        {
            die 'Bad config format in ' . $prm . '. Config file must return reference to hash.';
        }
    };
    if ( $@ )
    {
        throw Ambrosia::error::Exception('Error in config: ' . $prm . ';', $@);
    }
    return $self;
}

sub DESTROY
{
    
}

1;

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

{
    my $_CONTEXT;

    sub instance
    {
        unless ( $_CONTEXT )
        {
            my $package = shift;
            my %params = @_ == 1 ? %{$_[0]} : @_;
            assert {$params{engine_name}} 'Context must instance before first call "Context" or you not set "engine_name" in params.';
            #throw Ambrosia::error::Exception::BadUsage('Context must instance before first call "Context"') unless $params{engine_name};

            my ($engine_name,$engine_params) = @params{qw/engine_name engine_params/};
            delete @params{qw/engine_name engine_params/};
            my $cgi = Ambrosia::core::ClassFactory::create_object(
                    'Ambrosia::CommonGatewayInterface::' . $engine_name, $engine_params);

            $_CONTEXT = $package->SUPER::new(__cgi => $cgi, %params);
        }
        return $_CONTEXT;
    }

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

    if ( $self->method eq 'GET' || $self->method eq 'HEAD' )
    {
        return (defined $self->resource_id ? '/get/' : '/list/') . $self->resource_type
    }
    elsif ( $self->method eq 'POST' || $self->method eq 'DELETE' )
    {
        return '/save/' . $self->resource_type;
    }
    else
    {
        throw Ambrosia::error::Exception::BadUsage 'Unknown http method: "' . ($self->method || 'undefined' ) . '"';
    }
}

sub init_request_params
{
    my $self = shift;
    my $scriptName = $ENV{SCRIPT_NAME} or return;
    my $uri = $ENV{REQUEST_URI};
    $uri =~ s/^$scriptName//;

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

{
    my $self = shift;

    $self->close_connection;

    $self->_handler = DBI->connect (
            $self->_connection_params(),
            $self->user, $self->password,
            ($self->additional_params || {})
        )
        or throw Ambrosia::core::Exception(DBI->errstr);

    if ( defined $self->additional_action && ref $self->additional_action eq 'CODE' )
    {
        $self->additional_action->($self->_handler);
    }
    $self->begin_transaction();
    return $self->_handler;
}

sub close_connection

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/DataProvider/DBIDriver.pm  view on Meta::CPAN

            $self->__sth = $self->handler()->prepare_cached($sql);
            $self->__sth->execute(@_);
        }
        else
        {
            die (ref($self) . ': cannot create SQL.');
        }
    };
    if ( $@ )
    {
        throw Ambrosia::error::Exception 'Error: query=' . $sql . "\n\t[@_]\n"
            . ($self->_handler ? $self->_handler->errstr : '');
    }
}

sub next
{
    my $self = shift;

    unless ( $self->__sth )
    {

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

    return $res;
}


1;

__END__

=head1 NAME

Ambrosia::DataProvider::DBIDriver - an abstract class that realize L<Ambrosia::DataProvider::BaseDriver> and provide connection to data bases throw DBI.

=head1 VERSION

version 0.010

=head1 DESCRIPTION

C<Ambrosia::DataProvider::DBIDriver> is an abstract class that realize L<Ambrosia::DataProvider::BaseDriver> and provide connection to data bases throw DBI.

For more information see:

=over

=item L<Ambrosia::DataProvider::Engine::DB::mysql>

=item L<Ambrosia::DataProvider::Engine::DB::pg>

=back

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

            },
        ]
    };

    instance Ambrosia::Storage(application_name => $confDS);
    Ambrosia::DataProvider::assign 'application_name';


=head1 DESCRIPTION

C<Ambrosia::DataProvider::DBIDriver> is a class realize Ambrosia::DataProvider::BaseDriver and provide connection to data bases throw DBI.

For more information see:

=over

=item L<Ambrosia::DataProvider::Engine::Resource::Hash>

=back

=head1 SUBROUTINES/METHODS

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

{
    no strict 'refs';
    my $proto = shift;
    my %params = @_;
    my $type = $params{type};

    my $pk = $params{from};

    my $yeld = $params{optional}
        ? sub {new Ambrosia::core::Nil}
        : sub {throw Ambrosia::error::Exception shift};

    if ( $type->primary_key && $type->primary_key eq $params{to} )
    {
        *{$proto . '::' . $params{name}} = sub() {
                my $self = shift;

                return ($self->$pk ? $type->load($self->$pk) : undef)
                    || $yeld->('Wrong relationship for ' . $type . ': ' . $pk . '=' . $self->$pk);
            };
    }

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

}

sub link_one2many
{
    no strict 'refs';
    my $proto = shift;
    my %params = @_;

    my $yeld = $params{optional}
        ? sub {new Ambrosia::core::Nil}
        : sub {throw Ambrosia::error::Exception shift};

    my @key = ref $params{to} ? @{$params{to}} : $params{to};
    my @val = ref $params{from} ? @{$params{from}} : $params{from};
    my $condition = sub {shift(), shift()};
    while( my $k = shift(@key) )
    {
        my $v = shift(@val);
        my $old = $condition;
        $condition = sub { my $self = shift; my $q = shift; $old->($self, $q)->predicate($k, '=', $self->$v); return $q; }
    }

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]);

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

    if ( $self->{_dir} )
    {
        mkpath($self->{_dir}, 0, oct(777)) unless -d $self->{_dir};
        # Name of logfile is YYYYMMDD.log, where YYYYMMDD - is current date.
        $self->{_logname} = sprintf("%s/%s%04d%02d%02d.log", $self->{_dir}, $self->{_prefix}, $year + 1900, $mon + 1, $mday);
        $self->{_log} = new IO::File;
        $self->{_log}->autoflush(1);
        unless ($self->{_log}->open(">>$self->{_logname}"))
        {
            throw Ambrosia::error::Exception::BadParams 'Cannot open logfile: ' . $self->{_logname} . "[ $! ]";
        }
    }
    else
    {
        $self->{_log} = \*STDERR;
    }

    $LOGGERS{$key}->{date}->{$year . ' ' . $mon . ' ' . $mday} = 1;

    return $self;

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

        abstract    => &__ABSTRACT,
        sealed      => &__SEALED,
        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

    {
        next unless exists $params->{$inheritable};

        foreach my $package ( @{$params->{$inheritable}} )
        {
            unless ( eval {$package->VERSION} )
            {
                if ( eval qq{require $package;} )
                {
                    eval {$package->import; 1;}
                    or throw Ambrosia::error::Exception 'Cannot import ' . $package . ': ', $@;
                    if ( (${"$package\::__AMBROSIA_INSTANCE__"} || -42) == &__SEALED )
                    {
                        throw Ambrosia::error::Exception $INSTANCE_CLASS . ' cannot be inherited from sealed class ' . $package;
                    }
                }
                else
                {
                    throw Ambrosia::error::Exception 'Cannot require ' . $package . ': ', $@;
                }
            }
            unshift @$ISA, $package;

            foreach my $f ( keys %{"$package\::__AMBROSIA_INTERNAL_FLDS__"} )
            {
                $__PARENT__{$f} = !exists $__PARENT__{$f} ? $package : throw Ambrosia::error::Exception "Duplicate field $f for $package that exists one of a base class.";
            }
            push @PUB_FLDS, $package->fields if eval { $package->can('fields') };
        }
        delete $params->{$inheritable};
    }

    ############################################################################
    #create property for class
    my @__FRIENDS__;
    if (exists $params->{friends})
    {
        @__FRIENDS__ = @{$params->{friends}};
        delete $params->{friends};
    }

    my $pos = 0;
    foreach ( keys %$params )
    {
        my $access = $FIELDS_ACCESS{$_} or throw Ambrosia::error::Exception "Unknown keyword: $_.";
        foreach my $fn ( @{$params->{$_}} )
        {
            throw Ambrosia::error::Exception "Duplicate field $fn for $INSTANCE_CLASS that exists in one of a base class."
                if exists $__PARENT__{$fn};

            my $f = defined $alias->{$fn} ? $alias->{$fn} : $fn;

            if ( __PUBLIC == $access )
            {
                if ( $clsType == &__SEALED )
                {
                    my $p = $pos;
                    *{"${INSTANCE_CLASS}::$f"} = sub() : lvalue {

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

                push @PUB_FLDS, $fn;
                $__FIELDS__->{$fn} = __PUBLIC;
            }
            elsif ( __PROTECTED == $access )
            {
                *{"${INSTANCE_CLASS}::$f"} = sub() : lvalue {
#may be used assert????
                    my $_caller = caller;
                    unless ( $INSTANCE_CLASS eq $_caller || $_caller eq 'Ambrosia::core::Object' || eval{$_[0]->isa($_caller)} )
                    {
                        throw Ambrosia::error::Exception::AccessDenied "Access denied for $_caller. ${INSTANCE_CLASS}::$f() is a protected field of $INSTANCE_CLASS!"
                            unless ( grep { $_caller eq $_ }  @__FRIENDS__ );
                            #unless ( $_caller ~~ @__FRIENDS__ );
                    }
                    $_[0]->[1]->{$fn};
                };
                $__FIELDS__->{$fn} = __PROTECTED;
            }
            elsif ( __PRIVATE == $access )
            {
                if ( $clsType == &__SEALED )
                {
                    my $p = $pos;
                    *{"${INSTANCE_CLASS}::$f"} = sub() : lvalue {
                        my $_caller = caller;
                        unless ( $_caller eq $INSTANCE_CLASS || $_caller eq 'Ambrosia::core::Object' )
                        {
                            throw Ambrosia::error::Exception::AccessDenied "Access denied for $_caller. ${INSTANCE_CLASS}::$f() is a private field of $INSTANCE_CLASS!"
                                unless ( grep { $_caller eq $_ }  @__FRIENDS__ );
                                #unless ( $_caller ~~ @__FRIENDS__ );
                        }
                        $_[0]->[0]->[$p];
                    };
                }
                else
                {
                    *{"${INSTANCE_CLASS}::$f"} = sub() : lvalue {
                        my $_caller = caller;
                        unless ( $_caller eq $INSTANCE_CLASS || $_caller eq 'Ambrosia::core::Object' )
                        {
                            throw Ambrosia::error::Exception::AccessDenied "Access denied for $_caller. ${INSTANCE_CLASS}::$f() is a private field of $INSTANCE_CLASS!"
                                unless ( grep { $_caller eq $_ }  @__FRIENDS__ );
                                #unless ( $_caller ~~ @__FRIENDS__ );
                        }
                        $_[0]->[1]->{$fn};
                    };
                }
                $__FIELDS__->{$fn} = __PRIVATE;
            }
            $pos++;
        }

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

{
    my($class, $package, $symbol, $referent) = @_;
    no warnings 'redefine';
    *{$symbol} = sub {
            if (caller eq $package)
            {
                goto &$referent;
            }
            else
            {
                throw Ambrosia::error::Exception $package . '::' . *{$symbol}{NAME} . ': access denied for ' . ref $_[0];
            }
        };
}

sub Override
{
    my($class, $package, $symbol, $referent) = @_;
    no warnings 'redefine';
    *{$symbol} = sub {
            goto &$referent;
        };
}

sub Abstract
{
    my($class, $package, $symbol, $referent) = @_;
    no warnings 'redefine';
    ${$class.'::__AMBROSIA_INSTANCE__'} = &__ABSTRACT;
    *{$symbol} = sub {
            throw Ambrosia::error::Exception *{$symbol}{NAME} . ' is abstract method.';
        };
}

sub Protected
{
    my($class, $package, $symbol, $referent) = @_;
    no warnings 'redefine';
    *{$symbol} = sub {
            my $caller = caller;
            if (eval{$caller->isa($package)})
            {
                goto &$referent;
            }
            else
            {
                throw Ambrosia::error::Exception $package . '::' . *{$symbol}{NAME} . ': access denied for ' . $caller;
            }
        };
}

sub Public
{
}

sub Static
{

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

    my $self = shift;
    my $driver = shift;

    if ( eval { $driver->isa('Ambrosia::DataProvider::BaseDriver') }  )
    {
        $self->driver = $driver;
        $self->driver->reset()->source($self->source);
    }
    else
    {
        throw Ambrosia::error::Exception 'QL: bad driver: ' . $driver;
    }

    return $self;
}

sub what
{
    my $self = shift;
    $self->driver->what(@_);
    return $self;

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

                }
            }
            $RPC{$key} = $package->new(_list => \%list);
        }

        return $RPC{$key};
    }

    sub rpc
    {
        return __PACKAGE__->instance(shift || $PROCESS_MAP{$$} || throw Ambrosia::error::Exception::BadUsage("First access to Ambrosia::RPC without assign to RPC."));
    }

    sub destroy
    {
        %RPC = ();
    }
}

sub service #(serviceType, name)
{

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

    return CORE::ref $self->__as_any();
}

sub AUTOLOAD
{
    my $self = shift;
    my @param = @_;

    my $type = CORE::ref($self) or return;
    my ($func) = our $AUTOLOAD =~ /(\w+)$/
        or throw Ambrosia::error::Exception 'Error: cannot resolve AUTOLOAD: ' . $AUTOLOAD;
warn "AUTOLOAD: $func\n";
    my $p = $self->__as_any;

    if( CORE::ref($p) && eval {$p->can($func)} )
    {
        return $p->$func(@param );
    }
    else
    {
        throw Ambrosia::error::Exception 'Error: cannot resolve: ' . $AUTOLOAD;
    }
}

sub DESTROY
{
    #warn "DESTROY: @_\n";
}

1;
#so you can get acquainted with this code

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

sub import
{
    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};

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

sub check_file_name
{
    my $fileName = shift;

    if ( $fileName =~ /^([\/\w.]+)$/ )
    {
        $fileName = $1;
        if ( $fileName =~ /\.\./ )
        {
            throw Ambrosia::core::Exception('Bad filename (you cannot use relative path): [' . $fileName . ']');
        }
    }
    else
    {
        throw Ambrosia::core::Exception('Bad filename: [' . $fileName . ']');
    }
    return $fileName;
}

sub pare_list
{
    my @l1 = ref $_[0] ? @{shift()} : shift;
    my @l2 = ref $_[0] ? @{shift()} : shift;

    return wantarray

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

    return (map { @{$self->__data->{$_}->errorMessage} } keys %{$self->__data});
}

sub AUTOLOAD
{
    my $self = shift;
    my @param = @_;

    my $type = ref($self) or return;
    my ($func) = our $AUTOLOAD =~ /(\w+)$/
        or throw Ambrosia::error::Exception 'Error: cannot resolve AUTOLOAD: ' . $AUTOLOAD;

    my $p = $self->__data;

    my $val = undef;
    if ( exists $p->{$func} && scalar @param == 0 )
    {
        $val = $p->{$func}->value;
    }
    elsif( !exists $p->{$func} && eval {$self->prototype->can($func)} )
    {
        $val = $self->prototype->$func($self, @param );
    }
    elsif ( scalar @param > 0 )
    {
        throw Ambrosia::error::Exception 'Error: cannot assign new value for violation object ' . $self->prototype;
    }

    return $val;
}

sub DESTROY
{
    #warn "DESTROY: @_\n";
}

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

            }
            else
            {
                $node->setAttribute($p, $value);
            }
        }
    };
    if ( $@ )
    {
        carp("$@");
        throw Ambrosia::error::Exception 'error while converter to XML', $@ unless $ignore;
    }
    return ($document, $node);
}


1;

__END__

=head1 NAME

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

    eval
    {
        $fields->{package} = $package;
        Ambrosia::Meta::class($type, $fields);
        no strict 'refs';
        ${$package.'::VERSION'} = 0.001;
    };
    if ( $@ )
    {
        throw Ambrosia::error::Exception 'Error in ClassFactory: ' . $@;
    }
}

sub create_object
{
    my $package = shift;

    my $obj = undef;
    eval
    {

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

            }
            else
            {
                croak 'Cannot require ' . $package . ': ' . $@;
            }
        }
        $obj = $package->new( @_ ) if $can_new || ($is_load && eval {$package->can('new')});
    };
    if ( $@ )
    {
        throw Ambrosia::error::Exception 'Error in ClassFactory: ' . $@;
    }
    elsif( $obj )
    {
        return $obj;
    }
    croak 'Cannot create the object of ' . $package;
    return new Ambrosia::core::Nil;
}

sub load_class

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

                eval {$package->import};
            }
            else
            {
                croak 'Cannot require: ' . $package . '; err: ' . $@;
            }
        }
    };
    if ( $@ )
    {
        throw Ambrosia::error::Exception 'Error in ClassFactory: ' . $@;
    }
    return $package;
}

1;

__END__

=head1 NAME

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

        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 ();

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

    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
{

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

                        return $v->as_hash($ignore, $p);
                    }
                    else
                    {
                        return $v;
                    }
                }, $self->$m(@P) );
        };
        if ( $@ )
        {
            throw Ambrosia::error::Exception $@ unless $ignore;
        };
    }
    return $hash;
}

sub copy_to
{
    my $self = shift;
    my $dest = shift;
    throw Ambrosia::error::Exception("Cannot copy $self to $dest.") unless ref $self eq ref $dest;
    foreach my $f ( $self->fields )
    {
        $dest->$f = $self->$f;
    }
}

sub clone
{
    no strict 'refs';
    my $self = shift;

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

                    else
                    {
                        #die "cannot clone $v";
                        return $v;
                    }
                }, $self->$fn );
            };
            if ( $@ )
            {
                croak "$@\n";
                throw Ambrosia::error::Exception "FOR $fn CANNOT CLONE " . $self->$fn . ' :(', $@;
            }
        }
    }
    else
    {
        foreach my $f ( @__FIELDS__ )
        {
            $obj->$f = $self->$f;
        }
    }

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

                
            }
            else
            {
                $m = $_;
            }
            $node->addChild($_) foreach as_xml_nodes($document, $node, $a||$m, $self->$m(@P));
        };
        if ( $@ )
        {
            throw Ambrosia::error::Exception $@ unless $params{error_ignore};
        };
    }

    if ( $params{need_node} )
    {
        return $node;
    }
    else
    {
        $document->setDocumentElement($node);

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

package Ambrosia::error::Exception::Error;
use strict;
use warnings;

use overload '""' => \&as_string, fallback => 1;

our $VERSION = 0.010;

sub PREF() { '    ' };

sub throw
{
    my $class = shift;
    my $error_code = shift;
    my @msg = @_;

    unless ( $error_code =~ /^E\d+/ )
    {
        unshift @msg, $error_code;
        $error_code = 'E0000';
    }

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

version 0.010

=head1 DESCRIPTION

   Ambrosia::error::Exception::Error is a base class for Exceptions. See L<Ambrosia::error::Exceptions>.

=cut

=head1 CONSTRUCTOR

=head2 throw ($message1, $message2, ...)

The constructor that generate exception.

=cut

=head1 METHODS

=head2 message

Returns message about an exception.

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

our $VERSION = 0.010;
1;

######################################################################
package Ambrosia::error::Exception;
use base qw/Ambrosia::error::Exception::Error/;
our $VERSION = 0.010;

sub CODE() {'E0000'}

sub throw
{
    return shift->SUPER::throw(CODE, @_);
}

######################################################################
package Ambrosia::error::Exception::BadUsage;
use base qw/Ambrosia::error::Exception::Error/;
our $VERSION = 0.010;

sub CODE() {'E0001'}

sub throw
{
    return shift->SUPER::throw(CODE, @_);
}

######################################################################
package Ambrosia::error::Exception::BadParams;
use base qw/Ambrosia::error::Exception::Error/;
our $VERSION = 0.010;

sub CODE() {'E0002'}

sub throw
{
    return shift->SUPER::throw(CODE, @_);
}

######################################################################
package Ambrosia::error::Exception::AccessDenied;
use base qw/Ambrosia::error::Exception::Error/;
our $VERSION = 0.010;

sub CODE() {'E0003'}

sub throw
{
    return shift->SUPER::throw(CODE, @_);
}

1;

__END__

=head1 NAME

Ambrosia::error::Exception - an unspecified exception.
Ambrosia::error::Exception::BadUsage - this exception will occur if you use something incorrect.

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

Ambrosia::error::Exception::AccessDenied - this exception will occur if you try run closed method.

=head1 SYNOPSIS

    use Ambrosia::error::Exceptions;

    sub test
    {
        unless ( @_ )
        {
            throw Ambrosia::error::Exception::BadParams("Must call test with arguments.");
        }
    }

    eval
    {
        test();
    };
    if ( $@ )
    {
        if ( ref $@ && $@->isa('Ambrosia::error::Exception::Error') )
        {
            print "ERROR: " . $@->message . "\n";
            print "STACK:\n" . $@->stack . "\n";
            print "CODE: " . $@->code . "\n";

            #printed:
            #ERROR: Must call test with arguments.
            #ERROR: Must call test with arguments.
            #STACK:
            #    Ambrosia::error::Exception::BadParams::throw( Ambrosia::error::Exception::BadParams, Must call test with arguments. ) at main line ...
            #    main::test(  ) at main line ...
            #    (eval) at main line ...
            #CODE: E0002

            #ERROR: Must call test with arguments.
            #STACK:
            #    Ambrosia::error::Exception::BadParams::throw( Ambrosia::error::Exception::BadParams, Must call test with arguments. ) at main line ...
            #    main::test(  ) at main line ...
            #    (eval) at main line ...
        }
        #or you can do so:
        print "ERROR: $@";

        #printed:
        #ERROR: Must call test with arguments.
        #    Ambrosia::error::Exception::BadParams::throw( Ambrosia::error::Exception::BadParams, Must call test with arguments. ) at main line ...
        #    main::test(  ) at main line ...
        #    (eval) at main line ...
    }

=cut

=head1 DESCRIPTION

List of different types of exceptions.
Ambrosia::error::Exception - an unspecified exception.

share/Managers/buildXml.pm  view on Meta::CPAN

sub getDataSource
{
    my $t = shift;
    my $sn = shift;
    if ( ref config->data_source->{$t} eq 'ARRAY' )
    {
        foreach ( @{config->data_source->{$t}} )
        {
            return $_ if $_->{source_name} eq $sn;
        }
        throw Ambrosia::error::Exception::BadParams "Error: cannot find in config data_source source_name=$sn in type = $t";
    }
    elsif( config->data_source->{$t}->{source_name} eq $sn )
    {
        return config->data_source->{$t};
    }
    else
    {
        throw Ambrosia::error::Exception::BadParams "Error: cannot find in config data_source source_name=$sn in type = $t";
    }
}

sub processDataSource
{
    my $driver = shift;
    my $type = shift;
    my $source_name = shift;
    my $self = shift;

t/Ambrosia/Config.t  view on Meta::CPAN

Ambrosia::Config::assign 'test';

cmp_ok(config->param1, '==', 123, 'config(test)->param1 is ok'); #test #5
cmp_deeply(config->param2, [1,2,3], 'config(test)->param2 is ok'); #test #6

my $v = config->param3 = 456;
cmp_ok(config->param3, '==', 456, 'add param to config is ok'); #test #7
cmp_ok($v, '==', 456, 'return adding value to param is ok'); #test #8

throws_ok { new Ambrosia::Config( test_throws => { param1 => 1 } ); } 'Ambrosia::error::Exception::BadUsage', 'Ambrosia::error::Exception::BadUsage exception thrown'; #test #9

t/Ambrosia/Event.t  view on Meta::CPAN

    $foo->on_run(sub {$foo->foo=1; return 1;});
    $foo->run();
    ok($foo->foo == 1, 'fire event'); #test #2

    $foo->on_run(sub {$foo->foo+=1; return 1;});
    $foo->run();
    ok($foo->foo == 2, 'fire event with ignore previos'); #test #3

    $foo->on_run(sub {$foo->foo=3; return 0;});
    $foo->run();
    ok($foo->foo == 4, 'fire event throw chain previos'); #test #4

    my $abort = 0;
    Ambrosia::Event::attachHandler('','on_abort', sub {$abort=123});
    $foo->abort();
    ok($abort == 123, 'global event');
}

t/Ambrosia/core/Object.t  view on Meta::CPAN

use t::Bar;

#test create the object
my $my_foo = new_ok t::Foo => [foo_pub1 => 1, foo_pro1 => 2, foo_pri1 => 3]; #test #5

#test access to fields of the object
cmp_ok($my_foo->foo_pub1, '==', 1, 'Public field of Foo.'); #test #6
$my_foo->foo_pub1 = 321;
cmp_ok($my_foo->foo_pub1, '==', 321, 'Public field of Foo.'); #test #7

throws_ok { $my_foo->foo_pro1 } 'Ambrosia::error::Exception::AccessDenied', 'Ambrosia::error::Exception::AccessDenied to protected fields exception thrown'; #test #8
throws_ok { $my_foo->foo_pri1 } 'Ambrosia::error::Exception::AccessDenied', 'Ambrosia::error::Exception::AccessDenied to private fields exception thrown'; #test #9

#test methods of the object
#test static methods
my $H = {foo_pub1 => 1, foo_pub2 => 1, bar_pub1 => 1, bar_pub2 => 1};

my $my_bar = new_ok t::Bar => []; #test #11

cmp_deeply({map {$_ => 1} $my_bar->fields()}, $H, 'fields() is ok'); #test #12

my $string_dump = $my_bar->string_dump();

t/Ambrosia/error/Exception.t  view on Meta::CPAN

use Test::More tests => 15;
use lib qw(lib t ..);

BEGIN
{
    use_ok( 'Ambrosia::error::Exceptions' ); #test #1
}

sub err1
{
    throw Ambrosia::error::Exception 'error in "err1()"';
}

sub err2
{
    eval
    {
        err1(1,2,3);
    };
    if ( $@ )
    {
        ok($@->message() eq 'error in "err1()"', 'ok 1');
        throw Ambrosia::error::Exception 'error in "err2()"', $@;
    }
}

sub err3
{
    eval
    {
        err2(4,5,6);
    };
    if ( $@ )
    {
        ok($@->message() =~ m/error in "err2\(\)"/s, 'ok 2');
        throw Ambrosia::error::Exception 'error in "err3()"', $@;
    }
}

eval
{
    err3(7,8,9);
};
if ( $@ )
{
    ok($@->message() =~ m/error in "err3\(\)"/s, 'ok 3');

t/Ambrosia/error/Exception.t  view on Meta::CPAN

    ok($stack =~ m/err1\( 1, 2, 3 \)/s, 'stack ok 1');
    ok($stack =~ m/err2\( 4, 5, 6 \)/s, 'stack ok 2');
    ok($stack =~ m/err3\( 7, 8, 9 \)/s, 'stack ok 3');

    #print "ERROR:\n$stack\n";
}

#### Exception ####
eval
{
    throw Ambrosia::error::Exception('Exception');
};
if ( $@ )
{
    ok($@->code() eq Ambrosia::error::Exception::CODE(), 'Exception');
    ok($@->message() eq 'Exception', 'Exception');
}

#### BadUsage ####
eval
{
    throw Ambrosia::error::Exception::BadUsage('BadUsage');
};
if ( $@ )
{
    ok($@->code() eq Ambrosia::error::Exception::BadUsage::CODE(), 'BadUsage');
    ok($@->message() eq 'BadUsage', 'BadUsage');
}

#### BadParams ####
eval
{
    throw Ambrosia::error::Exception::BadParams('BadParams');
};
if ( $@ )
{
    ok($@->code() eq Ambrosia::error::Exception::BadParams::CODE(), 'BadParams');
    ok($@->message() eq 'BadParams', 'BadParams');
}

#### AccessDenied ####
eval
{
    throw Ambrosia::error::Exception::AccessDenied('AccessDenied');
};
if ( $@ )
{
    ok($@->code() eq Ambrosia::error::Exception::AccessDenied::CODE(), 'AccessDenied');
    ok($@->message() eq 'AccessDenied', 'AccessDenied');
}