This file is indexed.

/usr/share/perl5/Class/DBI/Search/Basic.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
package Class::DBI::Search::Basic;

=head1 NAME

Class::DBI::Search::Basic - Simple Class::DBI search

=head1 SYNOPSIS

	my $searcher = Class::DBI::Search::Basic->new(
		$cdbi_class, @search_args
	);

	my @results = $searcher->run_search;

	# Over in your Class::DBI subclass:
	
	__PACKAGE__->add_searcher(
		search  => "Class::DBI::Search::Basic",
	  isearch => "Class::DBI::Search::Plugin::CaseInsensitive",
	);

=head1 DESCRIPTION

This is the start of a pluggable Search infrastructure for Class::DBI.

At the minute Class::DBI::Search::Basic doubles up as both the default
search within Class::DBI as well as the search base class. We will
probably need to tease this apart more later and create an abstract base
class for search plugins.

=head1 METHODS

=head2 new 

	my $searcher = Class::DBI::Search::Basic->new(
		$cdbi_class, @search_args
	);

A Searcher is created with the class to which the results will belong,
and the arguments passed to the search call by the user.

=head2 opt 

	if (my $order = $self->opt('order_by')) { ... }

The arguments passed to search may contain an options hash. This will
return the value of a given option.

=head2 run_search

	my @results = $searcher->run_search;
	my $iterator = $searcher->run_search;

Actually run the search.

=head1 SUBCLASSING

=head2 sql / bind / fragment

The actual mechanics of generating the SQL and executing it split up
into a variety of methods for you to override.

run_search() is implemented as:

  return $cdbi->sth_to_objects($self->sql, $self->bind);

Where sql() is 

  $cdbi->sql_Retrieve($self->fragment);


There are also a variety of private methods underneath this that could
be overridden in a pinch, but if you need to do this I'd rather you let
me know so that I can make them public, or at least so that I don't
remove them from under your feet.

=cut

use strict;
use warnings;

use base 'Class::Accessor::Fast';
__PACKAGE__->mk_accessors(qw/class args opts type/);

sub new {
	my ($me, $proto, @args) = @_;
	my ($args, $opts) = $me->_unpack_args(@args);
	bless {
		class => ref $proto || $proto,
		args  => $args,
		opts  => $opts,
		type  => "=",
	} => $me;
}

sub opt {
	my ($self, $option) = @_;
	$self->{opts}->{$option};
}

sub _unpack_args {
	my ($self, @args) = @_;
	@args = %{ $args[0] } if ref $args[0] eq "HASH";
	my $opts = @args % 2 ? pop @args : {};
	return (\@args, $opts);
}

sub _search_for {
	my $self  = shift;
	my @args  = @{ $self->{args} };
	my $class = $self->{class};
	my %search_for;
	while (my ($col, $val) = splice @args, 0, 2) {
		my $column = $class->find_column($col)
			|| (List::Util::first { $_->accessor eq $col } $class->columns)
			|| $class->_croak("$col is not a column of $class");
		$search_for{$column} = $class->_deflated_column($column, $val);
	}
	return \%search_for;
}

sub _qual_bind {
	my $self = shift;
	$self->{_qual_bind} ||= do {
		my $search_for = $self->_search_for;
		my $type       = $self->type;
		my (@qual, @bind);
		for my $column (sort keys %$search_for) {    # sort for prepare_cached
			if (defined(my $value = $search_for->{$column})) {
				push @qual, "$column $type ?";
				push @bind, $value;
			} else {

				# perhaps _carp if $type ne "="
				push @qual, "$column IS NULL";
			}
		}
		[ \@qual, \@bind ];
	};
}

sub _qual {
	my $self = shift;
	$self->{_qual} ||= $self->_qual_bind->[0];
}

sub bind {
	my $self = shift;
	$self->{_bind} ||= $self->_qual_bind->[1];
}

sub fragment {
	my $self = shift;
	my $frag = join " AND ", @{ $self->_qual };
	if (my $order = $self->opt('order_by')) {
		$frag .= " ORDER BY $order";
	}
	return $frag;
}

sub sql {
	my $self = shift;
	return $self->class->sql_Retrieve($self->fragment);
}

sub run_search {
	my $self = shift;
	my $cdbi = $self->class;
	return $cdbi->sth_to_objects($self->sql, $self->bind);
}

1;