# $Id: Search.pm 79 2019-01-30 02:35:31Z stro $
package CPAN::SQLite::DBI::Search;
use strict;
use warnings;
BEGIN {
our $VERSION = '0.217';
$CPAN::SQLite::DBI::Search::info::VERSION = $VERSION;
$CPAN::SQLite::DBI::Search::mods::VERSION = $VERSION;
$CPAN::SQLite::DBI::Search::dists::VERSION = $VERSION;
$CPAN::SQLite::DBI::Search::auths::VERSION = $VERSION;
}
use parent 'CPAN::SQLite::DBI';
use CPAN::SQLite::DBI qw($tables $dbh);
use CPAN::SQLite::Util qw($full_id);
package CPAN::SQLite::DBI::Search::info;
use parent 'CPAN::SQLite::DBI::Search';
use CPAN::SQLite::DBI qw($dbh);
package CPAN::SQLite::DBI::Search::mods;
use parent 'CPAN::SQLite::DBI::Search';
use CPAN::SQLite::DBI qw($dbh);
package CPAN::SQLite::DBI::Search::dists;
use parent 'CPAN::SQLite::DBI::Search';
use CPAN::SQLite::DBI qw($dbh);
package CPAN::SQLite::DBI::Search::auths;
use parent 'CPAN::SQLite::DBI::Search';
use CPAN::SQLite::DBI qw($dbh);
package CPAN::SQLite::DBI::Search;
use parent 'CPAN::SQLite::DBI';
use CPAN::SQLite::DBI qw($tables $dbh);
use CPAN::SQLite::Util qw($full_id download);
sub fetch {
my ($self, %args) = @_;
my $fields = $args{fields};
my $search = $args{search};
my @fields = ref($fields) eq 'ARRAY' ? @{$fields} : ($fields);
my $sql = $self->sql_statement(%args) or do {
$self->{error} = 'Error constructing sql statement: ' . $self->{error};
return;
};
my $sth = $dbh->prepare($sql) or do {
$self->db_error();
return;
};
$sth->execute() or do {
$self->db_error($sth);
return;
};
if (not $search->{wantarray}) {
my (%results, $results);
@results{@fields} = $sth->fetchrow_array;
$results = ($sth->rows == 0) ? undef : \%results;
$sth->finish;
undef $sth;
$self->extra_info($results) if $results;
return $results;
} else {
my (%hash, $results);
while (@hash{@fields} = $sth->fetchrow_array) {
my %tmp = %hash;
$self->extra_info(\%tmp);
push @{$results}, \%tmp;
}
$results = undef if ($sth->rows == 0);
$sth->finish;
undef $sth;
return $results;
}
}
sub fetch_and_set {
my ($self, %args) = @_;
my $fields = $args{fields};
my $search = $args{search};
my $meta_obj = $args{meta_obj};
die "Please supply a CPAN::SQLite::Meta::* object"
unless ($meta_obj and ref($meta_obj) =~ /^CPAN::SQLite::META/);
my @fields = ref($fields) eq 'ARRAY' ? @{$fields} : ($fields);
my $sql = $self->sql_statement(%args) or do {
$self->{error} = 'Error constructing sql statement: ' . $self->{error};
return;
};
my $sth = $dbh->prepare($sql) or do {
$self->db_error();
return;
};
$sth->execute() or do {
$self->db_error($sth);
return;
};
my $want_ids = $args{want_ids};
my $set_list = $args{set_list};
my $download = $args{download};
if (not $search->{wantarray}) {
my (%results, %meta_results, $results);
@results{@fields} = $sth->fetchrow_array;
$results = ($sth->rows == 0) ? undef : \%results;
$sth->finish;
undef $sth;
return unless $results;
$self->extra_info($results);
$meta_obj->set_data($results);
if ($want_ids) {
$meta_results{dist_id} = $results{dist_id};
$meta_results{download} = download($results{cpanid}, $results{dist_file});
return \%meta_results;
} else {
return 1;
}
} else {
my (%hash, $meta_results);
while (@hash{@fields} = $sth->fetchrow_array) {
my %tmp = %hash;
if ($set_list) {
push @{$meta_results}, \%tmp;
} else {
$self->extra_info(\%tmp);
$meta_obj->set_data(\%tmp);
if ($want_ids) {
my $download = download($tmp{cpanid}, $tmp{dist_file});
push @{$meta_results},
{
dist_id => $tmp{dist_id},
download => $download
};
}
}
}
$meta_results = undef if ($sth->rows == 0);
$sth->finish;
undef $sth;
return unless $meta_results;
$meta_obj->set_list_data($meta_results, $download) if $set_list;
return $want_ids ? $meta_results : 1;
}
}
sub extra_info {
my ($self, $results) = @_;
if ($results->{cpanid} and $results->{dist_file}) {
$results->{download} = download($results->{cpanid}, $results->{dist_file});
}
return;
}
sub sql_statement {
my ($self, %args) = @_;
my $search = $args{search};
my $distinct = $search->{distinct} ? 'DISTINCT' : '';
my $table = $args{table};
my $fields = $args{fields};
my @fields = ref($fields) eq 'ARRAY' ? @{$fields} : ($fields);
for (@fields) {
$_ = $full_id->{$_} if $full_id->{$_};
}
my $sql = qq{SELECT $distinct } . join(',', @fields);
my $where = '';
my $type = $search->{type};
QUERY: {
($type eq 'query') and do {
my $value = $search->{value};
last QUERY if ($value eq '^');
my $name = $search->{name};
my $text = $search->{text};
my $use_like = ($value =~ /^\^?[A-Za-z0-9_\\\:\-]+$/) ? 1 : 0;
my $prepend = '%';
if ($use_like and $value =~ /^\^/) {
$prepend = '';
$value =~ s/^\^//;
$value =~ s{\\}{}g;
}
$where =
$use_like
? qq{$name LIKE '$prepend$value%'}
: qq{$name REGEXP '(?i:$value)'};
if ($name eq 'cpanid') {
$where .=
$use_like
? qq{ OR $text LIKE '$prepend$value%'}
: qq{ OR $text REGEXP '(?i:$value)'};
}
last QUERY;
};
($type eq 'id') and do {
$where = qq{ $search->{id} = $search->{value} };
last QUERY;
};
($type eq 'name') and do {
$where = qq{ $search->{name} = '$search->{value}' };
last QUERY;
};
warn qq{Unknown query type};
return;
}
my $join;
$sql .= ' FROM ' . $table;
my $left_join = $args{join} || $args{left_join};
if ($left_join) {
if (ref($left_join) eq 'HASH') {
foreach my $key (keys %$left_join) {
my $id = $left_join->{$key};
$sql .= " LEFT JOIN $key ON $table.$id=$key.$id ";
}
}
}
if ($where) {
$sql .= ' WHERE ( ' . $where . ' )';
$sql .= ' AND (' . $join . ')' if $join;
} else {
$sql .= ' WHERE (' . $join . ')' if $join;
}
my $order_by = '';
if (my $user_order_by = $args{order_by}) {
$order_by = $order_by ? "$order_by,$user_order_by" : $user_order_by;
}
if ($order_by and $where) {
$sql .= qq{ ORDER BY $order_by };
}
if (my $limit = $args{limit}) {
my ($min, $max) =
ref($limit) eq 'HASH'
? ($limit->{min} || 0, $limit->{max})
: (0, $limit);
$sql .= qq{ LIMIT $min,$max };
}
return $sql;
}
1;
=head1 NAME
CPAN::SQLite::DBI::Search - DBI information for searching the CPAN::SQLite database
=head1 VERSION
version 0.217
=head1 DESCRIPTION
This module provides methods for L<CPAN::SQLite::Search> for searching
the C<CPAN::SQLite> database. There are two main methods.
=over
=item C<fetch>
This takes information from C<CPAN::SQLite::Search> and sets up
a query on the database, returning the results found.
=item C<sql_statement>
This is used by the C<fetch> method to construct the appropriate
SQL statement.
=back
=head1 SEE ALSO
L<CPAN::SQLite::Search>
=cut