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

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

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

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

   my $results = $query->{results}

  my $results = $query->{results};

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

package CPAN::Search::Lite::Query;
use strict;
use warnings;
no warnings qw(redefine);
use utf8;
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.76;
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{query}) and do {
              $args{search} = {field => {name => $info->{name}, 
                                         text => $info->{text} },
                               value => $value};
#              $args{search} = {field => $info->{name},
#                               value => $value };
              $method = 'query';
              last METHOD;
            };
            $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 alias)];
    $args{table} = 'ppms';
    $args{join} = {reps => 'rep_id'};
    $args{order_by} = 'alias';
    $args{search} = {field => 'dist_id',
                     value => $self->{results}->{dist_id}};
    $self->{results}->{ppms} = $self->fetch(%args, wantarray => 1);

    my $ppms = $self->{results}->{ppms};
    (my $dist_letter = $self->{results}->{dist_name}) =~ s{^(\w).*}{$1};
    if ($dist_letter and ref($ppms) eq 'ARRAY') {
      foreach my $ppm (@$ppms) {
        my $rep_id = $ppm->{rep_id};
        next unless ($rep_id == 5 || $rep_id == 6);
        $ppm->{browse} =~ s{-A\.html}{-$dist_letter.html};
      }
    }

    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 alias) ];
    $args{order_by} = 'alias';
    $args{search} = {field => 'dist_id', 
                     value => $self->{results}->{dist_id}
                    };
    $self->{results}->{ppms} = $self->fetch(%args, wantarray => 1);

    my $ppms = $self->{results}->{ppms};
    (my $dist_letter = $self->{results}->{dist_name}) =~ s{^(\w).*}{$1};
    if ($dist_letter and ref($ppms) eq 'ARRAY') {
      foreach my $ppm (@$ppms) {
        my $rep_id = $ppm->{rep_id};
        next unless ($rep_id == 5 || $rep_id == 6);
        $ppm->{browse} =~ s{-A\.html}{-$dist_letter.html};
      }
    }

    $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, @order, %seen);
  foreach my $result (@$results) {
    my $dist_name = $result->{dist_name};
    unless ($seen{$dist_name}) {
      $seen{$dist_name}++;
      push @order, $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(@order) {
    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;
}

sub query {
    my ($self, %args) = @_;
    return unless $args{search};
    
    $args{fields} = [ qw(dist_id dist_name dist_abs 
                         chaps.chapterid chap_link) ];
    $args{table} = 'chaps';
    $args{join} = {dists => 'dist_id', chapters => 'chapterid'};
    $args{order_by} = 'chap_link,dist_name';
    $args{limit} = 2 * $max_results;

    return unless $self->{results} = $self->fetch(%args, wantarray => 1,
                                                  distinct => 1);
    foreach my $result (@{$self->{results}}) {
      my $chapterid = $result->{'chaps.chapterid'} + 0;
      next unless $chapterid;
      $result->{chap_desc} = $self->chap_desc($chapterid);
    }
    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 abs_score" if defined $match;

    my $str_match;
    if ($regex or $text_search) {
      my $value = $search->{value};
      $value =~ s/[\^\$\*\+\?\|]//g;
      my $name = $search->{field}->{name};
      my $tail = q{([a-zA-Z0-9_]*)?};
    MATCH: {
	($name eq 'dist_name') and do {
	  $value = 'CGI.pm' if (uc $value eq 'CGI');
	  if ($value =~ / /) {
	    (my $re = $value) =~ s@\s+@${tail}-@g;
	    $str_match = qq{$name REGEXP '^$re'};
	  }
	  else {
	    $str_match = ($value =~ /-/) ? 
	      qq{$name REGEXP '^$value'} : 
		qq{$name REGEXP '^$value(-[-a-zA-Z0-9_]*)?\$'};
	  }
	  last MATCH;
	};
	($name eq 'mod_name') and do {
	  if ($value =~ / /) {
	    (my $re = $value) =~ s@\s+@${tail}::@g;
	    $str_match = qq{$name REGEXP '^$re'};
	  }
	  else {
	    $str_match = ($value =~ /::/) ? 
	      qq{$name REGEXP '^$value'} : 
		qq{$name REGEXP '^$value(::[:a-zA-Z0-9_]*)?\$'};
	  }
	  last MATCH;
	};
	($name eq 'cpanid') and do {
	  if ($value =~ / /) {
	    (my $re = $value) =~ s@\s+@$tail @g;
	    $str_match = qq{$search->{field}->{text} REGEXP '^$re'};
	  }
	  else {
	    $str_match = qq{$name REGEXP '^$value([-a-zA-Z0-9_]*)?\$'};
	  }
	  last MATCH;
	};
	$str_match = qq{STRCMP($name, '$value') = 0};
      }
    }
    push @fields, "$str_match as str_score" if $str_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 ($str_match) {
      $order_by = 'str_score desc';
    }
    if ($text_search and not $not) {
      $order_by = $str_match ? qq{$order_by,abs_score desc} : 'abs_score desc';
    }
    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__