File Coverage

blib/lib/CQL/TermNode.pm

Criterion	Covered	Total	%
statement	68	68	100.0
branch	18	20	90.0
condition	8	12	66.6
subroutine	14	14	100.0
pod	8	9	88.8
total	116	123	94.3

package CQL::TermNode;

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

=head1 NAME

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

=head1 SYNOPSIS

=head1 DESCRIPTION

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:

=over 4

=item * george

=item * dc.creator=george

=back

=head1 METHODS

=head2 new()

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

=cut

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

=head2 getQualifier()

Get the qualifier in the terminal.

=cut

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

=head2 getRelation()

Get the relation in the terminal.

=cut

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

=head2 getTerm()

Get the actual term string in the terminal.

=cut

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

=head2 toCQL()

Returns a CQL representation of the terminal node.

=cut

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;
}

=head2 toSwish()

=cut

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;
}

=head2 toXCQL()

=cut

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

=head2 toLucene()

=cut

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;