CQL::TermNode - represents a terminal Node in a CQL Parse Tree

CQL-Parser documentation Contained in the CQL-Parser distribution.

Index

Code Index:

NAME

Top

CQL::TermNode - represents a terminal Node in a CQL Parse Tree

SYNOPSIS

Top

DESCRIPTION

Top

CQL::TermNode represents a terminal in a CQL parse tree. A term node consists of the string itself with optional qualifier string and relation. Examples could include:

* george
* dc.creator=george

METHODS

Top

new()

The constructor which has must have at least a term attribute, and can also include optional qualifier and modifier terms.

getQualifier()

Get the qualifier in the terminal.

getRelation()

Get the relation in the terminal.

getTerm()

Get the actual term string in the terminal.

toCQL()

Returns a CQL representation of the terminal node.

toSwish()

toXCQL()

toLucene()

CQL-Parser documentation Contained in the CQL-Parser distribution. 
package CQL::TermNode;

use strict;
use warnings;
use base qw( CQL::Node );
use Carp qw( croak );
use CQL::Utils qw( indent xq renderPrefixes );


sub new {
    my ($class,%args) = @_;
    croak( "must supply term parameter" ) if ! exists( $args{term} );
    return bless \%args, ref($class) || $class; 
}


sub getQualifier {
    return shift->{qualifier};
}


sub getRelation {
    return shift->{relation};
}


sub getTerm {
    return shift->{term};
}


sub toCQL {
    my $self = shift;
    my $qualifier = maybeQuote( $self->getQualifier() );
    my $term = maybeQuote( $self->getTerm() );
    my $relation = $self->getRelation();

    my $cql;
    if ( $qualifier and $qualifier !~ /srw\.serverChoice/i ) { 
        $cql = join( ' ', $qualifier, $relation->toCQL(), $term);
    } else {
        $cql = $term;
    }
    return $cql;
}


sub toSwish {
    my $self = shift;
    my $qualifier = maybeQuote( $self->getQualifier() );
    my $term = maybeQuote( $self->getTerm() );
    my $relation = $self->getRelation();
    my $swish; 
    if ( $qualifier and $qualifier !~ /srw\.serverChoice/i ) { 
        $swish = join( ' ', $qualifier, $relation->toSwish(), $term );
    } else {
        $swish = $term;
    }
    return $swish;
}


sub toXCQL {
    my ($self,$level,@prefixes) = @_;
    $level  = 0 unless $level;
    my $xml = 
        indent($level) . "<searchClause>\n" .
        renderPrefixes($level+1,@prefixes) .
        indent($level+1) . "<index>".xq($self->getQualifier())."</index>\n";
    if ( $self->getRelation() ) {
        $xml .= $self->getRelation()->toXCQL($level+1);
    }
    $xml .= 
        indent($level+1) . "<term>" . xq($self->getTerm()) . "</term>\n" . 
        indent($level) . "</searchClause>\n";
    return $self->addNamespace( $level, $xml );
}


sub toLucene {
    my $self      = shift;
    my $qualifier = maybeQuote( $self->getQualifier() );
    my $term      = maybeQuote( $self->getTerm() );
    my $relation  = $self->getRelation();

    my $query; 
    if ( $qualifier and $qualifier !~ /srw\.serverChoice/i ) { 
        my $base      = $relation->getBase();
        my @modifiers = $relation->getModifiers();

        foreach my $m ( @modifiers ) {
            if( $m->[ 1 ] eq 'fuzzy' ) {
                $term = "$term~";
            }
        }

	if( $base eq '=' ) {
	        $base = ':';
	}
	else {
		croak( "Lucene doesn't support relations other than '='" );
	}
        return "$qualifier$base$term";
    }
    else {
        return $term;
    }
}

sub maybeQuote {
    my $str = shift;
    return if ! defined $str;
    if ( $str =~ m|[" \t=<>/()]| ) { 
        $str =~ s/"/\\"/g;
        $str = qq("$str");
    }
    return $str;
}

1;