package Lire::FilterExpr;

use strict;

use Carp;

use Lire::Utils qw/ check_param check_object_param /;

sub new {
    my $class = shift;

    my %args = @_;

    check_object_param( $args{'container'}, 'container',
                        'Lire::XMLSpecContainer' );

    my $self = bless { 'container' => $args{'container'},
		     }, $class;

    return $self;
}

sub _is_value_a_ref {
    my ( $self, $value ) = @_;

    return substr( $value, 0, 1 ) eq '$';
}

sub _is_value_a_fieldref {
    my ( $self, $value ) = @_;

    return ( $self->_is_value_a_ref( $value )
             && $self->{'container'}->has_field( $self->_refname_from_value( $value ) ) );
}

sub _validate_ref_value {
    my ( $self, $value ) = @_;

    croak "value '$value' isn't a parameter or field reference"
      unless $self->_is_value_a_ref( $value );

    my $name = $self->_refname_from_value( $value );

    croak "'$name' isn't a defined parameter or field name"
      unless $self->{'container'}->has_param( $name ) ||
        $self->{'container'}->has_field( $name );
}

sub _refname_from_value {
    my ( $self, $value ) = @_;

    croak "value '$value' isn't a parameter or field reference"
      unless $self->_is_value_a_ref( $value );

    return substr( $value, 1 );
}

sub _validate_value {
    my ( $self, $value ) = @_;

    $self->_validate_ref_value( $value )
      if $self->_is_value_a_ref( $value );

    return 1;
}

sub print {
    croak ref($_[0])  . ": unimplemented abstract method";
}

sub sql_expr {
    croak "Unimplemented sql_expr() in ", ref $_[0];
}

sub sql_params {
    croak "Unimplemented sql_params() in ", ref $_[0];
}

package Lire::FilterExpr::BinaryExpr;

use base qw/Lire::FilterExpr/;

use Carp;
use Lire::Utils qw/ xml_encode sql_quote_name check_param /;

sub new {
    my $self  = shift()->SUPER::new( @_ );

    my %args = @_;
    foreach my $para ( qw/ arg1 arg2 op sql_op / ) {
        check_param( $args{$para}, $para );
    }

    $self->{'op'} = $args{'op'};
    $self->{'sql_op'} = $args{'sql_op'};
    $self->arg1(  $args{'arg1'} );
    $self->arg2(  $args{'arg2'} );

    return $self;
}

sub arg1 {
    my ($self, $arg1) = @_;

    if ( @_ == 2) {
        check_param( $arg1, 'arg1' );
	$self->_validate_value( $arg1 );
	$self->{'arg1'} = $arg1;
    }

    $self->{'arg1'};
}

sub arg2 {
    my ($self, $arg2) = @_;

    if ( @_ == 2 ) {
        check_param( $arg2, 'arg2' );
	$self->_validate_value( $arg2 );
	$self->{'arg2'} = $arg2;
    }

    $self->{'arg2'};
}

sub print {
    my ($self,$fh, $prefix) = @_;
    $fh	    ||= \*STDOUT;
    $prefix ||= 0;

    my $pfx = " " x $prefix;
    my $arg1 = xml_encode( $self->{'arg1'} );
    my $arg2 = xml_encode( $self->{'arg2'} );

    print $fh $pfx,
      qq{<lire:$self->{'op'} arg1="$arg1" arg2="$arg2"/>\n};
}

sub sql_params {
    my $self = $_[0];

    my @params = ();
    push @params, $self->{'container'}->resolve_param_ref( $self->{'arg1'} ),
      unless ( $self->_is_value_a_fieldref( $self->{'arg1'} ) );
    push @params, $self->{'container'}->resolve_param_ref( $self->{'arg2'} ),
      unless ( $self->_is_value_a_fieldref( $self->{'arg2'} ) );

    return \@params;
}

sub sql_expr {
    my $self = $_[0];

    my $arg1 = ( $self->_is_value_a_fieldref( $self->{'arg1'} ) )
                 ? sql_quote_name($self->_refname_from_value( $self->{'arg1'}))
                   : '?';
    my $arg2 = ( $self->_is_value_a_fieldref( $self->{'arg2'} ) )
                 ? sql_quote_name($self->_refname_from_value( $self->{'arg2'}))
                   : '?';

    return "$arg1 $self->{'sql_op'} $arg2";
}

package Lire::FilterExpr::Eq;

use base qw/ Lire::FilterExpr::BinaryExpr /;

sub new {
    return shift()->SUPER::new( @_ , 'op' => "eq", 'sql_op' => '=' );
}

package Lire::FilterExpr::Ne;

use base qw/ Lire::FilterExpr::BinaryExpr /;

sub new {
    return shift()->SUPER::new( @_ , 'op' => "ne", 'sql_op' => '!=' );
}

package Lire::FilterExpr::BinaryNumericExpr;

use base qw/ Lire::FilterExpr::BinaryExpr /;

use Carp;

use Lire::DataTypes qw/ check_number is_numeric_type /;

sub _validate_value {
    my ( $self, $value ) = @_;

    if ( $self->_is_value_a_ref( $value )) {
        $self->_validate_ref_value( $value );

	my $name = $self->_refname_from_value( $value );
	my $type;
	# Make sure it has the proper type
	if ( $self->{'container'}->has_param( $name ) ) {
	    $type = $self->{'container'}->param( $name )->type;
	} else {
	    $type = $self->{'container'}->field( $name )->type;
	}
	croak "variable must be a numeric type"
	  unless is_numeric_type( $type );
    } else {
	croak "literal isn't an int or number"
	  unless check_number( $value );
    }

    return;
}

package Lire::FilterExpr::Lt;

use base qw/ Lire::FilterExpr::BinaryNumericExpr /;

sub new {
    return shift()->SUPER::new( @_, 'op' => "lt", 'sql_op' => '<' );
}

package Lire::FilterExpr::Le;

use base qw/ Lire::FilterExpr::BinaryNumericExpr /;

sub new {
    return shift()->SUPER::new( @_ , 'op' => "le", 'sql_op' => '<=' );
}

package Lire::FilterExpr::Gt;

use base qw/ Lire::FilterExpr::BinaryNumericExpr /;

sub new {
    return shift()->SUPER::new( @_ , 'op' => "gt", 'sql_op' => '>' );
}

package Lire::FilterExpr::Ge;

use base qw/ Lire::FilterExpr::BinaryNumericExpr /;

sub new {
    return shift()->SUPER::new( @_ , 'op' => "ge", 'sql_op' => '>=' );
}

package Lire::FilterExpr::Match;

use base qw/ Lire::FilterExpr /;

use Carp;

use Lire::DataTypes qw/ check_bool eval_bool /;
use Lire::Utils qw/ xml_encode sql_quote_name check_param /;

sub new {
    my $self  = shift()->SUPER::new( @_ );

    my %args = @_;

    foreach my $para ( qw/ value re / ) {
        check_param( $args{$para}, $para );
    }

    $self->value( $args{'value'} );
    $self->re( $args{'re'} );
    $self->case_sensitive( $args{'case-sensitive'} || 0 );

    return $self;
}

sub value {
    my ( $self, $value ) = @_;

    if ( @_ == 2) {
        check_param( $value, 'value' );
	$self->_validate_value( $value );
	$self->{'value'} = $value;
    }

    return $self->{'value'};
}

sub re {
    my ( $self, $re ) = @_;

    if ( @_ == 2 ) {
        check_param( $re, 're' );

        if ( $self->_is_value_a_ref( $re ) ) {
            my $name = $self->_refname_from_value( $re );
            $self->_validate_ref_value( $re );
            croak "re parameter cannot be a reference to a DLF field: $re"
              unless $self->{'container'}->has_param( $name );
        }
	$self->{'re'} = $re;
    }

    return $self->{'re'};
}

sub case_sensitive {
    my ( $self, $cs ) = @_;

    if ( @_ == 2 ) {
        check_param( $cs, 'cs' );
	croak "invalid bool value : $cs"
	  unless check_bool( $cs );
	$self->{'case_sensitive'} = $cs;
    }

    return eval_bool( $self->{'case_sensitive'} );
}

sub print {
    my ($self,$fh, $prefix) = @_;
    $fh	    ||= \*STDOUT;
    $prefix ||= 0;

    my $pfx = " " x $prefix;
    my $value = xml_encode( $self->{'value'} );
    my $re    = xml_encode( $self->{'re'} );

    print $fh $pfx, qq{<lire:match value="$value" re="$re"};
    if (defined $self->{'case_sensitive'}) {
	    print $fh qq{ case-sensitive="$self->{'case_sensitive'}"};
    }
    print $fh "/>\n";

    return;
}

sub sql_params {
    my $self = $_[0];

    my @params = ();

    push @params, $self->{'container'}->resolve_param_ref( $self->{'value' } )
      unless ( $self->_is_value_a_fieldref( $self->{'value' } ) );
    push @params, $self->{'container'}->resolve_param_ref( $self->{'re' } );

    return \@params;
}

sub sql_expr {
    my $self = $_[0];

    my $val;
    if ( $self->_is_value_a_fieldref( $self->{'value' } ) ) {
        $val = sql_quote_name( $self->_refname_from_value($self->{'value' }));
    } else {
        $val = '?';
    }

    return 'lr_match(' . $val . ',?,' . $self->case_sensitive() . ')';
}

package Lire::FilterExpr::Value;

use base qw/ Lire::FilterExpr /;

use Lire::Utils qw/ xml_encode sql_quote_name check_param /;
use Carp;

sub new {
    my $self  = shift()->SUPER::new( @_ );

    my %args = @_;
    check_param( $args{'value'}, 'value' );

    $self->value( $args{'value'} );

    return $self;
}

sub value {
    my ( $self, $value ) = @_;

    if ( @_ == 2 ) {
        check_param( $value, 'value' );
	$self->_validate_value( $value );
	$self->{'value'} = $value;
    }

    $self->{'value'};
}

sub print {
    my ($self,$fh, $prefix) = @_;
    $fh	    ||= \*STDOUT;
    $prefix ||= 0;

    my $pfx = " " x $prefix;
    my $value = xml_encode( $self->{'value'} );
    print $fh $pfx, qq{<lire:value value="$value"/>\n};
}

sub sql_params {
    my $self = $_[0];

    unless ( $self->_is_value_a_fieldref( $self->{'value' } ) ) {
        my $val = $self->{'container'}->resolve_param_ref ( $self->{'value' });
        return [ ( $val ) x 3 ];
    } else {
        return [];
    }
}

sub sql_expr {
    my $self = $_[0];

    if ( $self->_is_value_a_fieldref( $self->{'value' } ) ) {
        my $f = sql_quote_name( $self->_refname_from_value($self->{'value' }));
        return $f . ' IS NOT NULL AND ' . $f
          . ' != 0 AND LENGTH(' . $f . ') > 0';
    } else {
        return '? IS NOT NULL AND ? != 0 AND LENGTH(?) > 0';
    }
}

package Lire::FilterExpr::DlfSource;

use base qw/ Lire::FilterExpr /;

use Lire::Utils qw/ sql_quote_name check_param /;
use Carp;

sub new {
    my $self  = shift()->SUPER::new( @_ );

    my %args = @_;
    check_param( $args{'value'}, 'value' );

    $self->value( $args{'value'} );

    return $self;
}

sub value {
    my ( $self, $value ) = @_;

    if ( @_ == 2 ) {
        check_param( $value, 'value' );
	$self->_validate_value( $value );
	$self->{'value'} = $value;
    }

    $self->{'value'};
}

sub print {
    croak "Cannot print a Lire::FilterExpr::DlfSource";
}

sub sql_params {
    my $self = $_[0];

    unless ( $self->_is_value_a_fieldref( $self->{'value' } ) ) {
        return [ $self->{'container'}->resolve_param_ref ( $self->{'value' }) ];
    } else {
        return [ $self->{'value'} ];
    }
}

sub sql_expr {
    my $self = $_[0];

    return  $self->{'container'}->schema()->sql_table() . ".dlf_source" . " = ?";
}

package Lire::FilterExpr::Not;

use base qw/ Lire::FilterExpr /;

use Carp;
use Lire::Utils qw/ check_object_param /;

sub expr {
    my ( $self, $expr ) = @_;

    if ( @_ == 2 ) {
        check_object_param( $expr, 'expr', 'Lire::FilterExpr' );
	$self->{'expr'} = $expr;
    }

    return $self->{'expr'};
}

sub print {
    my ($self,$fh, $prefix) = @_;
    $fh	    ||= \*STDOUT;
    $prefix ||= 0;

    croak "invalid not expression: missing child"
      unless defined $self->{'expr'};

    my $pfx = " " x $prefix;
    print $fh $pfx, "<lire:not>\n";
    $self->{'expr'}->print( $fh, $prefix + 1 );
    print $fh $pfx, "</lire:not>\n";
}


sub sql_params {
    my $self = $_[0];

    return $self->{'expr'}->sql_params();
}

sub sql_expr {
    my $self = $_[0];

    return 'NOT (' . $self->{'expr'}->sql_expr() . ')';
}

package Lire::FilterExpr::And;

use base qw/ Lire::FilterExpr /;

use Carp;
use Lire::Utils qw/ check_object_param /;

sub expr {
    my ( $self, $expr ) = @_;

    if (@_ == 2 ) {
        check_object_param( $expr, 'expr', 'ARRAY' );
	croak "'expr' must contains at least one expression" unless @$expr;

	foreach my $e ( @$expr) {
            check_object_param( $e, 'e', 'Lire::FilterExpr' );
	}
	$self->{'expr'} = $expr;
    }

    return $self->{'expr'};
}

sub print {
    my ($self,$fh, $prefix) = @_;
    $fh	    ||= \*STDOUT;
    $prefix ||= 0;

    croak "invalid and expression: missing children"
      unless ref $self->{'expr'} eq 'ARRAY' &&
	@{$self->{'expr'}};

    my $pfx = " " x $prefix;
    print $fh $pfx, "<lire:and>\n";
    foreach my $e ( @{$self->{'expr'}}) {
	$e->print( $fh, $prefix + 1 );
    }
    print $fh $pfx, "</lire:and>\n";

    return;
}

sub sql_params {
    my $self = $_[0];

    return [ map { @{$_->sql_params()} } @{$self->{'expr'}} ];
}

sub sql_expr {
    my $self = $_[0];

    return join (' AND ', map {'(' . $_->sql_expr() . ')'} @{$self->{'expr'}});
}

package Lire::FilterExpr::Or;

use base qw/ Lire::FilterExpr /;

use Carp;
use Lire::Utils qw/ check_object_param /;

sub expr {
    my ( $self, $expr ) = @_;

    if ( @_ == 2 ) {
        check_object_param( $expr, 'expr', 'ARRAY' );
	croak "'expr' must contain at leat one expression" unless @$expr;

	foreach my $e ( @$expr) {
	    croak "$e isn't an expression"
	      unless UNIVERSAL::isa( $e, 'Lire::FilterExpr' );
	}
	$self->{'expr'} = $expr;
    }

    $self->{'expr'};
}

sub print {
    my ($self,$fh, $prefix) = @_;
    $fh	    ||= \*STDOUT;
    $prefix ||= 0;

    croak "invalid or expression: missing children"
      unless ref $self->{'expr'} eq 'ARRAY' &&
	@{$self->{'expr'}};

    my $pfx = " " x $prefix;
    print $fh $pfx, "<lire:or>\n";
    foreach my $e ( @{$self->{'expr'}}) {
	$e->print( $fh, $prefix + 1 );
    }
    print $fh $pfx, "</lire:or>\n";
}

sub sql_params {
    my $self = $_[0];

    return [ map { @{$_->sql_params()} } @{$self->{'expr'}} ];
}

sub sql_expr {
    my $self = $_[0];

    return join (' OR ', map {'(' . $_->sql_expr() . ')'} @{$self->{'expr'}});
}

# keep perl happy
1;

__END__

=pod

=head1 NAME

Lire::FilterExpr - Lire Filter expression

=head1 SYNOPSIS

 use Lire::FilterExpr

=head1 DESCRIPTION

FIXME

=head1 AUTHOR

  Francis J. Lacoste <flacoste@logreport.org>

=head1 VERSION

$Id: FilterExpr.pm,v 1.33 2008/03/09 19:27:31 vanbaal Exp $

=head1 COPYRIGHT

Copyright (C) 2001 Stichting LogReport Foundation LogReport@LogReport.org

This file is part of Lire.

Lire is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program (see COPYING); if not, check with
http://www.gnu.org/copyleft/gpl.html. 

=cut
