torrus/perllib/Torrus/Search.pm

   1 #  Copyright (C) 2002  Stanislav Sinyagin
   2 #
   3 #  This program is free software; you can redistribute it and/or modify
   4 #  it under the terms of the GNU General Public License as published by
   5 #  the Free Software Foundation; either version 2 of the License, or
   6 #  (at your option) any later version.
   7 #
   8 #  This program is distributed in the hope that it will be useful,
   9 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 #  GNU General Public License for more details.
  12 #
  13 #  You should have received a copy of the GNU General Public License
  14 #  along with this program; if not, write to the Free Software
  15 #  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
  16
  17 # $Id: Search.pm,v 1.1 2010-12-27 00:03:39 ivan Exp $
  18 # Stanislav Sinyagin <ssinyagin@yahoo.com>
  19
  20
  21 # Task scheduler runtime information. Quite basic statistics access.
  22
  23 package Torrus::Search;
  24
  25 use Torrus::DB;
  26 use Torrus::Log;
  27 use strict;
  28
  29
  30 sub new
  31 {
  32     my $self = {};
  33     my $class = shift;
  34     my %options = @_;
  35     bless $self, $class;
  36
  37     %{$self->{'options'}} = %options;
  38
  39     return $self;
  40 }
  41
  42
  43 sub openTree
  44 {
  45     my $self = shift;
  46     my $tree = shift;
  47
  48     my $db = new Torrus::DB
  49         ( 'searchwords',
  50           -Subdir => $tree,
  51           -Btree => 1,
  52           -Duplicates => 1,
  53           -WriteAccess => $self->{'options'}{'-WriteAccess'},
  54           -Truncate => $self->{'options'}{'-WriteAccess'} );
  55
  56     $self->{'db_treewords'}{$tree} = $db;
  57 }
  58
  59
  60 sub closeTree
  61 {
  62     my $self = shift;
  63     my $tree = shift;
  64
  65     $self->{'db_treewords'}{$tree}->closeNow();
  66 }
  67
  68
  69 sub openGlobal
  70 {
  71     my $self = shift;
  72
  73     my $db = new Torrus::DB
  74         ( 'globsearchwords',
  75           -Btree => 1,
  76           -Duplicates => 1,
  77           -WriteAccess => $self->{'options'}{'-WriteAccess'},
  78           -Truncate => $self->{'options'}{'-WriteAccess'} );
  79
  80     $self->{'db_globwords'} = $db;
  81 }
  82
  83
  84 sub storeKeyword
  85 {
  86     my $self = shift;
  87     my $tree = shift;
  88     my $keyword = lc( shift );
  89     my $path = shift;
  90     my $param = shift;
  91
  92     my $val = $path;
  93     if( defined( $param ) )
  94     {
  95         $val .= ':' . $param;
  96     }
  97
  98     my $lookupkey = join( ':', $tree, $keyword, $val );
  99     if( not $self->{'stored'}{$lookupkey} )
 100     {
 101         $self->{'db_treewords'}{$tree}->put( $keyword, $val );
 102         if( defined( $self->{'db_globwords'} ) )
 103         {
 104             $self->{'db_globwords'}->put( $keyword, join(':', $tree, $val) );
 105         }
 106
 107         $self->{'stored'}{$lookupkey} = 1;
 108     }
 109 }
 110
 111 sub searchPrefix
 112 {
 113     my $self = shift;
 114     my $prefix = lc( shift );
 115     my $tree = shift;
 116
 117     my $db = defined( $tree ) ?
 118         $self->{'db_treewords'}{$tree} : $self->{'db_globwords'};
 119
 120     my $result = $db->searchPrefix( $prefix );
 121
 122     my $ret = [];
 123
 124     if( defined( $result ) )
 125     {
 126         foreach my $pair ( @{$result} )
 127         {
 128             my $retstrings = [];
 129             push( @{$retstrings}, split(':', $pair->[1]) );
 130             push( @{$ret}, $retstrings );
 131         }
 132     }
 133
 134     return $ret;
 135 }
 136
 137
 138
 139
 140
 141 1;
 142
 143
 144 # Local Variables:
 145 # mode: perl
 146 # indent-tabs-mode: nil
 147 # perl-indent-level: 4
 148 # End: