torrus/bin/buildsearchdb.in

   1 #!@PERL@ -w
   2 #  Copyright (C) 2002  Stanislav Sinyagin
   3 #
   4 #  This program is free software; you can redistribute it and/or modify
   5 #  it under the terms of the GNU General Public License as published by
   6 #  the Free Software Foundation; either version 2 of the License, or
   7 #  (at your option) any later version.
   8 #
   9 #  This program is distributed in the hope that it will be useful,
  10 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 #  GNU General Public License for more details.
  13 #
  14 #  You should have received a copy of the GNU General Public License
  15 #  along with this program; if not, write to the Free Software
  16 #  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
  17
  18 # $Id: buildsearchdb.in,v 1.1 2010-12-27 00:04:01 ivan Exp $
  19 # Stanislav Sinyagin <ssinyagin@yahoo.com>
  20
  21 BEGIN { require '@torrus_config_pl@'; }
  22
  23 use strict;
  24 use Getopt::Long;
  25
  26 use Torrus::ConfigTree;
  27 use Torrus::Search;
  28 use Torrus::SiteConfig;
  29 use Torrus::Log;
  30
  31 exit(1) if not Torrus::SiteConfig::verify();
  32
  33 my @trees;
  34 my $build_global;
  35 my $all_trees;
  36
  37 my $verbose;
  38 my $help_needed;
  39
  40 my $ok = GetOptions ('tree=s'   => \@trees,
  41                      'all'      => \$all_trees,
  42                      'global'   => \$build_global,
  43                      'verbose'  => \$verbose,
  44                      'help'     => \$help_needed);
  45
  46 if( not $ok or not (scalar(@trees) or $all_trees or $build_global) or
  47     $help_needed or scalar(@ARGV) > 0 )
  48 {
  49     print STDERR "Usage: $0 --tree=NAME [options...]\n",
  50     "Options:\n",
  51     "  --tree=NAME     rebuild search DB for a tree\n",
  52     "  --all           rebuild search DB for all trees\n",
  53     "  --global        rebuild global search DB\n",
  54     "  --verbose       print extra information\n",
  55     "  --help          this help message\n";
  56     exit 1;
  57 }
  58
  59 if( $build_global )
  60 {
  61     $all_trees = 1;
  62 }
  63
  64 if( $all_trees )
  65 {
  66     @trees = Torrus::SiteConfig::listTreeNames();
  67 }
  68
  69 if( $verbose )
  70 {
  71     Torrus::Log::setLevel('verbose');
  72 }
  73
  74 &Torrus::DB::setSafeSignalHandlers();
  75
  76 Verbose(sprintf('Torrus version %s', '@VERSION@'));
  77
  78 my $search = new Torrus::Search( -WriteAccess => 1 );
  79
  80 if( $build_global )
  81 {
  82     $search->openGlobal();
  83 }
  84
  85 foreach my $tree ( @trees )
  86 {
  87     if( not Torrus::SiteConfig::treeExists( $tree ) )
  88     {
  89         Error("Tree named \"" . $tree . "\" does not exist");
  90         exit(1);
  91     }
  92
  93     &Torrus::DB::checkInterrupted();
  94
  95     my $config_tree = new Torrus::ConfigTree( -TreeName => $tree );
  96     if( not defined($config_tree) )
  97     {
  98         print("Configuration is not ready\n");
  99         exit(1);
 100     }
 101
 102     Verbose("Processing the tree: $tree");
 103
 104     $search->openTree( $tree );
 105
 106     walkSubtree( $config_tree, $search, $config_tree->token('/') );
 107
 108     $search->closeTree( $tree );
 109     $config_tree = undef;
 110 }
 111
 112 exit(0);
 113
 114
 115 sub walkSubtree
 116 {
 117     my $config_tree = shift;
 118     my $search = shift;
 119     my $ptoken = shift;
 120
 121     my $tree = $config_tree->treeName();
 122
 123     foreach my $token ( $config_tree->getChildren( $ptoken ) )
 124     {
 125         &Torrus::DB::checkInterrupted();
 126
 127         if( $config_tree->isSubtree( $token ) )
 128         {
 129             walkSubtree( $config_tree, $search, $token );
 130         }
 131
 132         my $isSearchable =
 133             $config_tree->getNodeParam( $token, 'searchable', 1 );
 134         if( defined( $isSearchable ) and $isSearchable eq 'yes' )
 135         {
 136             my $path = $config_tree->path( $token );
 137
 138             my $nodeName = $config_tree->nodeName( $path );
 139             splitAndStore( $tree, $nodeName, $path );
 140
 141             my $params = $config_tree->getParams( $token, 1 );
 142             while( my( $param, $value ) = each %{$params} )
 143             {
 144                 if( $config_tree->getParamProperty( $param, 'search' ) )
 145                 {
 146                     splitAndStore( $tree, $value, $path, $param );
 147                 }
 148             }
 149         }
 150     }
 151 }
 152
 153
 154 sub splitAndStore
 155 {
 156     my $tree = shift;
 157     my $value = shift;
 158     my $path = shift;
 159     my $param = shift;
 160
 161     if( length( $value ) > 0 )
 162     {
 163         # split the value into words
 164         my @words = split( /\W+/ms, $value );
 165         if( scalar( @words ) > 0 )
 166         {
 167             foreach my $word ( @words )
 168             {
 169                 if( length( $word ) > 1 )
 170                 {
 171                     $search->storeKeyword( $tree, $word, $path, $param );
 172
 173                     # Split the word by underscores and minus
 174                     my @subwords = split( /_+/, $word );
 175                     if( scalar( @subwords ) > 1 )
 176                     {
 177                         foreach my $subword ( @subwords )
 178                         {
 179                             if( length( $subword ) > 1 )
 180                             {
 181                                 $search->storeKeyword( $tree,
 182                                                        $subword,
 183                                                        $path,
 184                                                        $param );
 185                             }
 186                         }
 187                     }
 188                 }
 189             }
 190         }
 191     }
 192 }
 193
 194
 195
 196 # Local Variables:
 197 # mode: perl
 198 # indent-tabs-mode: nil
 199 # perl-indent-level: 4
 200 # End: