/[SWISH-PlusPlus]/trunk/PlusPlus.pm

This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!

Diff of /trunk/PlusPlus.pm

Parent Directory | Revision Log | View Patch Patch

-revision 11 by dpavlin,
Sun Dec  5 13:30:57 2004 UTC
+revision 22 by dpavlin,
Tue Dec  7 16:05:43 2004 UTC
 Line 4 
 use 5.008004;
  use strict;
  use warnings;
- our $VERSION = '0.05';
+ our $VERSION = '0.20';
  use Carp;
  use File::Temp qw/ tempdir /;
- #use YAML;
+ use BerkeleyDB;
+ use Storable qw(store retrieve freeze thaw);
+ use YAML;
  =head1 NAME
- SWISH::PlusPlus - Perl extension SWISH++
+ SWISH::PlusPlus - Perl extension for full-text indexer SWISH++ with properties support
  =head1 SYNOPSIS
    use SWISH::PlusPlus;
-   blah blah blah
+   my $i = new SWISH::PlusPlus(
+         index_dir => '/tmp/foo',
+   );
+   $i->add( 42 => 'meaning of life' );
+   print $i->search("meaning");  # returns 42
  =head1 DESCRIPTION
  This is perl module to use SWISH++ indexer by Paul J. Lucas. SWISH++ is
- rewrite of swish-e in C++ which is extremly fast (thank to mmap), but without
+ rewrite of swish-e in C++ which is extremely fast (due to mmap usage and
- support for properties (which this module tries to fix).
+ clever language heuristics), but without support for properties (which this
+ module tries to fix).
- Implementation of this module is crafted after L<Plucene::Simple> and it
- should be easy to replace Plucene with this module for increased
+ Implementation of API is something in-between C<SWISH::API> and
- performance. However, this module is not plug-in replacement.
+ C<Plucene::Simple>. It should be easy to replace Plucene or swish-e with
+ this module for increased performance. However, this module is not plug-in
+ replacement.
  =head1 METHODS
  =head2 new
- Create new indexing object.
+ Create new instance for index.
    my $i = SWISH::PlusPlus->new(
          index_dir => '/path/to/index',
-Line 44 
 Create new indexing object.
+Line 54 
 Create new indexing object.
          use_stopwords => 1,
    );
- Options to new are following:
+ Options are described below:
  =over 5
  =item C<index_dir>
- Path to directory in which index will be created.
+ Path to directory in which index and meta database will be created.
  =item C<index>
-Line 70 
 C<STDERR> prefixed by C<##>.
+Line 80 
 C<STDERR> prefixed by C<##>.
  =item C<meta_in_body>
  This option (off by default) enables to search content of meta fields
- without specifing them (like they are in body of document). This will
+ without specifying them (like they are in body of document). This will
- somewhat increate index size.
+ somewhat increase index size.
  =item C<use_stopwords>
-Line 90 
 sub new {
+Line 100 
 sub new {
                  croak "need $_" unless $self->{$_};
          }
-         if (! -e $self->{'index_dir'}) {
+         my $index_dir = $self->{'index_dir'};
-                 mkdir $self->{'index_dir'} || confess "can't create index ",$self->{'index'},": $!";
+         my $cwd;
+         chomp($cwd = `pwd`);
+         $self->{'cwd'} = $cwd || carp "can't get cwd!";
+         if ($index_dir !~ m#^/#) {
+                 $index_dir = "$cwd/$index_dir";
+                 print STDERR "## full path to index_dir: $index_dir\n" if ($self->{'debug'});
+                 $self->{'index_dir'} = $index_dir;
+         }
+         if (! -e $index_dir) {
+                 mkdir $index_dir || confess "can't create index ",$self->{'index'},": $!";
          }
          # default executables
          $self->{'index'} ||= 'index';
          $self->{'search'} ||= 'search';
-         print STDERR "## new index_dir: ",$self->{'index_dir'}," index: ",$self->{'index'}, " search: ",$self->{'search'},"\n" if ($self->{'debug'});
+         print STDERR "## new index_dir: ",$index_dir," index: ",$self->{'index'}, " search: ",$self->{'search'},"\n" if ($self->{'debug'});
          $self ? return $self : return undef;
  }
-Line 106 
 sub new {
+Line 128 
 sub new {
  =head2 check_bin
- Check if swish++ binaries specified in L<new> are available and verify
+ Check if SWISH++ binaries specified in L<new> are available and verify
  version signature.
    if ($i->check_bin) {
-Line 117 
 It will also setup property
+Line 139 
 It will also setup property
    $i->{'version'}
- which you can examine to see version.
+ which you can examined to see numeric version (something like C<6.0.4>).
  =cut
-Line 134 
 sub check_bin {
+Line 156 
 sub check_bin {
          confess $self->{'search'}," binary is not SWISH++" unless ($s =~ m/^SWISH\+\+/);
          if ($i eq $s) {
+                 $i =~ s/^SWISH\+\+\s+// || confess "can't strip SWISH++ from version";
                  $self->{'version'} = $i;
                  return 1;
          } else  {
-Line 147 
 sub check_bin {
+Line 170 
 sub check_bin {
  Quick way to add simple data to index.
-   $i->index_document($key, $data);
+   $i->index_document($path, $data);
-   $i->index_document( 42 => 'meaning of life' );
+   $i->index_document(
+=> 'meaning of life',
+=> 'Oh!',
+   );
+ C<$path> value is really path, so you don't want to use directory
+ separators (slashes, /) in it probably.
  =cut
-Line 169 
 sub index_document {
+Line 198 
 sub index_document {
  =head2 add
- Add document with metadata to index.
+ Add document with meta-data to index.
    $i->add(
          path => 'path/to/document',
-Line 189 
 This is thin wrapper round L<_create_doc
+Line 218 
 This is thin wrapper round L<_create_doc
  sub add {
          my $self = shift;
-         $self->_create_doc(@_);
+         return $self->_create_doc(@_);
+ }
-         return 1;
+ =head2 delete
+ Delete document from index.
+   $i->delete("document/path");
+ If deletion is succesfull returns revision of deleted document, otherwise
+ undef.
+ =cut
+ sub delete {
+         my $self = shift;
+         my $path = shift || carp "empty path?";
+         print STDERR "## delete: $path\n" if ($self->{'debug'});
+         my $rev = $self->{'meta_db'}->{"R$path"};
+         if ($rev) {
+                 $self->{'_deleted'}->{$path} = $rev;
+                 $self->{'_deleted_counter'}++;
+                 print STDERR "## deleted revision $rev, counter: ",$self->{'_deleted_counter'}++,"\n" if ($self->{'debug'});
+                 return $rev;
+         }
+         return undef;
  }
  =head2 search
- Search your index.
+ Search your index using any valid SWISH++ query.
-   my @results = $i->search("swhish query");
+   my @results = $i->search("swish query");
- Returns array with result IDs.
+ Returns array with elements like this:
+   {
+    rank => 10,                  # rank of result
+    path => 'path to result',    # path to result
+    size => 999,                 # size in bytes
+    title => 'title of result'   # title meta property
+   }
  =cut
-Line 208 
 sub search {
+Line 274 
 sub search {
          my $query = shift || return;
-         $self->_close_index;
+         $self->finish_update;
+         $self->_tie_meta_db(DB_RDONLY);
          my @results;
          # escape double quotes in query for shell
          $query =~ s/"/\\"/g;
-         my $open_cmd = $self->{'search'}." -i ".$self->{'index_dir'}.'/index "'.$query.'" |';
+         my $open_cmd = $self->{'search'} .
-         print STDERR "## search $open_cmd\n" if ($self->{'debug'});
+                 ' -i ' . $self->{'index_dir'}.'/index' .
+                 ' "' . $query . '"'.
+                 ' |';
+         print STDERR "## search: $open_cmd\n" if ($self->{'debug'});
+         my %r;
          open(SEARCH, $open_cmd) || confess "can't start $open_cmd: $!";
-         while(<SEARCH>) {
+         my $l;
-                 next if (/^#/);
+         while($l = <SEARCH>) {
-                 chomp;
+                 next if ($l =~ /^#/);
-                 print STDERR "## $_\n" if ($self->{'debug'});
+                 chomp($l);
-                 my ($rank,$path,$size,$title) = split(/ /,$_,4);
+                 print STDERR "## $l\n" if ($self->{'debug'});
+                 my ($rank,$path,$size,$rev,$title) = split(/ /,$l,5);
+                 $path =~ s#^\./##; # strip from path
+                 # get current revision
+                 $r{$path} = $self->{'meta_db'}->{"R$path"};
+                 # skip if old revision
+                 next if ($r{$path} > $rev);
+                 print STDERR "## current revision $rev\n" if ($self->{'debug'});
                  push @results, {
                          rank => $rank,
                          path => $path,
                          size => $size,
                          title => $title,
-                 }
+                 } unless ($self->{'_deleted'}->{$path} && $self->{'_deleted'}->{$path} <= $rev);
          }
          close(SEARCH) || confess "can't close search";
-Line 239 
 sub search {
+Line 322 
 sub search {
          return @results;
  }
+ =head2 property
+ Return stored meta property from result or result path.
+   print $i->property('path', 'meta name');
+   print $i->property($res->{'path'}, 'meta name');
+   print $i->property('path');
+   print $i->property($res->{'path'});
+ Returns one meta property (if meta name is specified) or whole hash with
+ all meta properties.
+ =cut
+ sub property {
+         my $self = shift;
+         my $path = shift || return;
+         my $meta = shift;
+         if ($path =~ m/^HASH/) {
+                 $path = $path->{'path'} || confess "can't find path in input data";
+         }
+         my $val = $self->{'meta_db'}->{"M$path"};
+         # FIXME should we die here like swish-e does?
+         return unless ($val);
+         $val = thaw($val);
+         print STDERR "## property $path $meta: ",(Dump($val) || 'undef'),"\n" if ($self->{'debug'});
+         return $val->{$meta} if ($meta);
+         return $val;
+ }
+ =head2 finish_update
+ This method will close index binary and enable search. Searching is not
+ available while indexing is in process.
+   $i->finish_update;
+ Usually, you don't need to call this method directly. It will be called on
+ DESTROY when $i goes out of scope or when you first call search in session
+ if indexing was started.
+ =cut
+ sub finish_update {
+         my $self = shift;
+         print STDERR "## finish_update\n" if ($self->{'debug'});
+         $self->_close_index && $self->_untie_meta_db;
+ }
+ sub DESTROY {
+         my $self = shift;
+         $self->finish_update;
+ }
  =head1 PRIVATE METHODS
- Private methods implement internals for creating temporary file needed for
+ Private methods implement internals for creating temporary files needed for
- swish++. You should have no need to call them directly, and they are here
+ SWISH++. You should have no need to call them directly, and they are here
  just to have documentation.
  =head2 _init_indexer
-Line 259 
 It will also create empty file C<_stopwo
+Line 406 
 It will also create empty file C<_stopwo
  sub _init_indexer {
          my $self = shift;
-         $self->{'tmp_dir'} = tempdir( CLEANUP => 1 ) || confess "can't create temporary directory: $!";
+         return if ($self->{'_index_fh'});
+         my $tmp_dir = tempdir( CLEANUP => 1 ) || confess "can't create temporary directory: $!";
+         $self->{'tmp_dir'} = $tmp_dir;
+         chdir $tmp_dir || confess "can't chdir to ".$tmp_dir.": $!";
+         print STDERR "## tmp_dir: $tmp_dir\n" if ($self->{'debug'});
-         chdir $self->{'tmp_dir'} || confess "can't chdir to ".$self->{'tmp_dir'}.": $!";
+         my $opt = "-v " . ($self->{'debug'} || '0');
-         my $opt = "-v 4";
+         my $index_dir = $self->{'index_dir'} || confess "no index_dir?";
+         my $index_file = $index_dir . '/index';
+         if (-e $index_file && ! -z $index_file) {
+                 $opt .= ' -I ';
+                 $self->{'_incremental'} = 1;
+                 print STDERR "## using incremental indexing for $index_file\n" if ($self->{'debug'});
+         } else {
+                 $self->{'_incremental'} = 0;
+         }
          unless ($self->{'use_stopwrods'}) {
                  open(STOP, '>', "_stopwords_") || carp "can't create empty stopword file, skipping\n";
-Line 272 
 sub _init_indexer {
+Line 435 
 sub _init_indexer {
                  $opt .= " -s _stopwords_";
          }
-         my $open_cmd = '| '.$self->{'index'}.' '.$opt.' -e "html:*" -i '.$self->{'index_dir'}.'/index -';
+         my $open_cmd = '| '.$self->{'index'}.' '.$opt.' -e "html:*" -i '.$index_file.' -';
+         print STDERR "## init_indexer: $open_cmd\n" if ($self->{'debug'});
+         open($self->{'_index_fh'}, $open_cmd) || confess "can't start index with $open_cmd: $!";
-         open($self->{'index_fh'}, $open_cmd) || confess "can't start index with $open_cmd: $!";
+         chdir $self->{'cwd'} || confess "can't chdir to ".$self->{'cwd'}.": $!";
+         $self->_tie_meta_db(DB_CREATE);
-         return $self->{'index_fh'};
+         return $self->{'_index_fh'};
  }
  =head2 _create_doc
- Create temporary file and pass it's name to swish++
+ Create temporary file and pass it's name to SWISH++
    $i->_create_doc(
          path => 'path/to/store/in/index',
-Line 295 
 Create temporary file and pass it's name
+Line 462 
 Create temporary file and pass it's name
          }
    );
- To delete document, just omit body and meta data.
  =cut
  sub _create_doc {
-Line 305 
 sub _create_doc {
+Line 470 
 sub _create_doc {
          my $arg = {@_};
          # open indexer if needed
-         $self->{'index_fh'} ||= $self->_init_indexer;
+         $self->_init_indexer;
          my $path = $self->{'tmp_dir'} || confess "no tmp_dir?";
+         my $id = $arg->{'path'} || confess "no path?";
+         $path .= "/$id";
+         my $rev = $self->{'rev'}++;
-         open(TMP, '>', $arg->{'path'}) || die "can't create temp file ".$arg->{'path'}.": $!";
+         print STDERR "## _create_doc: $path [$rev]\n" if ($self->{'debug'});
+         open(TMP, '>', $path) || die "can't create temp file $path: $!";
          print TMP '<html><head>';
-         $arg->{'body'} ||= '';
+         my $body = $arg->{'body'};
+         if (defined($body)) {
+                 $self->{'meta_db'}->{"B$id"} = $body;
+         } else {
+                 $body = '';
+         }
+         my $title = $arg->{'title'};
          if ($arg->{'meta'}) {
                  foreach my $name (keys %{$arg->{'meta'}}) {
                          my $content = $arg->{'meta'}->{$name};
                          print TMP qq{<meta name="$name" content="$content">};
-                         $arg->{'body'} .= " $content" if ($self->{'meta_in_body'});
+                         $body .= " $content" if ($self->{'meta_in_body'});
                  }
+                 $arg->{'meta'}->{'title'} = $title;
+                 $self->{'meta_db'}->{"M$id"} = freeze($arg->{'meta'});
          }
-         if (defined($arg->{'title'})) {
+         if (defined($title)) {
-                 print TMP '<title>' . ($arg->{'title'} || '') . '</title>';
+                 $title = "$rev $title";
-                 $arg->{'body'} .= " ".$arg->{'title'} if ($self->{'meta_in_body'});
+                 $body .= " $title" if ($self->{'meta_in_body'});
+         } else {
+                 $title = "$rev $id";
          }
-         print TMP '</head><body>' . $arg->{'body'} . '</body></html>';
+         # dump html
+         print TMP "<title>$title</title></head><body>$body</body></html>";
          close(TMP) || confess "can't close tmp file ".$arg->{'path'}.": $!";
-         print { $self->{'index_fh'} } $arg->{'path'}."\n";
+         print { $self->{'_index_fh'} } "$id\n" || confess "can't pass document $id to indexer: $!";
+         $self->{'meta_db'}->{"R$id"} = $rev;
+         # FIXME this is probably not the right place to update global
+         # maximum revision, but it keeps database in sane state
+         $self->{'meta_db'}->{"Crev"} = $rev;
  }
  =head2 _close_index
-Line 348 
 You have to close index before searching
+Line 538 
 You have to close index before searching
  sub _close_index {
          my $self = shift;
-         return unless ($self->{'index_fh'});
+         $self->_store_deleted;
+         return unless ($self->{'_index_fh'});
          print STDERR "## close index\n" if ($self->{'debug'});
-         close($self->{'index_fh'});
+         close($self->{'_index_fh'}) || confess "can't close index: $!";
-         undef $self->{'index_fh'};
+         undef $self->{'_index_fh'};
+         if ($self->{'_incremental'}) {
+                 print STDERR "## move new index over old\n" if ($self->{'debug'});
+                 rename $self->{'index_dir'}.'/index.new',$self->{'index_dir'}.'/index' || die "can't move new index over old one: $!";
+         }
+         return 1;
+ }
+ =head2 _tie_meta_db
+ Open BerkeleyDB database with meta properties.
+   $i->_tie_meta_db(DB_CREATE);
+   $i->_tie_meta_db(DB_RDONLY);
+ }
+ =cut
+ sub _tie_meta_db  {
+         my $self = shift;
+         my $flags = shift || confess "need DB_CREATE or DB_RDONLY";
+         return if ($self->{'_meta_db_flags'} && $self->{'_meta_db_flags'} == $flags);
+         print STDERR "## _tie_meta_db($flags)\n" if ($self->{'debug'});
+         $self->_untie_meta_db;
+         $self->{'_meta_db_flags'} = $flags;
+         my $file = $self->{'index_dir'}.'/meta.db';
+         tie %{$self->{'meta_db'}}, "BerkeleyDB::Hash",
+                 -Filename => $file,
+                 -Flags    => $flags
+         or confess "cannot open $file: $! $BerkeleyDB::Error\n" ;
+         $self->{'rev'} = $self->{'meta_db'}->{'Crev'} || 0;
+         my $delref = $self->{'meta_db'}->{'Cdeleted'};
+         if ($delref) {
+                 $self->{'_deleted'} = thaw($delref);
+                 print "## deleted ",keys %{$self->{'_deleted'}}," records\n" if ($self->{'debug'});
+         } else {
+                 $self->{'_deleted'} = {};
+         }
+         $self->{'_deleted_counter'} = 0;
+         return 1;
+ }
+ =head2 _untie_meta_db
+ Close BerkeleyDB database with meta properties.
+   $i->_untie_meta_db;
+ =cut
+ sub _untie_meta_db {
+         my $self = shift;
+         return unless ($self->{'meta_db'});
+         print STDERR "## _untie_meta_db\n" if ($self->{'debug'});
+         untie %{$self->{'meta_db'}} || confess "can't untie!";
+         undef $self->{'meta_db'};
+         undef $self->{'_meta_db_flags'};
+         return 1;
+ }
+ =head2 _store_deleted
+ Save hash of deleted files using L<Storable>.
+   $i->_store_deleted;
+ =cut
+ sub _store_deleted {
+         my $self = shift;
+         return if (! $self->{'_deleted_counter'});
+         print STDERR "## save deleted ",Dump($self->{'_deleted'}) if ($self->{'debug'});
+         my $d = freeze($self->{'_deleted'});
+         $self->_tie_meta_db(DB_CREATE);
+         $self->{'meta_db'}->{'Cdeleted'} = $d ||
+                 carp "can't store deleted: $!";
+         # reset counter
+         $self->{'_deleted_counter'} = 0;
  }
 ;
-Line 367 
 None by default.
+Line 659 
 None by default.
  =head2 Debian
- Debian version of swish++ is often old (version 5 at moment of this writing
+ Debian version of SWISH++ is often old (version 5 at moment of this writing
  while version 6 is available in source code), so this module by default
  uses executable names B<index> and B<search> for self-compiled version
  instead of one from Debian package. See L<new> how to specify Debian
-Line 375 
 default binaries B<index++> and B<search
+Line 667 
 default binaries B<index++> and B<search
  =head2 SWISH++
- Aside from very good rewrite in C++, SWISH++ is fatster because it has
+ Aside from very good rewrite in C++, SWISH++ is faster because it uses
  claver heuristics about which data in input files are words to index and
  which are not. It's based on English language and might be best choice if
- you plan to install large amount of long text documents.
+ you plan to index large amount of long text documents.
  However, if you plan to index all data from structured storage (e.g. RDBMS)
  you might want B<all> words from data to end up in index as opposed to just
-Line 386 
 those which look like English words. Thi
+Line 678 
 those which look like English words. Thi
  don't plan to index English texts with this module.
  With distribution build versions of SWISH++ you might have problems with
- disepearing words. To overcome this problem, you will have to compile and
+ disapearing words. To overcome this problem, you will have to compile and
  configure SWISH++ yourself (because language characteristics are
  compilation-time option).
-Line 402 
 configuration is needed for B<date test>
+Line 694 
 configuration is needed for B<date test>
  doesn't recognize 2004-12-05 as date. Have in mind that your index size
  might explode.
+ =head1 BUGS
+ Currently there is no way to specify which meta data will be stored as
+ properties. B<This will be fixed very soon>.
+ There is no garbage collection on temporary files created for SWISH++. This
+ means that one run of indexer will take additional disk space for temporary
+ files, which will be removed at end. There should be some way to remove
+ files after they are indexed by SWISH++. However, at this early stage of
+ development it's just not supported yet. Have plenty of disk space!
  =head1 SEE ALSO
- C<swish++> web site L<http://homepage.mac.com/pauljlucas/software/swish/>
+ SWISH++ web site L<http://homepage.mac.com/pauljlucas/software/swish/>
  =head1 AUTHOR

 Legend:



Removed from v.11
 


changed lines


 
Added in v.22
 Legend:



Removed from v.11
 


changed lines


 
Added in v.22
-Removed from v.11
+Added in v.22

	ViewVC Help
Powered by ViewVC 1.1.26