| 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 |