summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl0/lib/CPAN/SQLite/Search.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl0/lib/CPAN/SQLite/Search.pm')
-rwxr-xr-xMaster/tlpkg/tlperl0/lib/CPAN/SQLite/Search.pm520
1 files changed, 520 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl0/lib/CPAN/SQLite/Search.pm b/Master/tlpkg/tlperl0/lib/CPAN/SQLite/Search.pm
new file mode 100755
index 00000000000..c09b549c606
--- /dev/null
+++ b/Master/tlpkg/tlperl0/lib/CPAN/SQLite/Search.pm
@@ -0,0 +1,520 @@
+package CPAN::SQLite::Search;
+use strict;
+use warnings;
+no warnings qw(redefine);
+use utf8;
+use CPAN::SQLite::Util qw($mode_info);
+use CPAN::SQLite::DBI::Search;
+
+our $max_results = 0;
+our $VERSION = '0.199';
+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};
+ 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}};
+ bless $self, $class;
+}
+
+package CPAN::SQLite::Search::author;
+use base qw(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 base qw(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 base qw(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;
+
+__END__
+
+=head1 NAME
+
+CPAN::SQLite::Search - perform queries on the database
+
+=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 containg
+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<dslip>, C<chapterid>, 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.
+
+=item * C<dslip_info>
+
+If C<dslip> is available, an array reference C<dslip_info> is supplied,
+each entry being a hash reference. The hash reference contains
+two keys - C<desc>, whose value is a general description of the
+what the dslip entry represents, and C<what>, whose value is
+a description of the entry itself.
+
+=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>, C<mod_vers>, and C<dslip>
+fields for the module.
+
+=item * C<dslip> and C<dslip_info>
+
+If the module name and distribution name are related by
+C<s/::/->, the C<dslip> and C<dslip_info> entries for
+that module are returned.
+
+=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 COPYRIGHT
+
+This software is copyright 2006 by Randy Kobes
+E<lt>r.kobes@uwinnipeg.caE<gt>. Use and
+redistribution are under the same terms as Perl itself.
+
+=cut
+