File Coverage

blib/lib/DynGig/Range/Cluster.pm

Criterion	Covered	Total	%
statement	15	57	26.3
branch	0	20	0.0
condition	0	18	0.0
subroutine	5	10	50.0
pod	1	1	100.0
total	21	106	19.8

=head1 NAME

DynGig::Range::Cluster - Extends DynGig::Range::String.

=cut
package DynGig::Range::Cluster;

=head1 VERSION

Version 0.01

=cut
our $VERSION = '0.03';

use base DynGig::Range::String;

use warnings;
use strict;
use Carp;

use DynGig::Range::Cluster::Client;

my %_ENV;

=head1 DESCRIPTION

=head2 setenv( timeout => seconds, server => server )

Sets DynGig::Range::Cluster::Client parameter. Returns object/class.

=cut
sub setenv
{
    my $this = shift @_;

    %_ENV = ( cluster => DynGig::Range::Cluster::Client->new( @_ ) );
    return $this;
}

=head1 SEE ALSO

See DynGig::Range::String for additional methods.

=head1 GRAMMAR

Tokenizer and parser implement the base class BNF with the
following differences.

=cut
sub _parse
{
    my ( $this, $input ) = @_;
    my $token = $this->_tokenize( $input, qr/[{}:=%()]/, qr/[-&]/ );

    $this += $this->_expression( $token, +{ '}' => 0, ')' => 0 } );
}

sub _valid
{
    my ( $this, $token, $lex ) = @_;

    return 0 unless @$token;
    return ref $token->[0] || $token->[0] eq '{' unless $lex;
    return ref $token->[0] || $token->[0] !~ /[-+&}:=%()]/ if $lex == 2;
    return $token->[0] =~ /[-+&]/;
}

=head2  ::=  |

=head2  ::=  '('  ':'  ')'

          |  '('  '%'  ')'
          |  '('  '='  ')'

=head2 SYMBOLS

I:

':' : given cluster name ( left operand ), get attribute keys by value.

'%' : given cluster name ( left operand ), get attribute values by key.

'=' : get cluster names with attribute key = value.

=cut
sub _range
{
    my ( $this, $token, $scope ) = @_;

    croak 'private method' unless $this->isa( ( caller )[0] );

    my $range = bless shift @$token, ref $this;

    return $range unless @$token && $token->[0] eq '(';

    my $type = ')';
    my $count = $scope->{$type};

    $this->_balance( $token, $scope, $type );

    my $key = $this->_expression( $token, $scope );
    my $op = shift @$token;

    unless ( @$token && $op && $op =~ /[:=%]/ )
    {
        splice @$token;
        return $this->new();
    }

    my $value = $this->_expression( $token, $scope );

    $this->_balance( $token, $scope, $type, $count )
        ? $this->_cluster( $op, $range, $key, $value ) : $range->clear();
}

sub _cluster
{
    my ( $this, $op ) = splice @_, 0, 2;
    my $range = $this->new();

    map { return $range if $_->empty() } @_;

    my $cluster = $_ENV{cluster} || croak "'cluster' not set";
    my ( $table, $key, $value ) = map { scalar $_->list() } @_;

    for my $table ( @$table )
    {
        for my $key ( @$key )
        {
            if ( $op eq ':' )
            {
                $range += $this->new
                (
                    map { $cluster->$table( cluster => $key, value => $_ ) }
                        @$value
                );
            }
            elsif ( $op eq '=' )
            {
                $range += $this->new
                (
                    map { $cluster->$table( key => $key, value => $_ ) }
                        @$value
                );
            }
            else
            {
                $range += $this->new
                (
                    map { $cluster->$table( cluster => $key, key => $_ ) }
                        @$value
                );
            }
        }
    }

    return $range;
}

=head1 MODULES

=head2 DynGig::Range::Cluster::Client

Cluster client

=head2 DynGig::Range::Cluster::Cache

Caching server. Implements DynGig::Range::Cluster::Interface.

=head2 DynGig::Range::Cluster::Server

Cluster server. Implements DynGig::Range::Cluster::Interface.

=head2 DynGig::Range::Cluster::Interface

Extends DynGig::Util::TCPServer.

=head2 DynGig::Range::Cluster::Config

Cluster configuration methods

=head2 DynGig::Range::Cluster::EZDB

Extends DynGig::Util::EZDB

=head1 AUTHOR

Kan Liu

=head1 COPYRIGHT and LICENSE

Copyright (c) 2010. Kan Liu

This program is free software; you may redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;

__END__