This file is indexed.

/usr/share/perl5/SQL/Eval.pm is in libsql-statement-perl 1.405-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
# -*- perl -*-

package SQL::Eval;

require 5.008;
use strict;
use warnings;
use vars qw($VERSION);

$VERSION = '1.405';

use Carp qw(croak);

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

sub param($;$)
{
    my ( $self, $paramNum, $param ) = @_;

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

sub params(;$)
{
    my ( $self, $array ) = @_;

    $self->{params} = $array if ( @_ == 2 );
    return $self->{params};
}

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

sub column($$)
{
    my ( $self, $table, $column ) = @_;

    return $self->table($table)->column($column);
}

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

    return $self->table($table)->_gen_access_fastpath();
}

package SQL::Eval::Table;

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

    return $self;
}

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

sub row()         { return $_[0]->{row}; }
sub column($)     { return $_[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) = @_;

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

sub capability($)
{
    my ( $self, $capname ) = @_;
    return $self->{capabilities}->{$capname} if ( defined( $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")
                                                    );

    return $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__

=head1 NAME

SQL::Eval - Base for deriving evaluation objects for SQL::Statement


=head1 SYNOPSIS

    require SQL::Statement;
    require SQL::Eval;

    # Create an SQL statement; use a concrete subclass of
    # SQL::Statement
    my $stmt = MyStatement->new("SELECT * FROM foo, bar",
			        SQL::Parser->new('Ansi'));

    # Get an eval object by calling open_tables; this
    # will call MyStatement::open_table
    my $eval = $stmt->open_tables($data);

    # Set parameter 0 to 'Van Gogh'
    $eval->param(0, 'Van Gogh');
    # Get parameter 2
    my $param = $eval->param(2);

    # Get the SQL::Eval::Table object referring the 'foo' table
    my $fooTable = $eval->table('foo');


=head1 DESCRIPTION

This module implements two classes that can be used for deriving
subclasses to evaluate SQL::Statement objects. The SQL::Eval object
can be thought as an abstract state engine for executing SQL queries
and the SQL::Eval::Table object is a table abstraction. It implements
methods for fetching or storing rows, retrieving column names and
numbers and so on.  See the C<test.pl> script as an example for
implementing a subclass.

While reading on, keep in mind that these are abstract classes,
you *must* implement at least some of the methods described below.
In addition, you need not derive from SQL::Eval or SQL::Eval::Table,
you just need to implement the method interface.

All methods throw a Perl exception in case of errors.

=head2 Method interface of SQL::Eval

=over 8

=item new

Constructor; use it like this:

    $eval = SQL::Eval->new(\%attr);

Blesses the hash ref \%attr into the SQL::Eval class (or a subclass).

=item param

Used for getting or setting input parameters, as in the SQL query

    INSERT INTO foo VALUES (?, ?);

Example:

    $eval->param(0, $val);        # Set parameter 0
    $eval->param(0);              # Get parameter 0

=item params

Used for getting or setting the complete array of input
parameters. Example:

    $eval->params($params);       # Set the array
    $eval->params();              # Get the array

=item table

Returns or sets a table object. Example:

    $eval->table('foo', $fooTable);  # Set the 'foo' table object
    $eval->table('foo');             # Return the 'foo' table object

=item column

Return the value of a column with a given name; example:

    $col = $eval->column('foo', 'id');  # Return the 'id' column of
                                        # the current row in the
                                        # 'foo' table

This is equivalent to and a shorthand for

    $col = $eval->table('foo')->column('id');

=item _gen_access_fastpath

Return a subroutine reference for fast accessing columns for read-only
access. This routine simply returns the C<_gen_access_fastpath> of the
referenced table.

=back


=head2 Method interface of SQL::Eval::Table

=over 8

=item new

Constructor; use it like this:

    $eval = SQL::Eval::Table->new(\%attr);

Blesses the hash ref \%attr into the SQL::Eval::Table class (or a
subclass).

The following attributes are used by C<SQL::Eval::Table>:

=over 12

=item col_names

Array reference containing the names of the columns in order they appear
in the table. This attribute B<must> be provided by the derived class.

=item col_nums

Hash reference containing the column names as keys and the column
indexes as values. If this is omitted (does not exist), it will be
created from C<col_names>.

=item capabilities

Hash reference containing additional capabilities.

=item _gen_access_fastpath

Return a subroutine reference for fast accessing columns for read-only
access. When the instantiated object doesn't provide own methods for
C<column> and C<column_num> a subroutine reference is returned which
directly access the internal data structures. For all other cases a
subroutine directly calling C<< $self->column($_[0]) >> is returned.

=back

=item row

Used to get the current row as an array ref. Do not confuse
getting the current row with the fetch_row method! In fact this
method is valid only after a successful C<$table-E<gt>fetchrow()>.
Example:

    $row = $table->row();

=item column

Get the column with a given name in the current row. Valid only after
a successful C<$table-E<gt>fetchrow()>. Example:

    $col = $table->column($colName);

=item column_num

Return the number of the given column name. Column numbers start with
0. Returns undef, if a column name is not defined, so that you can use
this for verifying column names. Example:

    $colNum = $table->column_num($colNum);

=item col_nums

Returns an hash ref of column names with the column names as keys and
the column indexes as the values.

=item col_names

Returns an array ref of column names ordered by their index within the table.

=item capability

Returns a boolean value whether the table has the specified capability
or not. This method might be overridden by derived classes, but ensure
that in that case the parent capability method is called when the
derived class does not handle the requested capability.

The following capabilities are used (and requested) by SQL::Statement:

=over 12

=item update_one_row

Defines whether the table is able to update one single row. This
capability is used for backward compatibility and might have
(depending on table implementation) several limitations. Please
carefully study the documentation of the table or ask the author of
the table, if this information is not provided.

This capability is evaluated automatically on first request and must
not be handled by any derived classes.

=item update_specific_row

Defines if the table is able to update one single row, but keeps the
original content of the row to update.

This capability is evaluated automatically on first request and must not
be handled by derived classes.

=item update_current_row

Defines if the table is able to update the currently touched row. This
capability requires the capability of C<inplace_update>.

This capability is evaluated automatically on first request and must not
be handled by derived classes.

=item rowwise_update

Defines if the table is able to do row-wise updates which means one
of C<update_one_row>, C<update_specific_row> or C<update_current_row>.
The C<update_current_row> is only evaluated if the table has the
C<inplace_update> capability.

This capability is evaluated automatically on first request and must not
be handled by derived classes.

=item inplace_update

Defines if an update of a row has side effects (capability is not
available) or can be done without harming any other currently running
task on the table.

Example: The table storage is using a hash on the C<PRIMARY KEY> of
the table. Real perl hashes do not care when an item is updated while
the hash is traversed using C<each>. C<SDBM_File> 1.06 has a bug,
which does not adjust the traversal pointer when an item is deleted.

C<SQL::Statement::RAM::Table> recognizes such situations and adjusts
the traversal pointer.

This might not be possible for all implementations which can update
single rows.

This capability could be provided by a derived class only.

=item delete_one_row

Defines whether the table can delete one single row by it's content or
not.

This capability is evaluated automatically on first request and must not
be handled by derived classes.

=item delete_current_row

Defines whether a table can delete the current traversed row or
not. This capability requires the C<inplace_delete> capability.

This capability is evaluated automatically on first request and must not
be handled by derived classes.

=item rowwise_delete

Defines if any row-wise delete operation is provided by the
table. C<row-wise> delete capabilities are C<delete_one_row> and
C<delete_current_row>.

This capability is evaluated automatically on first request and must not
be handled by derived classes.

=item inplace_delete

Defines if the deletion of a row has side effects (capability is not
available) or can be done without harming any other currently running
task on the table.

This capability should be provided by a derived class only.

=item insert_new_row

Defines if a table can easily insert a new row without need to seek
or truncate. This capability is provided by defining the table class
method C<insert_new_row>.

This capability is evaluated automatically on first request and must not
be handled by derived classes.

=back

If the capabilities I<rowwise_update> and I<insert_new_row> are
provided, the table primitive C<push_row> is not required anymore and
may be omitted.

=back

The above methods are implemented by SQL::Eval::Table. The following
methods are not, so that they *must* be implemented by the
subclass. See the C<DBD::DBM::Table> or C<DBD::CSV::Table> for
example.

=over 8

=item drop

Drops the table. All resources allocated by the table must be released
after C<$table->drop($data)>.

=item fetch_row

Fetches the next row from the table. Returns C<undef>, if the last
row was already fetched. The argument $data is for private use of
the subclass. Example:

    $row = $table->fetch_row($data);

Note, that you may use

    $row = $table->row();

for retrieving the same row again, until the next call of C<fetch_row>.

C<SQL::Statement> requires that the last fetched row is available again
and again via C<$table->row()>.

=item push_row

As fetch_row except for storing rows. Example:

    $table->push_row($data, $row);

=item push_names

Used by the I<CREATE TABLE> statement to set the column names of the
new table. Receives an array ref of names. Example:

    $table->push_names($data, $names);

=item seek

Similar to the seek method of a filehandle; used for setting the number
of the next row being written. Example:

    $table->seek($data, $whence, $rowNum);

Actually the current implementation only uses C<seek($data, 0, 0)>
(first row) and C<seek($data, 2, 0)> (beyond last row, end of file).

=item truncate

Truncates a table after the current row. Example:

    $table->truncate($data);

=back


=head1 INTERNALS

The current implementation is quite simple: An SQL::Eval object is an
hash ref with only two attributes. The C<params> attribute is an array
ref of parameters. The C<tables> attribute is an hash ref of table
names (keys) and table objects (values).

SQL::Eval::Table instances are implemented as hash refs. Attributes
used are C<row> (the array ref of the current row), C<col_nums> (an
hash ref of column names as keys and column numbers as values) and
C<col_names>, an array ref of column names with the column numbers as
indexes.

=head1 MULTITHREADING

All methods are working with instance-local data only, thus the module
is reentrant and thread safe, if you either don't share handles between
threads or grant serialized use.

=head1 BUGS

Please report any bugs or feature requests to C<bug-sql-statement at
rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=SQL-Statement>.  I
will be notified, and then you will automatically be notified of
progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc SQL::Eval
    perldoc SQL::Statement

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=SQL-Statement>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/SQL-Statement>

=item * CPAN Ratings

L<http://cpanratings.perl.org/s/SQL-Statement>

=item * Search CPAN

L<http://search.cpan.org/dist/SQL-Statement/>

=back


=head1 AUTHOR AND COPYRIGHT

Written by Jochen Wiedmann and currently maintained by Jens Rehsack.

This module is Copyright (C) 1998 by

    Jochen Wiedmann
    Am Eisteich 9
    72555 Metzingen
    Germany

    Email: joe@ispsoft.de
    Phone: +49 7123 14887

and Copyright (C) 2009, 2010 by

     Jens Rehsack < rehsackATcpan.org>

All rights reserved.

You may distribute this module under the terms of either the GNU
General Public License or the Artistic License, as specified in
the Perl README file.


=head1 SEE ALSO

L<SQL::Statement(3)>


=cut