File Coverage

blib/lib/SQL/Statement/RAM.pm
Criterion Covered Total %
statement 69 71 97.1
branch 13 16 81.2
condition 2 3 66.6
subroutine 16 17 94.1
pod n/a
total 100 107 93.4


line stmt bran cond sub pod time code
1             ############################
2             package SQL::Statement::RAM;
3             ############################
4              
5             ######################################################################
6             #
7             # This module is copyright (c), 2001,2005 by Jeff Zucker.
8             # This module is copyright (c), 2007-2020 by Jens Rehsack.
9             # All rights reserved.
10             #
11             # It may be freely distributed under the same terms as Perl itself.
12             # See below for help and copyright information (search for SYNOPSIS).
13             #
14             ######################################################################
15              
16 16     16   120 use strict;
  16         34  
  16         592  
17 16     16   88 use warnings FATAL => "all";
  16         29  
  16         572  
18              
19 16     16   88 use vars qw($VERSION);
  16         31  
  16         880  
20             $VERSION = '1.413_001';
21              
22             ####################################
23             package SQL::Statement::RAM::Table;
24             ####################################
25              
26 16     16   92 use strict;
  16         31  
  16         333  
27 16     16   70 use warnings FATAL => "all";
  16         33  
  16         435  
28              
29 16     16   80 use SQL::Eval ();
  16         31  
  16         313  
30              
31 16     16   87 use vars qw(@ISA);
  16         29  
  16         911  
32             @ISA = qw(SQL::Eval::Table);
33              
34 16     16   113 use Carp qw(croak);
  16         47  
  16         12224  
35              
36             sub new
37             {
38 38     38   128 my ( $class, $tname, $col_names, $data_tbl ) = @_;
39 38         271 my %table = (
40             NAME => $tname,
41             index => 0,
42             records => $data_tbl,
43             col_names => $col_names,
44             capabilities => {
45             inplace_update => 1,
46             inplace_delete => 1,
47             },
48             );
49 38         241 my $self = $class->SUPER::new( \%table );
50             }
51              
52             ##################################
53             # fetch_row()
54             ##################################
55             sub fetch_row
56             {
57 9155     9155   15391 my ( $self, $data ) = @_;
58              
59             return $self->{row} =
60             ( $self->{records} and ( $self->{index} < scalar( @{ $self->{records} } ) ) )
61 9155 100 66     19157 ? [ @{ $self->{records}->[ $self->{index}++ ] } ]
  8966         63752  
62             : undef;
63             }
64              
65             ####################################
66             # insert_new_row()
67             ####################################
68             sub insert_new_row
69             {
70 4280     4280   7988 my ( $self, $data, $fields ) = @_;
71 4280         5881 push @{ $self->{records} }, [ @{$fields} ];
  4280         7631  
  4280         11792  
72 4280         11046 return 1;
73             }
74              
75             ##################################
76             # delete_current_row()
77             ##################################
78             sub delete_current_row
79             {
80 10     10   27 my ( $self, $data, $fields ) = @_;
81 10         33 my $currentRow = $self->{index} - 1;
82 10 50       34 croak "No current row" unless ( $currentRow >= 0 );
83 10         20 splice @{ $self->{records} }, $currentRow, 1;
  10         29  
84 10         24 --$self->{index};
85 10         21 return 1;
86             }
87              
88             ##################################
89             # update_current_row()
90             ##################################
91             sub update_current_row
92             {
93 7     7   16 my ( $self, $data, $fields ) = @_;
94 7         16 my $currentRow = $self->{index} - 1;
95 7 50       18 croak "No current row" unless ( $currentRow >= 0 );
96 7         13 $self->{records}->[$currentRow] = [ @{$fields} ];
  7         23  
97 7         18 return 1;
98             }
99              
100             ##################################
101             # truncate()
102             ##################################
103             sub truncate
104             {
105 0     0   0 return splice @{ $_[0]->{records} }, $_[0]->{index};
  0         0  
106             }
107              
108             #####################################
109             # push_names()
110             #####################################
111             sub push_names
112             {
113 35     35   105 my ( $self, $data, $names ) = @_;
114 35         84 $self->{col_names} = $names;
115 35         61 $self->{org_col_names} = [ @{$names} ];
  35         105  
116 35         101 $self->{col_nums} = SQL::Eval::Table::_map_colnums($names);
117             }
118              
119             #####################################
120             # drop()
121             #####################################
122             sub drop
123             {
124 7     7   19 my ( $self, $data ) = @_;
125 7         19 my $tname = $self->{NAME};
126 7         18 delete $data->{Database}->{sql_ram_tables}->{$tname};
127 7         17 return 1;
128             }
129              
130             #####################################
131             # seek()
132             #####################################
133             sub seek
134             {
135 4478     4478   9250 my ( $self, $data, $pos, $whence ) = @_;
136 4478 50       10230 return unless defined $self->{records};
137 4478         7393 my ($currentRow) = $self->{index};
138 4478 100       8059 if ( $whence == 0 )
    100          
    100          
139             {
140 4475         7269 $currentRow = $pos;
141             }
142             elsif ( $whence == 1 )
143             {
144 1         4 $currentRow += $pos;
145             }
146             elsif ( $whence == 2 )
147             {
148 1         5 $currentRow = @{ $self->{records} } + $pos;
  1         4  
149             }
150             else
151             {
152 1         201 croak $self . "->seek: Illegal whence argument ($whence)";
153             }
154 4477 100       8491 if ( $currentRow < 0 )
155             {
156 1         86 croak "Illegal row number: $currentRow";
157             }
158 4476         10138 $self->{index} = $currentRow;
159             }
160              
161             1;
162              
163             =pod
164              
165             =head1 NAME
166              
167             SQL::Statement::RAM
168              
169             =head1 SYNOPSIS
170              
171             SQL::Statement::RAM
172              
173             =head1 DESCRIPTION
174              
175             This package contains support for the internally used
176             SQL::Statement::RAM::Table.
177              
178             =head1 INHERITANCE
179              
180             SQL::Statement::RAM
181              
182             SQL::Statement::RAM::Table
183             ISA SQL::Eval::Table
184              
185             =head1 SQL::Statement::RAM::Table
186              
187             =head2 METHODS
188              
189             =over 8
190              
191             =item new
192              
193             Instantiates a new C object, used for temporary
194             tables.
195              
196             CREATE TEMP TABLE foo ....
197              
198             =item fetch_row
199              
200             Fetches the next row
201              
202             =item push_row
203              
204             As fetch_row except for writing
205              
206             =item delete_current_row
207              
208             Deletes the last fetched/pushed row
209              
210             =item update_current_row
211              
212             Updates the last fetched/pushed row
213              
214             =item truncate
215              
216             Truncates the table at the current position
217              
218             =item push_names
219              
220             Set the column names of the table
221              
222             =item drop
223              
224             Discards the table
225              
226             =item seek
227              
228             Seek the row pointer
229              
230             =back
231              
232             =head2 CAPABILITIES
233              
234             This table has following capabilities:
235              
236             =over 8
237              
238             =item update_current_row
239              
240             Using provided method C and capability C.
241              
242             =item rowwise_update
243              
244             By providing capability C.
245              
246             =item inplace_update
247              
248             By definition (appropriate flag set in constructor).
249              
250             =item delete_current_row
251              
252             Using provided method C and capability C.
253              
254             =item rowwise_delete
255              
256             By providing capability C.
257              
258             =item inplace_delete
259              
260             By definition (appropriate flag set in constructor).
261              
262             =back
263              
264             =head1 SUPPORT
265              
266             You can find documentation for this module with the perldoc command.
267              
268             perldoc SQL::Statement
269              
270             You can also look for information at:
271              
272             =over 4
273              
274             =item * RT: CPAN's request tracker
275              
276             L
277              
278             =item * AnnoCPAN: Annotated CPAN documentation
279              
280             L
281              
282             =item * CPAN Ratings
283              
284             L
285              
286             =item * Search CPAN
287              
288             L
289              
290             =back
291              
292             =head1 AUTHOR AND COPYRIGHT
293              
294             Copyright (c) 2001,2005 by Jeff Zucker: jzuckerATcpan.org
295             Copyright (c) 2007-2020 by Jens Rehsack: rehsackATcpan.org
296              
297             All rights reserved.
298              
299             You may distribute this module under the terms of either the GNU
300             General Public License or the Artistic License, as specified in
301             the Perl README file.
302              
303             =cut