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


line stmt bran cond sub pod time code
1             package SQL::Eval;
2              
3             #########################################################################
4             #
5             # This module is copyright (c), 2001,2005 by Jeff Zucker.
6             # This module is copyright (c), 2007-2020 by Jens Rehsack.
7             # All rights reserved.
8             #
9             # It may be freely distributed under the same terms as Perl itself.
10             #
11             # See below for help (search for SYNOPSIS)
12             #########################################################################
13              
14             require 5.008;
15 16     16   128 use strict;
  16         41  
  16         647  
16 16     16   91 use warnings FATAL => "all";
  16         36  
  16         810  
17 16     16   109 use vars qw($VERSION);
  16         41  
  16         946  
18              
19             $VERSION = '1.413_001';
20              
21 16     16   96 use Carp qw(croak);
  16         35  
  16         4785  
22              
23             sub new($)
24             {
25 4643     4643 1 9192 my ( $proto, $attr ) = @_;
26 4643         14959 my ($self) = {%$attr};
27 4643   33     24018 bless( $self, ( ref($proto) || $proto ) );
28             }
29              
30             sub param($;$)
31             {
32 12242 50   12242 1 21783 $_[1] < 0 and croak "Illegal parameter number: $_[1]";
33 12242 50       22774 @_ == 3 and return $_[0]->{params}->[ $_[1] ] = $_[2];
34 12242         26783 $_[0]->{params}->[ $_[1] ];
35             }
36              
37             sub params(;$)
38             {
39 4443 100   4443 1 13656 @_ == 2 and return $_[0]->{params} = $_[1];
40 1         5 $_[0]->{params};
41             }
42              
43 4808     4808 1 12003 sub table($) { $_[0]->{tables}->{ $_[1] } }
44              
45 1     1 1 7 sub column($$) { $_[0]->table( $_[1] )->column( $_[2] ) }
46              
47 224     224   531 sub _gen_access_fastpath($) { $_[0]->table( $_[1] )->_gen_access_fastpath() }
48              
49             package SQL::Eval::Table;
50              
51 16     16   125 use strict;
  16         32  
  16         387  
52 16     16   79 use warnings FATAL => "all";
  16         185  
  16         641  
53              
54 16     16   100 use Carp qw(croak);
  16         28  
  16         895  
55 16     16   117 use Params::Util qw(_ARRAY0 _HASH0);
  16         52  
  16         14901  
56              
57             sub new($)
58             {
59 83     83   347 my ( $proto, $attr ) = @_;
60 83         413 my ($self) = {%$attr};
61              
62 83 50 33     547 defined( $self->{col_names} ) and defined( _ARRAY0( $self->{col_names} ) )
63             or croak("attribute 'col_names' must be defined as an array");
64 83 100       314 exists( $self->{col_nums} ) or $self->{col_nums} = _map_colnums( $self->{col_names} );
65 83 50 33     442 defined( $self->{col_nums} ) and defined( _HASH0( $self->{col_nums} ) )
66             or croak("attribute 'col_nums' must be defined as a hash");
67              
68 83 100       282 $self->{capabilities} = {} unless ( defined( $self->{capabilities} ) );
69 83   33     628 bless( $self, ( ref($proto) || $proto ) );
70             }
71              
72             sub _map_colnums
73             {
74 73     73   132 my $col_names = $_[0];
75 73         109 my %col_nums;
76 73         323 $col_nums{ $col_names->[$_] } = $_ for ( 0 .. scalar @$col_names - 1 );
77 73         209 \%col_nums;
78             }
79              
80 1     1   17 sub row() { $_[0]->{row} }
81 2     2   9 sub column($) { $_[0]->{row}->[ $_[0]->column_num( $_[1] ) ] }
82 12994     12994   44877 sub column_num($) { $_[0]->{col_nums}->{ $_[1] }; }
83 0     0   0 sub col_nums() { $_[0]->{col_nums} }
84 4711     4711   10455 sub col_names() { $_[0]->{col_names}; }
85              
86             sub _gen_access_fastpath($)
87             {
88 394     394   691 my ($self) = @_;
89              
90             $self->can("column") == SQL::Eval::Table->can("column")
91             && $self->can("column_num") == SQL::Eval::Table->can("column_num")
92 16951     16951   53142 ? sub { $self->{row}->[ $self->{col_nums}->{ $_[0] } ] }
93 394 100 66 1189   5081 : sub { $self->column( $_[0] ) };
  1189         2179  
94             }
95              
96             sub capability($)
97             {
98 8709     8709   15922 my ( $self, $capname ) = @_;
99 8709 100       35458 exists $self->{capabilities}->{$capname} and return $self->{capabilities}->{$capname};
100              
101             $capname eq "insert_new_row"
102 57 100       230 and $self->{capabilities}->{insert_new_row} = $self->can("insert_new_row");
103             $capname eq "delete_one_row"
104 57 100       175 and $self->{capabilities}->{delete_one_row} = $self->can("delete_one_row");
105             $capname eq "delete_current_row"
106             and $self->{capabilities}->{delete_current_row} =
107 57 100 33     163 ( $self->can("delete_current_row") and $self->capability("inplace_delete") );
108             $capname eq "update_one_row"
109 57 100       181 and $self->{capabilities}->{update_one_row} = $self->can("update_one_row");
110             $capname eq "update_current_row"
111             and $self->{capabilities}->{update_current_row} =
112 57 100 33     161 ( $self->can("update_current_row") and $self->capability("inplace_update") );
113             $capname eq "update_specific_row"
114 57 100       147 and $self->{capabilities}->{update_specific_row} = $self->can("update_specific_row");
115              
116             $capname eq "rowwise_update"
117             and $self->{capabilities}->{rowwise_update} = (
118 57 100 33     140 $self->capability("update_one_row")
119             or $self->capability("update_current_row")
120             or $self->capability("update_specific_row")
121             );
122             $capname eq "rowwise_delete"
123             and $self->{capabilities}->{rowwise_delete} = (
124 57 100 33     134 $self->capability("delete_one_row")
125             or $self->capability("delete_current_row")
126             );
127              
128 57         256 $self->{capabilities}->{$capname};
129             }
130              
131 0     0     sub drop ($$) { croak "Abstract method " . ref( $_[0] ) . "::drop called" }
132 0     0     sub fetch_row ($$) { croak "Abstract method " . ref( $_[0] ) . "::fetch_row called" }
133 0     0     sub push_row ($$$) { croak "Abstract method " . ref( $_[0] ) . "::push_row called" }
134 0     0     sub push_names ($$$) { croak "Abstract method " . ref( $_[0] ) . "::push_names called" }
135 0     0     sub truncate ($$) { croak "Abstract method " . ref( $_[0] ) . "::truncate called" }
136 0     0     sub seek ($$$$) { croak "Abstract method " . ref( $_[0] ) . "::seek called" }
137              
138             1;
139              
140             __END__