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 ...
$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)
{