Ambrosia

 view release on metacpan or  search on metacpan

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

    {
        *{"${package_instance}::assert"} = sub(&$) { goto &__assert; };
    }
    else
    {
        *{"${package_instance}::assert"} = sub(&$) {};
    }

}

sub __assert(&$)
{
    my $condition = shift;
    if (( ref $condition eq 'CODE' && !$condition->() ) || !$condition)
    {
        carp( 'error: ' . shift);
        exit(42);
    }
}
################################################################################

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

use Ambrosia::Meta;

class
{
    extends => [qw/Exporter/],
    private => [qw/__managers __last_manager/],
};

our $VERSION = 0.010;

sub RELEGATE() { 0 }
sub INTERNALREDIRECT() { 1 }
sub FORWARD() { 2 }

our @EXPORT = qw/controller/;

{
    my $__CONTROLLER__;

    sub instance
    {
        $__CONTROLLER__ = shift->SUPER::new(@_) unless $__CONTROLLER__;
        return $__CONTROLLER__;

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


    $self->__core->send_http_header if $nph;
    $self->__core->no_cache if $no_cache;
    $self->__core->send_cgi_header(join(crlf(), @$header, crlf()));

    return '';
}

################################################################################

sub crlf() { "\r\n"; }

sub prepare_header
{
    my %params = @_;
    my @headers = ();
    my $type = 'Content-Type: text/html';
    my $charset = '';
    my $date;
    my $nph;
    my $status;

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

    $self->_cql_query = [];
    $self->_cache = new Ambrosia::core::Nil();
    return $self;
}

sub next : Abstract {}

sub count : Abstract {}

####### CQL #########
sub WHAT()     { 0 }
sub SELECT()   { 1 }
sub INSERT()   { 2 }
sub UPDATE()   { 3 }
sub DELETE()   { 4 }
sub SOURCE()   { 5 }
sub PREDICATE() { 6 }
sub LIMIT()    { 7 }
sub ORDER_BY() { 8 }
sub NO_QUOTE() { 9 }
sub JOIN()     { 10 }
sub ON()       { 11 }
sub UNIQ()     { 12 }
sub UNION()    { 13 }
#####################
sub get_what      { $_[0]->_cql_query->[&WHAT] }
sub get_select    { $_[0]->_cql_query->[&SELECT] }
sub get_insert    { $_[0]->_cql_query->[&INSERT] }
sub get_update    { $_[0]->_cql_query->[&UPDATE] }
sub get_delete    { $_[0]->_cql_query->[&DELETE] }
sub get_source    { $_[0]->_cql_query->[&SOURCE] }
sub get_predicate { $_[0]->_cql_query->[&PREDICATE] }
sub get_limit     { $_[0]->_cql_query->[&LIMIT] }
sub get_order_by  { $_[0]->_cql_query->[&ORDER_BY] }

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

use Ambrosia::Meta;
class abstract
{
    private => [qw/_state/],
};

our $VERSION = 0.010;

################################################################################

sub _map() { return shift->__AMBROSIA_ALIAS_FIELDS__ || {} }

sub _init
{
    my $self = shift;
    $self->SUPER::_init(@_);
    if ( $self->key_value() )
    {
        $self->SET_LOADED;
    }
    else

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

    return $driver->catalog, $driver->schema, $_[0]->table();
}

#Редактируемые поля (сохраняемые в БД). По умолчанию все public поля класса
#Edited fields (storage in Data Source). Default all publick fields of class.
sub edit_fields
{
    return $_[0]->fields();
}

sub fields_mapping()
{
    my $proto = shift;
    return map { $proto->_map->{$_} || $_ } $proto->edit_fields();
}

#Возвращает имя ключа класса.
#Соответствует автоинкрементному полю в БД.
#Если поле не автоинкрементное используем key
sub primary_key
{

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

use base qw/Exporter/;
our @EXPORT = qw/class abstract sealed inheritable/;

use Ambrosia::Assert;
use Ambrosia::error::Exceptions;
require Ambrosia::core::Object;

our $VERSION = 0.010;

#fields
sub __PRIVATE()   { 1 }
sub __PUBLIC()    { 2 }
sub __PROTECTED() { 3 }
sub __FRIENDS()   { 4 }

#classes
sub __ABSTRACT()    { 1 }
sub __SEALED()      { 2 }
sub __INHERITABLE() { 3 }

my %FIELDS_ACCESS = (
        private   => &__PRIVATE,
        protected => &__PROTECTED,
        public    => &__PUBLIC,
        friends   => &__FRIENDS,
    );

my %CLASS_TYPE = (
        abstract    => &__ABSTRACT,

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

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

sub abstract(@)
{
    return abstract => @_;
}

sub sealed(@)
{
    return sealed => @_;
}

sub inheritable(@)
{
    return inheritable => @_;
}

sub class(@)
{
    my $INSTANCE_CLASS;

# You can create your class
# 1. so: class {} or equalent class inheritable {}
# 2. or so: class abstract {}
# 3. and so: class sealed {}
#
    my ( $clsType, $params ) = @_ == 1 ? (&__INHERITABLE, shift) : ( @_ == 2 ? ($CLASS_TYPE{lc(+shift)}, shift) : (&__INHERITABLE, {}) );

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

};

our $VERSION = 0.010;

sub new :Private
{
}

sub _TRUE { 1 }

sub from(&)
{
    my $proto = shift;
    my $class = ref $proto || $proto;

    return $class->SUPER::new(
            source => shift,
            driver => new Ambrosia::core::Nil(),
            __variable  => shift || \my $tmp,
            __predicate => \&_TRUE,
            __on        => \&_TRUE,

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

    '${}' => \&__as_scalar,
    '&{}' => \&__as_func,
    '*{}' => \&__as_glob,
    '==' => \&__as_bool,
    'bool'=> \&__as_bool,
    '""'  => \&__as_string,
    '0+'  => \&__as_number,
    'fallback' => 1
    ;

sub call(&)
{
    return bless {code => $_[0]}, 'deferred';
}

sub as_hash
{
    return $_[0] if caller eq __PACKAGE__;
    local $@;
    unless ( exists $_[0]->{value} )
    {

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

    $self;
}

sub inhead
{
    my $self = shift;
    unshift @{$self->__list}, @_;
    $self;
}

sub next()
{
    my $self = shift;

    if ( $self->IS_STRATEGY_LIFO )
    {
        return pop @{$self->__list};
    }
    else
    {
        return shift @{$self->__list};
    }
}

sub last()
{
    my $self = shift;

    return undef unless $self->size();

    if ( $self->IS_STRATEGY_LIFO )
    {
        return $self->__list->[0];
    }
    else
    {
        return $self->__list->[-1];
    }
}

sub head()
{
    my $self = shift;

    if ( $self->IS_STRATEGY_LIFO )
    {
        return pop @{$self->__list};
    }
    else
    {
        return shift @{$self->__list};
    }
}

sub first()
{
    my $self = shift;

    return undef unless $self->size();

    if ( $self->IS_STRATEGY_LIFO )
    {
        return $self->__list->[-1];
    }
    else
    {
        return $self->__list->[0];
    }
}

sub size()
{
    return scalar @{$_[0]->__list};
}

sub clear()
{
    $_[0]->__list = [];
    $_[0];
}

sub reset
{
    shift()->clear->add(@_);
}

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;

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


package Ambrosia::error::Exceptions;
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__

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


use Ambrosia::Context;
use Ambrosia::Meta;
class sealed
{
    extends => [qw/Ambrosia::BaseManager/],
};

our $VERSION = 0.010;

sub readln()
{
    chomp(my $c = <STDIN>);
    $c =~ s/^(\s+)|(\s+)$//sg;
    return $c;
}

sub isRootDir
{
    my ($volume, $dir, $name) = File::Spec->splitpath(shift);
    return File::Spec->rootdir() eq $dir;

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

        my %h;
        @h{qw/table_cat table_schem table_name table_type remarks/} = (
            $table_cat, $table_schem, $table_name, $table_type, $remarks, );

        push @tables, \%h;
    }
    $sth->finish;
    return \@tables;
}

sub SQL_NO_NULLS()         { 0 }
sub SQL_NULLABLE()         { 1 }
sub SQL_NULLABLE_UNKNOWN() { 2 }


#=rem
#TABLE_CAT: The catalog identifier. This field is NULL (undef) if not applicable to the data source, which is often the case. This field is empty if not applicable to the table.
#TABLE_SCHEM: The schema identifier. This field is NULL (undef) if not applicable to the data source, and empty if not applicable to the table.
#TABLE_NAME: The table identifier. Note: A driver may provide column metadata not only for base tables, but also for derived objects like SYNONYMS etc.
#COLUMN_NAME: The column identifier.
#DATA_TYPE: The concise data type code.
#TYPE_NAME: A data source dependent data type name.
#COLUMN_SIZE: The column size. This is the maximum length in characters for character data types, the number of digits or bits for numeric data types or the length in the representation of temporal types. See the relevant specifications for detailed ...

t/Foo.pm  view on Meta::CPAN


    $self->foo_pub1 ||= 'foo_pub1';
    $self->foo_pub2 ||= 'foo_pub2';
    $self->foo_pro1 ||= 'foo_pro1';
    $self->foo_pro2 ||= 'foo_pro2';
    $self->foo_pri1 ||= 'foo_pri1';
    $self->foo_pri2 ||= 'foo_pri2';
}

my $sum = 0;
sub count() { ++$sum; }

sub twice_pro
{
    my $self = shift;
    my $delim = shift || ';';
    return $self->foo_pro1 . $delim . $self->foo_pro2;
}

sub getPro #: Public(1,2,3)
{



( run in 0.449 second using v1.01-cache-2.11-cpan-65fba6d93b7 )