File Coverage

blib/lib/SWISH/API/Common.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

###########################################
# SWISH::API::Common
###########################################

###########################################
package SWISH::API::Common;
###########################################

use strict;
use warnings;

our $VERSION         = "0.04";
our $SWISH_EXE       = "swish-e";
our @SWISH_EXE_PATHS = qw(/usr/local/bin);

use SWISH::API;
use File::Path;
use File::Find;
use File::Spec;
use File::Basename;
use Log::Log4perl qw(:easy);
use Sysadm::Install qw(:all);
use File::Temp qw(tempfile);

###########################################
sub new {
###########################################
    my($class, %options) = @_;

    my $self = {
        swish_adm_dir             => "$ENV{HOME}/.swish-common",
        swish_exe                 => swish_find(),
        swish_fuzzy_indexing_mode => "Stemming_en",
        %options,
    };

    my $defaults = {
        swish_idx_file   => "$self->{swish_adm_dir}/default.idx",
        swish_cnf_file   => "$self->{swish_adm_dir}/default.cnf",
        dirs_file        => "$self->{swish_adm_dir}/default.dirs",
        streamer         => "$self->{swish_adm_dir}/default.streamer",
        file_len_max     => 100_000,
        atime_preserve   => 0,
    };

    for my $name (keys %$defaults) {
        if(! exists $self->{$name}) {
            $self->{$name} = $defaults->{$name};
        }
    }

    LOGDIE "swish-e executable not found" unless -x $self->{swish_exe};

    bless $self, $class;
}

###########################################
sub index_remove {
###########################################
    my($self) = @_;

    unlink $self->{swish_idx_file};
}

###########################################
sub search {
###########################################
    my($self, $term) = @_;

    if(! -f $self->{swish_idx_file}) {
        ERROR "Index file $self->{swish_idx_file} not found";
        return undef;
    }

    my $swish = SWISH::API->new($self->{swish_idx_file});

    $swish->AbortLastError
        if $swish->Error;

    my $results = $swish->Query($term);

    $swish->AbortLastError
        if $swish->Error;

       # We might change this in the future to return an iterator
       # in scalar context
    my @results = ();

    while (my $r = $results->NextResult) {
        my $hit = SWISH::API::Common::Hit->new(
                      path => $r->Property("swishdocpath")
                  );
        push @results, $hit;
    }

    return @results;
}

###########################################
sub files_stream {
###########################################
    my($self) = @_;

    my @dirs = split /,/, slurp $self->{dirs_file};

    my @files = grep { -f } @dirs;
       @dirs  = grep { ! -f } @dirs;

    for(@files) {
        $self->file_stream($_);
    }

    return unless @dirs;

    find(sub {
        return unless -f;
        return unless -T;

        my $full = $File::Find::name;

        DEBUG "Indexing $full";
        $self->file_stream(File::Spec->rel2abs($_));

    }, @dirs);
}

############################################
sub file_stream {
############################################
    my($self, $file) = @_;

    my @saved;

    if($self->{atime_preserve}) {
        @saved = (stat($file))[8,9];
    }

    if(! open FILE, "<$file") {
        WARN "Cannot open $file ($!)";
        return;
    }

    my $rc = sysread FILE, my $data, $self->{file_len_max};

    unless(defined $rc) {
        WARN "Can't read $file $!";
        return;
    }
    close FILE;

    if($self->{atime_preserve}) {
        utime(@saved, $file);
    }

    my $size = length $data;

    print "Path-Name: $file\n",
          "Document-Type: TXT*\n",
          "Content-Length: $size\n\n";
    print $data;
}

############################################
sub dir_prep {
############################################
    my($file) = @_;

    my $dir = dirname($file);

    if(! -d $dir) {
        mkd($dir) unless -d $dir;
    }
}

############################################
sub index_add {
############################################
    my($self, $dir) = @_;

        # Index new doc in tmp idx file
    my $old_idx_name = $self->{swish_idx_file};
    (my $dummy, my $old_idx) = tempfile(CLEANUP => 1);
    mv $old_idx_name, $old_idx;
    mv "$old_idx_name.prop", "$old_idx.prop";

    ($dummy, $self->{swish_idx_file}) = tempfile(CLEANUP => 1);
    $self->index($dir);

        # Merge two indices
    my($stdout, $stderr, $rc) = tap($self->{swish_exe}, "-M",
                                    $old_idx,
                                    $self->{swish_idx_file},
                                    $old_idx_name);

    if($rc != 0) {
        ERROR "Merging failed: $stdout $stderr";
        return undef;
    }

    $self->{swish_idx_file} = $old_idx_name;
}

############################################
sub index {
############################################
    my($self, @dirs) = @_;

        # Make a new dirs file
    dir_prep($self->{dirs_file});
    blurt join(',', @dirs), $self->{dirs_file};

        # Make a new swish conf file
    dir_prep($self->{swish_cnf_file});
    blurt <{swish_cnf_file};
IndexDir  $self->{streamer}
IndexFile $self->{swish_idx_file}
FuzzyIndexingMode $self->{swish_fuzzy_indexing_mode}
EOT

        # Make a new streamer
    dir_prep($self->{streamer});
    my $perl = perl_find();
    blurt <{streamer};
#!$perl
use SWISH::API::Common;
SWISH::API::Common->new(
        dirs_file    => '$self->{dirs_file}',
        file_len_max => '$self->{file_len_max}',
)->files_stream();
EOT

    chmod 0755, $self->{streamer} or
        LOGDIE "chmod of $self->{streamer} failed ($!)";

    my($stdout, $stderr, $rc) = tap($self->{swish_exe}, "-c",
                                    $self->{swish_cnf_file},
                                    "-e", "-S", "prog");

    unless($stdout =~ /Indexing done!/) {
        ERROR "Indexing failed: $stdout $stderr";
        return undef;
    }

    DEBUG "$stdout";

    1;
}

###########################################
sub perl_find {
###########################################

    if($^X =~ m#/#) {
        return $^X;
    }

    return exe_find($^X);
}

###########################################
sub swish_find {
###########################################

    for my $path (@SWISH_EXE_PATHS) {
        if(-f File::Spec->catfile($path, $SWISH_EXE)) {
                return File::Spec->catfile($path, $SWISH_EXE);
        }
    }

    return exe_find($SWISH_EXE);
}

###########################################
sub exe_find {
###########################################
    my($exe) = @_;

    for my $path (split /:/, $ENV{PATH}) {
        if(-f File::Spec->catfile($path, $exe)) {
                return File::Spec->catfile($path, $exe);
        }
    }

    return undef;
}

###########################################
package SWISH::API::Common::Hit;
###########################################

make_accessor(__PACKAGE__, "path");

###########################################
sub new {
###########################################
    my($class, %options) = @_;

    my $self = {
        %options,
    };

    bless $self, $class;
}

##################################################
# Poor man's Class::Struct
##################################################
sub make_accessor {
##################################################
    my($package, $name) = @_;

    no strict qw(refs);

    my $code = <
        *{"$package\\::$name"} = sub {
            my(\$self, \$value) = \@_;

            if(defined \$value) {
                \$self->{$name} = \$value;
            }
            if(exists \$self->{$name}) {
                return (\$self->{$name});
            } else {
                return "";
            }
        }
EOT
    if(! defined *{"$package\::$name"}) {
        eval $code or die "$@";
    }
}

1;

__END__