File Coverage

blib/lib/CPAN/SQLite/Search.pm

Criterion	Covered	Total	%
statement	150	169	88.7
branch	60	84	71.4
condition	10	17	58.8
subroutine	16	16	100.0
pod	1	3	33.3
total	237	289	82.0

# $Id: Search.pm 85 2022-10-29 05:44:36Z stro $

package CPAN::SQLite::Search;
use strict;
use warnings;
no warnings qw(redefine);

our $VERSION = '0.220';

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.220

=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, 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.

=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, and C
fields for the module.

=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 [e-mail]

=head1 COPYRIGHT

Copyright 2006,2008 by Randy Kobes [e-mail].

Copyright 2011-2013 by Serguei Trouchelle [e-mail].

Use and redistribution are under the same terms as Perl itself.

=cut