File Coverage

blib/lib/SQL/Eval.pm

Criterion	Covered	Total	%
statement	65	72	90.2
branch	30	34	88.2
condition	10	27	37.0
subroutine	24	31	77.4
pod	5	5	100.0
total	134	169	79.2

package SQL::Eval;

#########################################################################
#
# This module is copyright (c), 2001,2005 by Jeff Zucker.
# This module is copyright (c), 2007-2020 by Jens Rehsack.
# All rights reserved.
#
# It may be freely distributed under the same terms as Perl itself.
#
# See below for help (search for SYNOPSIS)
#########################################################################

require 5.008;
use strict;
use warnings FATAL => "all";
use vars qw($VERSION);

$VERSION = '1.413_001';

use Carp qw(croak);

sub new($)
{
    my ( $proto, $attr ) = @_;
    my ($self) = {%$attr};
    bless( $self, ( ref($proto) || $proto ) );
}

sub param($;$)
{
    $_[1] < 0 and croak "Illegal parameter number: $_[1]";
    @_ == 3 and return $_[0]->{params}->[ $_[1] ] = $_[2];
    $_[0]->{params}->[ $_[1] ];
}

sub params(;$)
{
    @_ == 2 and return $_[0]->{params} = $_[1];
    $_[0]->{params};
}

sub table($) { $_[0]->{tables}->{ $_[1] } }

sub column($$) { $_[0]->table( $_[1] )->column( $_[2] ) }

sub _gen_access_fastpath($) { $_[0]->table( $_[1] )->_gen_access_fastpath() }

package SQL::Eval::Table;

use strict;
use warnings FATAL => "all";

use Carp qw(croak);
use Params::Util qw(_ARRAY0 _HASH0);

sub new($)
{
    my ( $proto, $attr ) = @_;
    my ($self) = {%$attr};

    defined( $self->{col_names} ) and defined( _ARRAY0( $self->{col_names} ) )
      or croak("attribute 'col_names' must be defined as an array");
    exists( $self->{col_nums} ) or $self->{col_nums} = _map_colnums( $self->{col_names} );
    defined( $self->{col_nums} ) and defined( _HASH0( $self->{col_nums} ) )
      or croak("attribute 'col_nums' must be defined as a hash");

    $self->{capabilities} = {} unless ( defined( $self->{capabilities} ) );
    bless( $self, ( ref($proto) || $proto ) );
}

sub _map_colnums
{
    my $col_names = $_[0];
    my %col_nums;
    $col_nums{ $col_names->[$_] } = $_ for ( 0 .. scalar @$col_names - 1 );
    \%col_nums;
}

sub row()         { $_[0]->{row} }
sub column($)     { $_[0]->{row}->[ $_[0]->column_num( $_[1] ) ] }
sub column_num($) { $_[0]->{col_nums}->{ $_[1] }; }
sub col_nums()    { $_[0]->{col_nums} }
sub col_names()   { $_[0]->{col_names}; }

sub _gen_access_fastpath($)
{
    my ($self) = @_;

    $self->can("column") == SQL::Eval::Table->can("column")
      && $self->can("column_num") == SQL::Eval::Table->can("column_num")
      ? sub { $self->{row}->[ $self->{col_nums}->{ $_[0] } ] }
      : sub { $self->column( $_[0] ) };
}

sub capability($)
{
    my ( $self, $capname ) = @_;
    exists $self->{capabilities}->{$capname} and return $self->{capabilities}->{$capname};

    $capname eq "insert_new_row"
      and $self->{capabilities}->{insert_new_row} = $self->can("insert_new_row");
    $capname eq "delete_one_row"
      and $self->{capabilities}->{delete_one_row} = $self->can("delete_one_row");
    $capname eq "delete_current_row"
      and $self->{capabilities}->{delete_current_row} =
      ( $self->can("delete_current_row") and $self->capability("inplace_delete") );
    $capname eq "update_one_row"
      and $self->{capabilities}->{update_one_row} = $self->can("update_one_row");
    $capname eq "update_current_row"
      and $self->{capabilities}->{update_current_row} =
      ( $self->can("update_current_row") and $self->capability("inplace_update") );
    $capname eq "update_specific_row"
      and $self->{capabilities}->{update_specific_row} = $self->can("update_specific_row");

    $capname eq "rowwise_update"
      and $self->{capabilities}->{rowwise_update} = (
             $self->capability("update_one_row")
          or $self->capability("update_current_row")
          or $self->capability("update_specific_row")
      );
    $capname eq "rowwise_delete"
      and $self->{capabilities}->{rowwise_delete} = (
             $self->capability("delete_one_row")
          or $self->capability("delete_current_row")
      );

    $self->{capabilities}->{$capname};
}

sub drop ($$)        { croak "Abstract method " . ref( $_[0] ) . "::drop called" }
sub fetch_row ($$)   { croak "Abstract method " . ref( $_[0] ) . "::fetch_row called" }
sub push_row ($$$)   { croak "Abstract method " . ref( $_[0] ) . "::push_row called" }
sub push_names ($$$) { croak "Abstract method " . ref( $_[0] ) . "::push_names called" }
sub truncate ($$)    { croak "Abstract method " . ref( $_[0] ) . "::truncate called" }
sub seek ($$$$)      { croak "Abstract method " . ref( $_[0] ) . "::seek called" }

1;

__END__