This file is indexed.

/usr/share/perl5/Class/DBI/Query.pm is in libclass-dbi-perl 3.0.17-4.

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
package Class::DBI::Query::Base;

use strict;

use base 'Class::Accessor';
use Storable 'dclone';

sub new {
	my ($class, $fields) = @_;
	my $self = $class->SUPER::new();
	foreach my $key (keys %{ $fields || {} }) {
		$self->set($key => $fields->{$key});
	}
	$self;
}

sub get {
	my ($self, $key) = @_;
	my @vals = @{ $self->{$key} || [] };
	return wantarray ? @vals : $vals[0];
}

sub set {
	my ($self, $key, @args) = @_;
	@args = map { ref $_ eq "ARRAY" ? @$_ : $_ } @args;
	$self->{$key} = [@args];
}

sub clone { dclone shift }

package Class::DBI::Query;

use base 'Class::DBI::Query::Base';

__PACKAGE__->mk_accessors(
	qw/
		owner essential sqlname where_clause restrictions order_by kings
		/
);

=head1 NAME

Class::DBI::Query - Deprecated SQL manager for Class::DBI

=head1 SYNOPSIS

	my $sth = Class::DBI::Query
		->new({ 
			owner => $class, 
			sqlname => $type, 
			essential => \@columns, 
			where_columns => \@where_cols,
		})
		->run($val);


=head1 DESCRIPTION

This abstracts away many of the details of the Class::DBI underlying SQL
mechanism. For the most part you probably don't want to be interfacing
directly with this.

The underlying mechanisms are not yet stable, and are subject to change
at any time.

=cut

=head1 OPTIONS

A Query can have many options set before executing. Most can either be
passed as an option to new(), or set later if you are building the query
up dynamically:

=head2 owner

The Class::DBI subclass that 'owns' this query. In the vast majority
of cases a query will return objects - the owner is the class of
which instances will be returned. 

=head2 sqlname

This should be the name of a query set up using set_sql.

=head2 where_clause

This is the raw SQL that will substituted into the 'WHERE %s' in your
query. If you have multiple %s's in your query then you should supply
a listref of where_clauses. This SQL can include placeholders, which will be 
used when you call run().

=head2 essential

When retrieving rows from the database that match the WHERE clause of
the query, these are the columns that we fetch back and pre-load the
resulting objects with. By default this is the Essential column group
of the owner class.

=head1 METHODS

=head2 where()

	$query->where($match, @columns);

This will extend your 'WHERE' clause by adding a 'AND $column = ?' (or
whatever $match is, isntead of "=") for each column passed. If you have
multiple WHERE clauses this will extend the last one.

=cut

sub new {
	my ($class, $self) = @_;
	require Carp;
	Carp::carp "Class::DBI::Query deprecated";
	$self->{owner}     ||= caller;
	$self->{kings}     ||= $self->{owner};
	$self->{essential} ||= [ $self->{owner}->_essential ];
	$self->{sqlname}   ||= 'SearchSQL';
	return $class->SUPER::new($self);
}

sub _essential_string {
	my $self  = shift;
	my $table = $self->owner->table_alias;
	join ", ", map "$table.$_", $self->essential;
}

sub where {
	my ($self, $type, @cols) = @_;
	my @where = $self->where_clause;
	my $last = pop @where || "";
	$last .= join " AND ", $self->restrictions;
	$last .= " ORDER BY " . $self->order_by if $self->order_by;
	push @where, $last;
	return @where;
}

sub add_restriction {
	my ($self, $sql) = @_;
	$self->restrictions($self->restrictions, $sql);
}

sub tables {
	my $self = shift;
	join ", ", map { join " ", $_->table, $_->table_alias } $self->kings;
}

# my $sth = $query->run(@vals);
# Runs the SQL set up in $sqlname, e.g.
#
# SELECT %s (Essential)
# FROM   %s (Table)
# WHERE  %s = ? (SelectCol = @vals)
#
# substituting the relevant values via sprintf, and then executing with $select_val.

sub run {
	my $self = shift;
	my $owner = $self->owner or Class::DBI->_croak("Query has no owner");
	$owner = ref $owner || $owner;
	$owner->can('db_Main') or $owner->_croak("No database connection defined");
	my $sql_name = $self->sqlname or $owner->_croak("Query has no SQL");

	my @sel_vals = @_
		? ref $_[0] eq "ARRAY" ? @{ $_[0] } : (@_)
		: ();
	my $sql_method = "sql_$sql_name";

	my $sth;
	eval {
		$sth =
			$owner->$sql_method($self->_essential_string, $self->tables,
			$self->where);
		$sth->execute(@sel_vals);
	};
	if ($@) {
		$owner->_croak(
			"Can't select for $owner using '$sth->{Statement}' ($sql_name): $@",
			err => $@);
		return;
	}
	return $sth;
}

1;