Whitespace. gah.
[working/Evergreen.git] / Open-ILS / src / perlmods / OpenILS / Application / Storage / FTS.pm
index 1081203..05c4dec 100644 (file)
@@ -4,12 +4,35 @@ my $log = 'OpenSRF::Utils::Logger';
 #-------------------------------------------------------------------------------
 package OpenILS::Application::Storage::FTS;
 use OpenSRF::Utils::Logger qw/:level/;
+use Parse::RecDescent;
+use OpenILS::Utils::Normalize qw( naco_normalize );
+
+my $_default_grammar_parser = new Parse::RecDescent ( <<'GRAMMAR' );
+
+<autotree>
+
+search_expression: or_expr(s) | and_expr(s) | expr(s)
+or_expr: lexpr '||' rexpr
+and_expr: lexpr '&&' rexpr
+lexpr: expr
+rexpr: expr
+expr: phrase(s) | group(s) | word(s)
+joiner: '||' | '&&'
+phrase: '"' token(s) '"'
+group : '(' search_expression ')'
+word: numeric_range | negative_token | token
+negative_token: '-' .../\D+/ token
+token: /[-\w]+/
+numeric_range: /\d+-\d*/
+
+GRAMMAR
 
 sub compile {
 
        $log->debug("You must override me somewhere, or I will make searching really slow!!!!",ERROR);;
 
        my $self = shift;
+       my $class = shift;
        my $term = shift;
 
        $self = ref($self) || $self;
@@ -31,17 +54,21 @@ sub compile {
 sub decompose {
        my $self = shift;
        my $term = shift;
+       my $parser = shift || $_default_grammar_parser;
 
        $term =~ s/:/ /go;
+       $term =~ s/\s+--\s+/ /go;
        $term =~ s/(?:&[^;]+;)//go;
        $term =~ s/\s+/ /go;
        $term =~ s/(^|\s+)-(\w+)/$1!$2/go;
        $term =~ s/\b(\+)(\w+)/$2/go;
        $term =~ s/^\s*\b(.+)\b\s*$/$1/o;
-       $term =~ s/^(?:an?|the)\b(.*)/$1/o;
+       $term =~ s/(\d{4})-(\d{4})/$1 $2/go;
+       #$term =~ s/^(?:an?|the)\b(.*)/$1/o;
 
        $log->debug("Stripped search term string is [$term]",DEBUG);
 
+       my $parsetree = $parser->search_expression( $term );
        my @words = $term =~ /\b((?<!!)\w+)\b/go;
        my @nots = $term =~ /\b(?<=!)(\w+)\b/go;
 
@@ -60,6 +87,7 @@ sub decompose {
        $self->{ fts_op } = 'ILIKE';
        $self->{ fts_col } = $self->{ text_col } = 'value';
        $self->{ raw } = $term;
+       $self->{ parsetree } = $parsetree;
        $self->{ words } = \@words;
        $self->{ nots } = \@nots;
        $self->{ phrases } = \@parts;
@@ -87,6 +115,11 @@ sub raw {
        return $self->{raw};
 }
 
+sub parse_tree {
+       my $self = shift;
+       return $self->{parsetree};
+}
+
 sub fts_col {
        my $self = shift;
        return $self->{fts_col};
@@ -161,7 +194,10 @@ sub sql_where_clause {
 }
 
 #-------------------------------------------------------------------------------
-use Class::DBI;
+use UNIVERSAL::require; 
+BEGIN {                 
+       'Class::DBI::Frozen::301'->use or 'Class::DBI'->use or die $@;
+}     
 
 package Class::DBI;
 
@@ -213,3 +249,4 @@ package Class::DBI;
 }
 
 1;
+