# $Id: Search.pm 53 2015-07-14 23:14:34Z stro $ package CPAN::SQLite::Search; use strict; use warnings; no warnings qw(redefine); our $VERSION = '0.211'; 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 chapterid dslip 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_dslip 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; } package CPAN::SQLite::Search; sub mod_subchapter { my ($self, $mod_name) = @_; (my $sc = $mod_name) =~ s{^([^:]+).*}{$1}; return $sc; } sub dist_subchapter { my ($self, $dist_name) = @_; (my $sc = $dist_name) =~ s{^([^-]+).*}{$1}; return $sc; } 1; =head1 NAME CPAN::SQLite::Search - perform queries on the database =head1 VERSION version 0.211 =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 object is created via the C 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 $db_dir This is the directory where the database file is stored. This is optional if the C option is given. =item * CPAN =E $CPAN This option specifies the C directory of an already configured CPAN.pm, which is where the database file will be stored if C is not given. =item * max_results =E $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 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, C, and C modes For a mode of C, C, and C, there are four basic options to be used for the C<$type =E $value> option: =over 3 =item * query =E $query_term This will search through module names, distribution names, or CPAN author names and ids (for C, C, and C modes respectively). The results are case insensitive, and Perl regular expressions for the C<$query_term> are recognized. =item * name =E $name This will report exact matches (in a case sensitive manner) for the module name, distribution name, or CPAN author id, for C, C, and C modes respectively. =item * id =E $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{error}>). Assuming there are results, what is returned depends on the mode and on the type of query. See L 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 mode =over 3 =item * C or C query This returns the C, C, C, and C of the C table. As well, an array reference C<$results-E{dists}> is returned representing all distributions associated with that C - each member of the array reference is a hash reference describing the C, C, C, C, and C fields in the C table. An additional entry, C, is supplied, which can be used as C<$CPAN/authors/id/$download> to specify the url of the distribution. =item * C 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, C, and C fields. If there is only one result found, a C query based on the matched C is performed. =back =head2 C mode =over 3 =item * C or C query This returns the C, C, C, C, C, C, C, C, C, C, C, C, and C of the C, C, and C tables. As well, the following entries may be present. =over 3 =item * C This can be used as C<$CPAN/authors/id/$download> to specify the url of the distribution. =item * C If C is available, an array reference C is supplied, each entry being a hash reference. The hash reference contains two keys - C, whose value is a general description of the what the dslip entry represents, and C, whose value is a description of the entry itself. =back =item * C 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, C, C, C, C, C, C, C, C, C, and C. As well, a C 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 query based on the matched C is performed. =back =head2 C mode =over 3 =item * C or C query This returns the C, C, C, C, C, C, C, C, C, and C of the C, C, and C tables. As well, the following entries may be present. =over 3 =item * C This can be used as C<$CPAN/authors/id/$download> to specify the url of the distribution. =item * C This is an array reference containing information on the modules present. Each entry is a hash reference containing the C, C, C, C, and C fields for the module. =item * C and C If the module name and distribution name are related by C, the C and C entries for that module are returned. =back =item * C 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, C, C, C, and C fields. As well, a C 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 query based on the matched C is performed. =back =head1 SEE ALSO L. =head1 AUTHORS Randy Kobes (passed away on September 18, 2010) Serguei Trouchelle Estro@cpan.orgE =head1 COPYRIGHT Copyright 2006,2008 by Randy Kobes Er.kobes@uwinnipeg.caE. Copyright 2011-2013 by Serguei Trouchelle Estro@cpan.orgE. Use and redistribution are under the same terms as Perl itself. =cut