CPAN-Search-Lite documentation

CPAN::Search::Lite::Query - perform queries on the database

Code Index:

__top

NAME

CPAN::Search::Lite::Query - perform queries on the database

__top

SYNOPSIS

  my $max_results = 200;
  my $query = CPAN::Search::Lite::Query->new(db => $db,
                                             user => $user,
                                             passwd => $passwd,
                                             max_results => $max_results);
  $query->query(mode => 'module', name => 'Net::FTP');
  my $results = $query->{results};

__top

CONSTRUCTING THE QUERY

This module queries the database via various types of queries and returns the results for subsequent display. The CPAN::Search::Lite::Query object is created via the new method as

  my $query = CPAN::Search::Lite::Query->new(db => $db,
                                             user => $user,
                                             passwd => $passwd,
                                             max_results => $max_results);

which takes as arguments

A basic query then is constructed as

   $query->query(mode => $mode, $type => $value);

with the results available as

   my $results = $query->{results}

There are four basic modes:

module, dist, and author modes

For a mode of module, dist, and author, there are four basic options to be used for the $type => $value option:

As well, for the dist mode there is an additional type: recent => $age, which will report all distribtions uploaded in the last $age days. If $age is not specified, it will default to 7.

chapter mode

For a mode of chapter, one can specify two additional arguments:

__top

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 $query->{error}). Assuming there are results, what is returned depends on the mode and on the type of query. See the CPAN::Search::Lite::Populate manpage 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.

author mode

module mode

dist mode

chapter mode

For a name or id query of dist, author, or module, if the query is constructed as

  $query->query(mode => $mode, $type => $value, fields => $fields);

where $fields is an array reference, then only those fields specified will be returned. For author, only the auths table is searched, for module, the mods, auths, and dists tables are searched, and for dist, the dists and auths tables are searched.

__top

SEE ALSO

Apache::CPAN::Search and Apache::CPAN::Query.

__top

COPYRIGHT

This software is copyright 2004 by Randy Kobes <randy@theoryx5.uwinnipeg.ca>. Use and redistribution are under the same terms as Perl itself.

__top

package CPAN::Search::Lite::Query;
use strict;
use warnings;
use utf8;
no warnings qw(redefine);
use CPAN::Search::Lite::Util qw($repositories %chaps
                                $full_id $mode_info);
our $months = {};
our $chaps_desc = {};
our $pages = {};
our $dslip = {};
use CPAN::Search::Lite::Lang qw(load);
use CPAN::Search::Lite::DBI::Query;
use CPAN::Search::Lite::DBI qw($dbh);
use Lingua::Stem qw(:stem);
use constant GB => 1024 * 1024 * 1024;
use constant MB => 1024 * 1024;
use constant KB => 1024;

our ($lang);
our $max_results = 200;
our $VERSION = 0.66;
my $cdbi_query;

my %mode2obj;
$mode2obj{$_} = __PACKAGE__ . '::' . $_ 
    for (qw(dist author module chapter));
 
sub new {
    my ($class, %args) = @_;
    foreach (qw(db user passwd)) {
        die "Please supply a '$_' argument" unless defined $args{$_};
    }
    $cdbi_query = CPAN::Search::Lite::DBI::Query->new(%args);

    $max_results = $args{max_results} if $args{max_results};
    $lang = 'en' unless $lang;
    my $self = {results => undef, error => ''};
    bless $self, $class;
}

sub query {
    my ($self, %args) = @_;
    unless ($months->{$lang}) {
      my $rc = load(lang => $lang, dslip => $dslip, pages => $pages,
                    months => $months, chaps_desc => $chaps_desc);
      unless ($rc == 1) {
        $self->{error} = $rc;
        return;
      }
    }
    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::Search::Lite::DBI::Query::' . $table;
    unless ($cdbi and ref($cdbi) eq $class) {
      $self->{error} = qq{No cdbi object exists for '$table'};
      return;
    }
    my $fields = $args{fields};
    if ($fields and ref($fields) ne 'ARRAY') {
      $self->{error} = q{Please supply an array reference for fields};
      return;
    }
    my $obj;
    eval {$obj = $mode2obj{$mode}->make(table => $table, cdbi => $cdbi);};
    if ($@) {
        $self->{error} = qq{Mode '$mode' is not known};
        return;
    }
    my ($value, $method);
  METHOD: {
        ($mode eq 'dist' and exists $args{recent}) and do {
            $args{search} = {field => 'birth',
                             value => $args{recent} || 7 };
            $method = 'recent';
            last METHOD;
            
        };
        ($mode eq 'chapter') and do {
            $value = $args{id} or do {
                $self->{error} = q{Must supply a chapterid};
                return;
            };
            push @{$args{search}}, {field => $info->{id},
                                    value => $value};
            if (my $subvalue = $args{subchapter}) {
                push @{$args{search}}, {field => $info->{name},
                                        value => $subvalue};
                $method = 'search';
            }
            else {
                $method = 'info';
            }
            last METHOD;
        };
        ($value = $args{query}) and do {
            $args{search} = {field => {name => $info->{name}, 
                                       text => $info->{text} },
                             value => $value };
            $method = 'search';
            last METHOD;
        };
        ($value = $args{letter}) and do {
            $args{search} = {field => $info->{name},
                             value => $value };
            $method = 'letter';
            last METHOD;
        };
        ($value = $args{id}) and do {
            $args{search} = {field => $info->{id},
                             value => $value };
            $method = 'info';
            last METHOD;
        };
        ($value = $args{name}) and do {
            $args{search} = {field => $info->{name},
                             value => $value };
            $method = 'info';
            last METHOD;
        };
        $self->{error} = q{Cannot determine a method name};
        return;
    }
    
    $obj->$method(search => $args{search}, user_fields => $fields);
    $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::Search::Lite::Query::author;
use base qw(CPAN::Search::Lite::Query);
use CPAN::Search::Lite::DBI qw($dbh);

sub info {
    my ($self, %args) = @_;
    return unless $args{search};
    
    $args{fields} = $args{user_fields} || 
      [ qw(auth_id cpanid email fullname) ];
    $args{table} = 'auths';

    return unless ($self->{results} = $self->fetch(%args, distinct => 1));
    return 1 if $args{user_fields};

    $args{fields} = [qw(dist_id dist_name birth
                        dist_abs dist_vers dist_file)];
    $args{table} = 'dists';
    $args{search} = {field => 'auth_id', 
                     value => $self->{results}->{auth_id}};
    $args{order_by} = 'dist_name';
    my $cpanid = $self->{results}->{cpanid};
    if ($self->{results}->{dists} = $self->fetch(%args, wantarray => 1)) {
        foreach my $dist (@{$self->{results}->{dists}}) {
            $dist->{download} = 
                $self->download($cpanid, $dist->{dist_file});
            $dist->{birth} = $self->date_format($dist->{birth});
        }
    }
    return 1;
}

sub search {
    my ($self, %args) = @_;
    return unless $args{search};
    
    $args{fields} = [ qw(auth_id cpanid fullname) ];
    $args{table} = 'auths';
    $args{limit} = $max_results;
    $args{order_by} = 'cpanid';
    return unless $self->{results} = $self->fetch(%args);
    if (ref($self->{results}) ne 'ARRAY') {
        return $self->query(mode => 'author', 
                            id => $self->{results}->{auth_id});
    }
    return 1;
}

sub letter {
    my ($self, %args) = @_;
    return unless $args{search};
    
    $args{fields} = [ qw(auth_id cpanid fullname) ];
    $args{table} = 'auths';

    $args{order_by} = 'cpanid';
    return unless $self->{results} = $self->fetch(%args, letter => 1,
                                                  wantarray => 1);
    return 1;
}

package CPAN::Search::Lite::Query::module;
use base qw(CPAN::Search::Lite::Query);
use CPAN::Search::Lite::Util qw(%chaps);
use CPAN::Search::Lite::DBI qw($dbh);

sub info {
    my ($self, %args) = @_;
    return unless $args{search};
    
    $args{fields} = $args{user_fields} ||
      [ qw(mod_id mod_name mod_abs doc src mod_vers 
           dslip chapterid dist_id dist_name dist_file
           auth_id cpanid fullname) ];
    $args{table} = 'dists';
    $args{join} = { mods => 'dist_id',
                    auths => 'auth_id',
                  };

    return unless ($self->{results} = $self->fetch(%args, distinct => 1,
                                                   case_sensitive => 1));
    return 1 if $args{user_fields};
    my $mod_name = $self->{results}->{mod_name};

    if ($self->{results}->{doc}) {
        (my $mod_link = $mod_name) =~ s{::}{/}g;
        my $html = $self->{results}->{dist_name} . '/' .
            $mod_link . '.html';
        $self->{results}->{html} = $html;
    }

    if ($self->{results}->{src}) {
        (my $mod_link = $mod_name) =~ s{::}{/}g;
        my $html = $self->{results}->{dist_name} . '/' .
            $mod_link . '.pm.html';
        $self->{results}->{htmlsrc} = $html;
    }

    $self->{results}->{download} = 
        $self->download($self->{results}->{cpanid}, 
                        $self->{results}->{dist_file});

    if (my $chapterid = $self->{results}->{chapterid}) {
        $self->{results}->{chap_link} = $self->chap_link($chapterid);
        $self->{results}->{chap_desc} = $self->chap_desc($chapterid);
        $self->{results}->{subchapter} = $self->mod_subchapter($mod_name);
    }

    if (my $what = $self->{results}->{dslip}) {
        $self->{results}->{dslip_info} = $self->expand_dslip($what);
    }
    
    $args{fields} = [ qw(rep_id ppm_vers browse abs)];
    $args{table} = 'ppms';
    $args{join} = {reps => 'rep_id'};
    $args{search} = {field => 'dist_id',
                     value => $self->{results}->{dist_id}};
    $self->{results}->{ppms} = $self->fetch(%args, wantarray => 1);
    return 1;
}

sub search {
  my ($self, %args) = @_;
  return unless $args{search};
  
  $args{fields} = [ qw(mod_id mod_name mod_abs chapterid) ];
  $args{table} = 'mods';
  $args{order_by} = 'mod_name';
  $args{limit} = $max_results;
  return unless $self->{results} = $self->fetch(%args);
  my $results = $self->{results};
  if (ref($results) ne 'ARRAY') {
    return $self->query(mode => 'module',
                        id => $self->{results}->{mod_id});
  }
  else {
    foreach my $result (@$results) {
      next unless my $id = $result->{chapterid};
      next unless my $chap = $chaps{$id};
      next unless my $mod_name = $result->{mod_name};
      my $sub_chapter = $self->mod_subchapter($mod_name);      
      $result->{chapter} = $chap . '/' . $sub_chapter;
    }
  }
  if (scalar @$results == 1) {
    return $self->query(mode => 'module',
                        id => $self->{results}->[0]->{mod_id});
  }
  return 1;
}

sub letter {
  my ($self, %args) = @_;
  return unless $args{search};
  
  $args{fields} = [ qw(mod_id mod_name mod_abs) ];
  $args{table} = 'mods';
  $args{order_by} = 'mod_name';
  my $match;
  return unless $match = $self->fetch(%args, letter => 1,
                                      wantarray => 1);
  $self->{results} = $match;
  my $mod_re = qr{^([^:]+)::};
  if ($args{search}->{value} =~ /^\w$/) {
    my %count;
    foreach my $result (@$match) {
      if ($result->{mod_name} =~ /$mod_re/) {
        $count{$1}++;
      }
    }
    my %seen;
    my $results = [];
    foreach my $result (@$match) {
      if ($result->{mod_name} =~ /$mod_re/) {
        my $letter = $1;
        my $count = $count{$letter};
        if ( $count == 1) {
          push @$results, $result;
        }
        else {
          next if $seen{$letter};
          push @$results, {letter => $letter,
                           count => $count};
          $seen{$letter}++;
        }
      }
      else {
        push @$results, $result;
      }
    }
    $self->{results} = $results;
  }
  return 1;
}

package CPAN::Search::Lite::Query::dist;
use base qw(CPAN::Search::Lite::Query);
use CPAN::Search::Lite::Util qw(%chaps);
use CPAN::Search::Lite::DBI qw($dbh);

sub info {
    my ($self, %args) = @_;
    return unless $args{search};
    
    $args{fields} = $args{user_fields} ||
      [ qw(dist_id dist_name dist_abs dist_vers md5
           dist_file size birth readme changes meta install
           auth_id cpanid fullname) ];
    $args{table} = 'dists';
    $args{join} = {auths => 'auth_id'};

    return unless ($self->{results} = $self->fetch(%args, distinct => 1,
                                                   case_sensitive => 1));
    $self->{results}->{birth} = $self->date_format($self->{results}->{birth});
    $self->{results}->{size} = $self->size_format($self->{results}->{size});
    return 1 if $args{user_fields};

    $self->{results}->{download} = 
        $self->download($self->{results}->{cpanid}, $self->{results}->{dist_file});

    $args{join} = {reps => 'rep_id'};
    $args{table} = 'ppms';
    $args{fields} = [ qw(rep_id ppm_vers browse abs) ];
    $args{search} = {field => 'dist_id', 
                     value => $self->{results}->{dist_id}
                    };
    $self->{results}->{ppms} = $self->fetch(%args, wantarray => 1);

    $args{join} = undef;
    $args{table} = 'mods';
    $args{fields} = [ qw(mod_id mod_name mod_abs mod_vers doc dslip src) ];
    $args{order_by} = 'mod_name';
    $self->{results}->{mods} = $self->fetch(%args, wantarray => 1);
    my $mod_dslip;
    my $distname = $self->{results}->{dist_name};
    if (my $mods = $self->{results}->{mods}) {
        foreach my $mod (@$mods) {
            my $mod_name = $mod->{mod_name};
            (my $trial_dist = $mod_name) =~ s!::!-!g;
            $mod_dslip = $mod->{dslip}
                if ($trial_dist eq $distname and $mod->{dslip});
            if ($mod->{doc}) {
                (my $docpath = $mod_name) =~ s!::!/!g;
                $mod->{html} = $distname . '/' . $docpath . '.html';
            }
            if ($mod->{src}) {
                (my $mod_link = $mod_name) =~ s{::}{/}g;
                my $html = $self->{results}->{dist_name} . '/' .
                    $mod_link . '.pm.html';
                $mod->{htmlsrc} = $html;
            }
        }
    }
    if ($mod_dslip) {
        $self->{results}->{dslip} = $mod_dslip;
        $self->{results}->{dslip_info} = $self->expand_dslip($mod_dslip);
    }

    $args{table} = 'chaps';
    $args{fields} = [ qw(chaps.chapterid subchapter chap_link) ];
    $args{join} = {chapters => 'chapterid'};
    $args{order_by} = 'chapterid';
    if ($self->{results}->{chaps} = $self->fetch(%args, wantarray => 1)) {
        foreach my $chap (@{$self->{results}->{chaps}}) {
            my $chapterid = $chap->{'chaps.chapterid'} + 0;
            next unless $chapterid;
            $chap->{chap_desc} = $self->chap_desc($chapterid);
        }
    }
  
    $args{search} = {field => 'reqs.dist_id', 
                     value => $self->{results}->{dist_id},
                    };
    $args{table} = 'reqs';
    $args{join} = {mods => 'mod_id'};
    $args{fields} = [ qw(mod_id req_vers mod_name mod_abs) ];
    $args{order_by} = 'mod_name';
    $self->{results}->{reqs} = $self->fetch(%args, wantarray => 1);
    return 1;
}

sub search {
  my ($self, %args) = @_;
  return unless $args{search};
  
  $args{fields} = [ qw(dist_id dist_name dist_abs chapterid subchapter) ];
  $args{table} = 'dists';
  $args{order_by} = 'dist_name';
  $args{limit} = $max_results;
  $args{left_join} = {chaps => 'dist_id'};
  return unless $self->{results} = $self->fetch(%args);
  my $results = $self->{results};
  if (ref($results) ne 'ARRAY') {
    return $self->query(mode => 'dist',
                        id => $self->{results}->{dist_id});
  }
  else {
    foreach my $result (@$results) {
      next unless my $id = $result->{chapterid};
      next unless my $subchapter = $result->{subchapter};
      next unless my $chap = $chaps{$id};
      $result->{chapter} = $chap . '/' . $subchapter;
    }
  }
  my ($tmp, $chapters);
  foreach my $result (@$results) {
    my $dist_name = $result->{dist_name};
    $tmp->{$dist_name} = {dist_id => $result->{dist_id},
                        dist_abs => $result->{dist_abs}};
    next unless $result->{chapter};
    push @{$chapters->{$dist_name}}, $result->{chapter};
  }
  my $pruned;
  foreach my $dist_name(sort keys %$tmp) {
    push @$pruned, {dist_name => $dist_name,
                   %{$tmp->{$dist_name}},
                   chapters => $chapters->{$dist_name},
                   };
  }
  if (scalar @$pruned == 1) {
    return $self->query(mode => 'dist',
                        id => $pruned->[0]->{dist_id});
  }
  $self->{results} = $pruned;
  return 1;
}

sub letter {
  my ($self, %args) = @_;
  return unless $args{search};
  
  $args{fields} = [ qw(dist_id dist_name dist_abs) ];
  $args{table} = 'dists';
  $args{order_by} = 'dist_name';
  my $match;
  return unless $match = $self->fetch(%args, letter => 1,
                                      wantarray => 1);
  $self->{results} = $match;

  my $dist_re = qr{^([^-]+)-};
  if ($args{search}->{value} =~ /^\w$/) {
    my %count;
    foreach my $result(@$match) {
      if ($result->{dist_name} =~ /$dist_re/) {
        $count{$1}++;
      }
    }
    my %seen;
    my $results = [];
    foreach my $result (@$match) {
      if ($result->{dist_name} =~ /$dist_re/) {
        my $letter = $1;
        my $count = $count{$letter};
        if ( $count == 1) {
          push @$results, $result;
        }
        else {
          next if $seen{$letter};
          push @$results, {letter => $letter,
                           count => $count};
          $seen{$letter}++;
        }
      }
      else {
        push @$results, $result;
      }
    }
    $self->{results} = $results;
  }
  return 1;
}

sub recent {
    my ($self, %args) = @_;
    return unless $args{search};
    
    $args{fields} = [ qw(birth dist_id dist_name dist_abs dist_vers
                        dist_file auth_id cpanid) ];
    $args{table} = 'dists';
    $args{join} = {auths => 'auth_id'};
    $args{order_by} = 'birth desc,dist_name';
    my $results;
    return unless $results = $self->fetch(%args, wantarray => 1,
                                                 age => 1);
    foreach my $result(@$results) {
        $result->{download} = $self->download($result->{cpanid}, $result->{dist_file});
        $result->{birth} = $self->date_format($result->{birth});
    }
    $self->{results} = $results;
    return 1;
}


package CPAN::Search::Lite::Query::chapter;
use base qw(CPAN::Search::Lite::Query);
use CPAN::Search::Lite::DBI qw($dbh);

sub info {
    my ($self, %args) = @_;
    return unless $args{search};
    
    $args{fields} = [ qw(dist_id dist_abs subchapter) ];
    $args{table} = 'chaps';
    $args{order_by} = 'subchapter';
    $args{join} = {dists => 'dist_id'};
    my $match;
    return unless $match = $self->fetch(%args, wantarray => 1,
                                          distinct => 1);
    my %count;
    $count{$_->{subchapter}}++ for @$match;
    my $results = [];
    my %seen;
    foreach my $result (@$match) {
      my $subchapter = $result->{subchapter};
      next if $seen{$subchapter};
      my $count = $count{$subchapter};
      if ($count > 1) {
        push @$results, {subchapter => $subchapter,
                         count => $count};
        $seen{$subchapter}++;
      }
      else {
        push @$results, $result;
      }
    }
    $self->{results} = $results;
    return 1;
}

sub search {
    my ($self, %args) = @_;
    return unless $args{search};
    
    $args{fields} = [ qw(dist_id dist_name dist_abs) ];
    $args{table} = 'chaps';
    $args{join} = {dists => 'dist_id'};
    $args{order_by} = 'dist_name';
    return unless $self->{results} = $self->fetch(%args, wantarray => 1);
    return 1;
}

package CPAN::Search::Lite::Query;

sub fetch {
    my ($self, %args) = @_;
    my $fields = $args{fields};
    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();
    if ($sth->rows == 0) {
        $sth->finish;
        return;
    }
 
    if ($sth->rows == 1 and not $args{wantarray}) {
        my %results;
        @results{@fields} = $sth->fetchrow_array;
        $sth->finish;
        return \%results;
    }
    else {
        my (%hash, $results);
        while ( @hash{@fields} = $sth->fetchrow_array) {
            my %tmp = %hash;
            push @{$results}, \%tmp;
        }    
        $sth->finish;
        return (defined $args{distinct} and not defined $args{wantarray}) ? 
            $results->[0] : $results;
    }    
}

sub sql_statement {
    my ($self, %args) = @_;

    my $search = $args{search};
    my $chap = (ref($search) eq 'ARRAY');
    my $distinct = $args{distinct} ? 'DISTINCT' : '';
    my $binary = $args{case_sensitive} ? 'BINARY' : '';
    my $text_search = (not $chap and ref($search->{field}) eq 'HASH');
    my $regex = (not $distinct and not $chap and not ref($search->{value}) 
                 and $search->{value} =~ /\^|\$|\*|\+|\?|\||::|\b-\b/);
    if ($regex) {
        my $v = $search->{value};
        eval{$v =~ /$v/};
        if ($@) {
            $self->{error} = $@;
            return;
        }
    }
    my $letter = $args{letter};
    my $age = $args{age};
    my $not = ($regex or $letter or $chap or $age);
    my ($match, @words);
    if ($text_search and not $not) {
        @words = split ' ', $search->{value};
        my %excl = map {$_ => 1} grep /^-/, @words;
        my $stems = stem(@words);
        my @stems = @$stems;
        for (0 .. $#stems) {
            $stems[$_] = "-$stems[$_]" if $excl{$words[$_]};
        }
        my $join = join ' ', map { /^-/ ? "$_*" : "+$_*" } @stems;
        $match = q/ MATCH (/ .
                           $search->{field}->{text} .
                           q/) AGAINST ('/ . $join .
            q/' IN BOOLEAN MODE )/;
    }

    my $table = $args{table};
    my @tables = ($table);

    my $fields = $args{fields};
    my @fields = ref($fields) eq 'ARRAY' ? 
        @{$fields} : ($fields);
    for (@fields) {
        $_ = $full_id->{$_} if $full_id->{$_};
#        $_ = $table . '.chapterid' if $_ eq 'chapterid';
#        $_ = qq{DATE_FORMAT($_, '%e %b %Y')} if $_ eq 'birth';
#        $_ = qq{FORMAT($_, 0)} if $_ eq 'size';
    }
    push @fields, "$match as score" if defined $match;
    my $sql = qq{SELECT $distinct } . join(',', @fields);


    my $where;
  QUERY: {
        $chap and do {
            $where = qq{ $search->[0]->{field} = $search->[0]->{value} };
            if (defined $search->[1]) {
                $where .= ' AND ' .
                    qq{ $search->[1]->{field} = '$search->[1]->{value}' }; 
            }
            last QUERY;
        };
        $letter and do {
            my $value = $search->{value};
            my $star = ($value =~ /^\w$/) ? '%' : 
                ($table eq 'mods' ? '::%' : '-%');
            $where = qq{ $search->{field} LIKE '$value$star' };
            last QUERY;
        };
        $age and do {
            $where = qq{ TO_DAYS(NOW()) - TO_DAYS($search->{field}) <= $search->{value} };
            last QUERY;
        };
        $regex and do {
            $where = qq{ $search->{field}->{name} REGEXP '$search->{value}' };
            last QUERY;
        };
        $text_search and do {
            my $name = $search->{field}->{name};
            $where = join ' AND ', 
                map {" $name ". (s/^-// ? 'NOT ' : '') . "LIKE '%$_%' "} @words;
            last QUERY;
        };
        $full_id->{$search->{field}} and do {
            $where = qq{ $search->{field} = $search->{value} };
            last QUERY;
        };
        $where = qq{ $binary $search->{field} = '$search->{value}' };
    }

    my $join;
#    if (defined $args{join}) {
#        my @join = ();
#        while (my ($join, $id) = each %{$args{join}}) {
#            push @tables, $join;
#            push @join, ($table.'.'.$id. ' = ' . $join.'.'.$id); 
#        }
#        $join = join ' AND ', @join;
#    }
#    $sql .= ' FROM ' . join ',', @tables;

    $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) {
#          $sql .= " LEFT JOIN $key using ($left_join->{$key}) ";
            my $id = $left_join->{$key};
          $sql .= " LEFT JOIN $key ON $table.$id=$key.$id ";
        }
      }
    }

    if ($text_search and not $not) {
        $sql .= ' WHERE ( ( ' . $where . ' ) OR ( ' . $match . ' ) )';
    }
    else {
        $sql .= ' WHERE ( ' . $where . ' )';
    }
    $sql .= ' AND (' . $join . ')' if $join;

    my $order_by = '';
    if ($text_search and not $not) {
      $order_by = 'score';
    }
    if (my $user_order_by = $args{order_by}) {
      $order_by = $order_by ? "$order_by,$user_order_by" : $user_order_by;
    }
    if ($order_by) {
      $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;
}

sub expand_dslip {
    my ($self, $string) = @_;
    my $entries = [];
    my @info = split '', $string;
    my @given = qw(d s l i p);
    for (0 .. 4) {
        my $entry;
        my $given = $given[$_];
        my $info = $info[$_];
        $entry->{desc} = $dslip->{$lang}->{$given}->{desc};
        $entry->{what} = (not $info or $info eq '?') ?
            $pages->{$lang}->{na} : $dslip->{$lang}->{$given}->{$info};
        push @$entries, $entry;
    }
    return $entries;
}

sub download {
    my ($self, $cpanid, $dist_file) = @_;
    (my $fullid = $cpanid) =~ s!^(\w)(\w)(.*)!$1/$1$2/$1$2$3!;
    my $download = $fullid . '/' . $dist_file;
    return $download;
}

sub chap_link {
    my ($self, $id) = @_;
    return $chaps{$id};
}

sub chap_desc {
    my ($self, $id) = @_;
    return $chaps_desc->{$lang}->{$id};
}

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;
}

sub db_error {
    my ($obj, $sth) = @_;
    return unless $dbh;
    $sth->finish if $sth;
    $obj->{error} = q{Database error: } . $dbh->errstr;
}

sub date_format {
    my ($self, $date) = @_;
    my @e = split /-/, $date;
    return sprintf("%d %s %d", $e[2], $months->{$lang}->{$e[1]}, $e[0]);
}

sub size_format {
    my ($self, $size) = @_;
    my ($test, $string);
  SWITCH: {
        ( ($test = $size / GB) && int($test) > 0) and do {
            $string = sprintf('%.1f GB', $test);
            last SWITCH;
        };
        ( ($test = $size / MB) && int($test) > 0) and do {
            $string = sprintf('%.1f MB', $test);
            last SWITCH;
        };
        ( ($test = $size / KB) && int($test) > 0) and do {
            $string = sprintf('%.1f KB', $test);
            last SWITCH;
        };
        $string = sprintf("%d $pages->{$lang}->{bytes}", $size);
    }
    $string =~ s{\.}{,} unless ($lang eq 'en');
    return $string;
}

1;

__END__
CPAN-Search-Lite documentation