Initial Commit
This commit is contained in:
Riley Schneider
517
database/perl/vendor/lib/CPAN/SQLite/Search.pm
vendored
Normal file
517
database/perl/vendor/lib/CPAN/SQLite/Search.pm
vendored
Normal file
@@ -0,0 +1,517 @@
|
||||
# $Id: Search.pm 84 2020-05-31 06:29:34Z stro $
|
||||
|
||||
package CPAN::SQLite::Search;
|
||||
use strict;
|
||||
use warnings;
|
||||
no warnings qw(redefine);
|
||||
|
||||
our $VERSION = '0.219';
|
||||
|
||||
use English qw/-no_match_vars/;
|
||||
|
||||
use utf8;
|
||||
use CPAN::SQLite::Util qw($mode_info);
|
||||
use CPAN::SQLite::DBI::Search;
|
||||
|
||||
our $max_results = 0;
|
||||
|
||||
my $cdbi_query;
|
||||
|
||||
my %mode2obj;
|
||||
$mode2obj{$_} = __PACKAGE__ . '::' . $_ for (qw(dist author module));
|
||||
|
||||
sub new {
|
||||
my ($class, %args) = @_;
|
||||
$cdbi_query = CPAN::SQLite::DBI::Search->new(%args);
|
||||
$max_results = $args{max_results} if $args{max_results};
|
||||
my $self = { results => undef, error => '', %args };
|
||||
return bless $self, $class;
|
||||
}
|
||||
|
||||
sub query {
|
||||
my ($self, %args) = @_;
|
||||
my $mode = $args{mode} || 'module';
|
||||
unless ($mode) {
|
||||
$self->{error} = q{Please specify a 'mode' argument};
|
||||
return;
|
||||
}
|
||||
my $info = $mode_info->{$mode};
|
||||
my $table = $info->{table};
|
||||
unless ($table) {
|
||||
$self->{error} = qq{No table exists for '$mode'};
|
||||
return;
|
||||
}
|
||||
my $cdbi = $cdbi_query->{objs}->{$table};
|
||||
my $class = 'CPAN::SQLite::DBI::Search::' . $table;
|
||||
unless ($cdbi and ref($cdbi) eq $class) {
|
||||
$self->{error} = qq{No cdbi object exists for '$table'};
|
||||
return;
|
||||
}
|
||||
my $obj;
|
||||
eval { $obj = $mode2obj{$mode}->make(table => $table, cdbi => $cdbi); };
|
||||
if ($@) {
|
||||
$self->{error} = qq{Mode '$mode' is not known};
|
||||
return;
|
||||
}
|
||||
my $value;
|
||||
my $search = {
|
||||
name => $info->{name},
|
||||
text => $info->{text},
|
||||
id => $info->{id},
|
||||
};
|
||||
TYPE: {
|
||||
($value = $args{query}) and do {
|
||||
$search->{value} = $value;
|
||||
$search->{type} = 'query';
|
||||
$search->{wantarray} = 1;
|
||||
last TYPE;
|
||||
};
|
||||
($value = $args{id}) and do {
|
||||
$search->{value} = $value;
|
||||
$search->{type} = 'id';
|
||||
$search->{distinct} = 1;
|
||||
last TYPE;
|
||||
};
|
||||
($value = $args{name}) and do {
|
||||
$search->{value} = $value;
|
||||
$search->{type} = 'name';
|
||||
$search->{distinct} = 1;
|
||||
last TYPE;
|
||||
};
|
||||
$self->{error} = q{Cannot determine the type of search};
|
||||
return;
|
||||
}
|
||||
|
||||
$obj->search(search => $search, meta_obj => $self->{meta_obj});
|
||||
$self->{results} = $obj->{results};
|
||||
if (my $error = $obj->{error}) {
|
||||
$self->{error} = $error;
|
||||
return;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub make {
|
||||
my ($class, %args) = @_;
|
||||
for (qw(table cdbi)) {
|
||||
die qq{Must supply an '$_' arg} unless defined $args{$_};
|
||||
}
|
||||
my $self = {
|
||||
results => undef,
|
||||
error => '',
|
||||
table => $args{table},
|
||||
cdbi => $args{cdbi} };
|
||||
return bless $self, $class;
|
||||
}
|
||||
|
||||
package CPAN::SQLite::Search::author;
|
||||
use parent 'CPAN::SQLite::Search';
|
||||
|
||||
sub search {
|
||||
my ($self, %args) = @_;
|
||||
return unless $args{search};
|
||||
my $cdbi = $self->{cdbi};
|
||||
my $meta_obj = $args{meta_obj};
|
||||
$args{fields} = [qw(auth_id cpanid fullname email)];
|
||||
$args{table} = 'auths';
|
||||
if ($max_results) {
|
||||
$args{limit} = $max_results;
|
||||
}
|
||||
$args{order_by} = 'cpanid';
|
||||
my $results;
|
||||
return unless $results = (
|
||||
$meta_obj
|
||||
? $cdbi->fetch_and_set(%args)
|
||||
: $cdbi->fetch(%args));
|
||||
unless ($meta_obj) {
|
||||
$self->{results} = (ref($results) eq 'ARRAY' and scalar @$results == 1) ? $results->[0] : $results;
|
||||
}
|
||||
return 1 if $meta_obj;
|
||||
|
||||
# The following will get all the dists associated with the cpanid
|
||||
$args{join} = undef;
|
||||
$args{table} = 'dists';
|
||||
$args{fields} = [qw(dist_file dist_abs)];
|
||||
$args{order_by} = 'dist_file';
|
||||
my @items = (ref($results) eq 'ARRAY') ? @$results : ($results);
|
||||
foreach my $item (@items) {
|
||||
my $search = {
|
||||
id => 'auth_id',
|
||||
value => $item->{auth_id},
|
||||
type => 'id',
|
||||
wantarray => 1,
|
||||
};
|
||||
my $dists;
|
||||
next unless ($dists = $cdbi->fetch(%args, search => $search));
|
||||
$item->{dists} = (ref($dists) eq 'ARRAY') ? $dists : [$dists];
|
||||
}
|
||||
$self->{results} = (ref($results) eq 'ARRAY' and scalar @$results == 1) ? $results->[0] : $results;
|
||||
return 1;
|
||||
}
|
||||
|
||||
package CPAN::SQLite::Search::module;
|
||||
use parent 'CPAN::SQLite::Search';
|
||||
|
||||
sub search {
|
||||
my ($self, %args) = @_;
|
||||
return unless $args{search};
|
||||
my $cdbi = $self->{cdbi};
|
||||
my $meta_obj = $args{meta_obj};
|
||||
|
||||
$args{fields} = [
|
||||
qw(mod_id mod_name mod_abs mod_vers
|
||||
dist_id dist_name dist_file dist_vers dist_abs
|
||||
auth_id cpanid fullname email)
|
||||
];
|
||||
$args{table} = 'dists';
|
||||
$args{join} = {
|
||||
mods => 'dist_id',
|
||||
auths => 'auth_id',
|
||||
};
|
||||
$args{order_by} = 'mod_name';
|
||||
if ($max_results) {
|
||||
$args{limit} = $max_results;
|
||||
}
|
||||
my $results;
|
||||
return unless $results = (
|
||||
$meta_obj
|
||||
? $cdbi->fetch_and_set(%args, want_ids => 1)
|
||||
: $cdbi->fetch(%args));
|
||||
|
||||
# if running under CPAN.pm, need to build a list of modules
|
||||
# contained in the distribution
|
||||
if ($meta_obj) {
|
||||
my %seen;
|
||||
$args{join} = undef;
|
||||
$args{table} = 'mods';
|
||||
my @items = (ref($results) eq 'ARRAY') ? @$results : ($results);
|
||||
foreach my $item (@items) {
|
||||
my $dist_id = $item->{dist_id};
|
||||
next if $seen{$dist_id};
|
||||
$args{fields} = [qw(mod_name mod_abs)];
|
||||
$args{order_by} = 'mod_name';
|
||||
$args{join} = undef;
|
||||
my $search = {
|
||||
id => 'dist_id',
|
||||
value => $item->{dist_id},
|
||||
type => 'id',
|
||||
wantarray => 1,
|
||||
};
|
||||
$seen{$dist_id}++;
|
||||
my $mods;
|
||||
next unless $mods = $cdbi->fetch_and_set(
|
||||
%args,
|
||||
search => $search,
|
||||
set_list => 1,
|
||||
download => $item->{download});
|
||||
}
|
||||
}
|
||||
unless ($meta_obj) {
|
||||
$self->{results} = (ref($results) eq 'ARRAY' and scalar @$results == 1) ? $results->[0] : $results;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
package CPAN::SQLite::Search::dist;
|
||||
use parent 'CPAN::SQLite::Search';
|
||||
|
||||
sub search {
|
||||
my ($self, %args) = @_;
|
||||
return unless $args{search};
|
||||
my $cdbi = $self->{cdbi};
|
||||
my $meta_obj = $args{meta_obj};
|
||||
|
||||
$args{fields} = [
|
||||
qw(dist_id dist_name dist_abs dist_vers
|
||||
dist_file auth_id cpanid fullname email)
|
||||
];
|
||||
$args{table} = 'dists';
|
||||
$args{join} = { auths => 'auth_id' };
|
||||
$args{order_by} = 'dist_name';
|
||||
if ($max_results) {
|
||||
$args{limit} = $max_results;
|
||||
}
|
||||
my $results;
|
||||
return unless $results = (
|
||||
$meta_obj
|
||||
? $cdbi->fetch_and_set(%args, want_ids => 1)
|
||||
: $cdbi->fetch(%args));
|
||||
|
||||
$args{join} = undef;
|
||||
$args{table} = 'mods';
|
||||
$args{fields} = [qw(mod_name mod_abs)];
|
||||
$args{order_by} = 'mod_name';
|
||||
my @items = (ref($results) eq 'ARRAY') ? @$results : ($results);
|
||||
foreach my $item (@items) {
|
||||
my $search = {
|
||||
id => 'dist_id',
|
||||
value => $item->{dist_id},
|
||||
type => 'id',
|
||||
wantarray => 1,
|
||||
};
|
||||
my $mods;
|
||||
next
|
||||
unless $mods = (
|
||||
$meta_obj
|
||||
? $cdbi->fetch_and_set(
|
||||
%args,
|
||||
search => $search,
|
||||
set_list => 1,
|
||||
download => $item->{download})
|
||||
: $cdbi->fetch(%args, search => $search));
|
||||
next if $meta_obj;
|
||||
$item->{mods} = (ref($mods) eq 'ARRAY') ? $mods : [$mods];
|
||||
}
|
||||
unless ($meta_obj) {
|
||||
$self->{results} = (ref($results) eq 'ARRAY' and scalar @$results == 1) ? $results->[0] : $results;
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
CPAN::SQLite::Search - perform queries on the database
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.219
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
my $max_results = 200;
|
||||
my $query = CPAN::SQLite::Search->new(db_dir => $db_dir,
|
||||
db_name => $db_name,
|
||||
max_results => $max_results);
|
||||
$query->query(mode => 'module', name => 'Net::FTP');
|
||||
my $results = $query->{results};
|
||||
|
||||
=head1 CONSTRUCTING THE QUERY
|
||||
|
||||
This module queries the database via various types of queries
|
||||
and returns the results for subsequent display. The
|
||||
C<CPAN::SQLite::Search> object is created via the C<new> method as
|
||||
|
||||
my $query = CPAN::SQLite::Search->new(db_dir => $db_dir,
|
||||
db_name => $db_name,
|
||||
max_results => $max_results);
|
||||
|
||||
which takes as arguments
|
||||
|
||||
=over 3
|
||||
|
||||
=item * db_dir =E<gt> $db_dir
|
||||
|
||||
This is the directory where the database file is stored. This is
|
||||
optional if the C<CPAN> option is given.
|
||||
|
||||
=item * CPAN =E<gt> $CPAN
|
||||
|
||||
This option specifies the C<cpan_home> directory of an
|
||||
already configured CPAN.pm, which is where the database
|
||||
file will be stored if C<db_dir> is not given.
|
||||
|
||||
=item * max_results =E<gt> $max_results
|
||||
|
||||
This is the maximum value used to limit the number of results
|
||||
returned under a user query. If not specified, a value contained
|
||||
within C<CPAN::SQLite::Search> will be used.
|
||||
|
||||
=back
|
||||
|
||||
A basic query then is constructed as
|
||||
|
||||
$query->query(mode => $mode, $type => $value);
|
||||
|
||||
with the results available as
|
||||
|
||||
my $results = $query->{results}
|
||||
|
||||
There are three basic modes:
|
||||
|
||||
=over 3
|
||||
|
||||
=item * module
|
||||
|
||||
This is for information on modules.
|
||||
|
||||
=item * dist
|
||||
|
||||
This is for information on distributions.
|
||||
|
||||
=item * author
|
||||
|
||||
This is for information on CPAN authors or cpanids.
|
||||
|
||||
=back
|
||||
|
||||
=head2 C<module>, C<dist>, and C<author> modes
|
||||
|
||||
For a mode of C<module>, C<dist>, and C<author>, there are
|
||||
four basic options to be used for the C<$type =E<gt> $value> option:
|
||||
|
||||
=over 3
|
||||
|
||||
=item * query =E<gt> $query_term
|
||||
|
||||
This will search through module names,
|
||||
distribution names, or CPAN author names and ids
|
||||
(for C<module>, C<dist>, and C<author> modes
|
||||
respectively). The results are case insensitive,
|
||||
and Perl regular expressions for the C<$query_term>
|
||||
are recognized.
|
||||
|
||||
=item * name =E<gt> $name
|
||||
|
||||
This will report exact matches (in a case sensitive manner)
|
||||
for the module name, distribution name, or CPAN author id,
|
||||
for C<module>, C<dist>, and C<author> modes
|
||||
respectively.
|
||||
|
||||
=item * id =E<gt> $id
|
||||
|
||||
This will look up information on the primary key according
|
||||
to the mode specified. This is more for internal use,
|
||||
to help speed up queries; using this "publically" is
|
||||
probably not a good idea, as the ids may change over the
|
||||
course of time.
|
||||
|
||||
=back
|
||||
|
||||
=head1 RESULTS
|
||||
|
||||
After making the query, the results can be accessed through
|
||||
|
||||
my $results = $query->{results};
|
||||
|
||||
No results either can mean no matches were found, or
|
||||
else an error in making the query resulted (in which case,
|
||||
a brief error message is contained in C<$query-E<gt>{error}>).
|
||||
Assuming there are results, what is returned depends on
|
||||
the mode and on the type of query. See L<CPAN::SQLite::Populate>
|
||||
for a description of the fields in the various tables
|
||||
listed below - these fields are used as the keys of the
|
||||
hash references that arise.
|
||||
|
||||
=head2 C<author> mode
|
||||
|
||||
=over 3
|
||||
|
||||
=item * C<name> or C<id> query
|
||||
|
||||
This returns the C<auth_id>, C<cpanid>, C<email>, and C<fullname>
|
||||
of the C<auths> table. As well, an array reference
|
||||
C<$results-E<gt>{dists}> is returned representing
|
||||
all distributions associated with that C<cpanid> - each
|
||||
member of the array reference is a hash reference
|
||||
describing the C<dist_id>, C<dist_name>,
|
||||
C<dist_abs>, C<dist_vers>, and C<dist_file> fields in the
|
||||
C<dists> table. An additional entry, C<download>, is
|
||||
supplied, which can be used as C<$CPAN/authors/id/$download>
|
||||
to specify the url of the distribution.
|
||||
|
||||
=item * C<query> query
|
||||
|
||||
If this results in more than one match, an array reference
|
||||
is returned, each member of which is a hash reference containing
|
||||
the C<auth_id>, C<cpanid>, and C<fullname> fields. If there
|
||||
is only one result found, a C<name> query based on the
|
||||
matched C<cpanid> is performed.
|
||||
|
||||
=back
|
||||
|
||||
=head2 C<module> mode
|
||||
|
||||
=over 3
|
||||
|
||||
=item * C<name> or C<id> query
|
||||
|
||||
This returns the C<mod_id>, C<mod_name>, C<mod_abs>, C<mod_vers>,
|
||||
C<dist_id>, C<dist_name>, C<dist_file>,
|
||||
C<auth_id>, C<cpanid>, C<fullname>, and C<email>
|
||||
of the C<auths>, C<mods>, and C<dists> tables.
|
||||
As well, the following entries may be present.
|
||||
|
||||
=over 3
|
||||
|
||||
=item * C<download>
|
||||
|
||||
This can be used as C<$CPAN/authors/id/$download>
|
||||
to specify the url of the distribution.
|
||||
|
||||
=back
|
||||
|
||||
=item * C<query> query
|
||||
|
||||
If this results in more than one match, an array reference
|
||||
is returned, each member of which is a hash reference containing
|
||||
the C<mod_id>, C<mod_name>, C<mod_abs>, C<mod_abs>, C<dist_vers>, C<dist_abs>,
|
||||
C<auth_id>, C<cpanid>, C<dist_id>, C<dist_name>, and C<dist_file>.
|
||||
As well, a C<download> field which
|
||||
can be used as C<$CPAN/authors/id/$download>
|
||||
to specify the url of the distribution is provided. If there
|
||||
is only one result found, a C<name> query based on the
|
||||
matched C<mod_name> is performed.
|
||||
|
||||
=back
|
||||
|
||||
=head2 C<dist> mode
|
||||
|
||||
=over 3
|
||||
|
||||
=item * C<name> or C<id> query
|
||||
|
||||
This returns the C<dist_id>, C<dist_name>, C<dist_abs>, C<dist_vers>,
|
||||
C<dist_file>, C<size>, C<birth>, C<auth_id>, C<cpanid>, and C<fullname>
|
||||
of the C<auths>, C<mods>, and C<dists> tables.
|
||||
As well, the following entries may be present.
|
||||
|
||||
=over 3
|
||||
|
||||
=item * C<download>
|
||||
|
||||
This can be used as C<$CPAN/authors/id/$download>
|
||||
to specify the url of the distribution.
|
||||
|
||||
=item * C<mods>
|
||||
|
||||
This is an array reference containing information on the
|
||||
modules present. Each entry is a hash reference containing the
|
||||
C<mod_id>, C<mod_name>, C<mod_abs>, and C<mod_vers>
|
||||
fields for the module.
|
||||
|
||||
=back
|
||||
|
||||
=item * C<query> query
|
||||
|
||||
If this results in more than one match, an array reference
|
||||
is returned, each member of which is a hash reference containing
|
||||
the C<dist_id>, C<dist_name>, C<dist_abs>, C<dist_file>,
|
||||
and C<cpanid> fields. As well, a C<download> field which
|
||||
can be used as C<$CPAN/authors/id/$download>
|
||||
to specify the url of the distribution is provided. If there
|
||||
is only one result found, a C<name> query based on the
|
||||
matched C<dist_name> is performed.
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<CPAN::SQLite::Populate>.
|
||||
|
||||
=head1 AUTHORS
|
||||
|
||||
Randy Kobes (passed away on September 18, 2010)
|
||||
|
||||
Serguei Trouchelle E<lt>stro@cpan.orgE<gt>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright 2006,2008 by Randy Kobes E<lt>r.kobes@uwinnipeg.caE<gt>.
|
||||
|
||||
Copyright 2011-2013 by Serguei Trouchelle E<lt>stro@cpan.orgE<gt>.
|
||||
|
||||
Use and redistribution are under the same terms as Perl itself.
|
||||
|
||||
=cut
|
||||
Reference in New Issue
Block a user