view release on metacpan or  search on metacpan

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

use Ambrosia::core::Nil;
use Ambrosia::Meta;

#=rem
#
#driver: источник данных:
#    - ARRAY;
#    - Ambrosia::QL;
#    - класс у которго реализован метод CQL().
#
#__variable: содержит ссылку на переменную в которой размещен объект;
#__predicate: ссылка на функцию, которая проверяет соответствие полученного объекта заданному условию;
#__select: ссылка на функцию, которая может проделать дополнительную обработку полученного объекта;
#__join: ссылка на родителя
#
#=cut
#

class sealed {
    public  => [qw/driver source/],
    private => [qw/__variable __predicate __on __select __join __join_kw __limit __skip/],
};

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,
            __limit     => 0,
            __skip      => 0,
        );
}

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

sub predicate
{
    my $self = shift;

    if(ref $_[0] eq 'CODE')
    {
        $self->__limit = 1;
        my $p = $_[0];
        my $old = $self->__predicate;
        $self->__predicate = sub { $old->(@_) && $p->(@_) }
    }
    else
    {
        $self->driver->predicate(@_);
    }

    return $self;
}

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

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

sub join
{
    my $self = shift;
    my ($kw, $driver, $source);

    if ( scalar @_ == 1 )
    {
        $kw = 'INNER';
        $driver = $self->driver->clone;
        $source = $driver->get_source();
    }
    elsif ( scalar @_ == 2 )
    {
        $kw = shift || 'INNER';
        $driver = $self->driver->clone;