package Lire::AsciiDlf::FilterExpr;

use strict;

use Lire::FilterExpr;

use Carp;

use vars qw/ $VERSION @ISA /;

use Lire::DataTypes qw( :basic );

BEGIN {
    ($VERSION)	= '$Revision: 1.8 $' =~ m!Revision: ([.\d]+)!;
    @ISA = qw/ Lire::FilterExpr /;
}

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

    if ( $value =~ /^\$/ ) {
	my $n = substr $value, 1;
	if ( $self->{container}->has_param( $n ) ) {
	    return is_numeric_type( $self->{container}->param( $n )->type );
	} else {
	    return is_numeric_type( $self->{container}->schema()->field( $n )->type );
	}
    } else {
	return check_number( $value );
    }
}

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

    if ( $value =~ /^\$/ ) {
	my $n = substr $value, 1;
	if ( $self->{container}->has_param( $n ) ) {
	    my $v = $self->{container}->param( $n )->value();
	    return $v;
	} else {
	    my $pos = $self->{container}->schema()->field( $n )->pos();
	    return "dlf[$pos]";
	}
    } else {
	return $value;
    }
}

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

    my $is_num = $self->is_numeric_value( $value );
    if ( $value =~ /^\$/ ) {
	my $n = substr $value, 1;
	if ( $self->{container}->has_param( $n ) ) {
	    my $v = $self->{container}->param( $n )->value();
	    return $is_num ? $v : qq{q{$v}};
	} else {
	    my $pos = $self->{container}->schema()->field( $n )->pos();
	    return "\$_[0][$pos]";
	}
    } else {
	return $is_num ? $value : qq{q{$value}};
    }
}

sub compile {
    croak "Unimplemented: ", __PACKAGE__, "::compile";
}

package Lire::AsciiDlf::FilterExpr::BinaryExpr;

use vars qw/ @ISA /;

use Carp;

BEGIN {
    @ISA = qw/ Lire::FilterExpr::BinaryExpr Lire::AsciiDlf::FilterExpr /;
}

sub id {
    my ($self) = @_;
    my $arg1 = $self->make_id_value( $self->arg1 );
    my $arg2 = $self->make_id_value( $self->arg2 );
    my $op   = $self->make_eval_op();

    return "$op($arg1 $arg2)";
}

sub compile {
    my ($self) = @_;
    my $arg1 = $self->make_eval_value( $self->arg1 );
    my $arg2 = $self->make_eval_value( $self->arg2 );
    my $op   = $self->make_eval_op();

    my $code = qq! sub { $arg1 $op $arg2 } !;
    my $sub  = eval $code;
    croak "error compiling expression ($code): $@" if $@;

    return $sub;
}

sub make_eval_op {
    croak "Unimplemented: ", __PACKAGE__, "::make_eval_op";
}

package Lire::AsciiDlf::FilterExpr::Eq;

use vars qw/ @ISA /;

BEGIN {
    @ISA = qw/ Lire::FilterExpr::Eq Lire::AsciiDlf::FilterExpr::BinaryExpr /;
}

sub make_eval_op {
    my ( $self ) = @_;

    if ( $self->is_numeric_type( $self->arg1) &&
	 $self->is_numeric_type( $self->arg2) ) {
	return "==";
    } else {
	return "eq";
    }
}

package Lire::AsciiDlf::FilterExpr::Ne;

use vars qw/ @ISA /;

BEGIN {
    @ISA = qw/ Lire::FilterExpr::Ne Lire::AsciiDlf::FilterExpr::BinaryExpr /;
}

sub make_eval_op {
    my ( $self ) = @_;

    if ( $self->is_numeric_type( $self->arg1) &&
	 $self->is_numeric_type( $self->arg2) ) {
	return "!=";
    } else {
	return "ne";
    }
}

package Lire::AsciiDlf::FilterExpr::Lt;

use vars qw/ @ISA /;

BEGIN {
    @ISA = qw/ Lire::FilterExpr::Lt Lire::AsciiDlf::FilterExpr::BinaryExpr /;
}

sub make_eval_op {
    return "<";
}

package Lire::AsciiDlf::FilterExpr::Le;

use vars qw/ @ISA /;

BEGIN {
    @ISA = qw/ Lire::FilterExpr::Le Lire::AsciiDlf::FilterExpr::BinaryExpr /;
}

sub make_eval_op {
    return "<=";
}

package Lire::AsciiDlf::FilterExpr::Gt;

use vars qw/ @ISA /;

BEGIN {
    @ISA = qw/ Lire::FilterExpr::Gt Lire::AsciiDlf::FilterExpr::BinaryExpr /;
}

sub make_eval_op {
    return ">";
}

package Lire::AsciiDlf::FilterExpr::Ge;

use vars qw/ @ISA /;

BEGIN {
    @ISA = qw/ Lire::FilterExpr::Ge Lire::AsciiDlf::FilterExpr::BinaryExpr /;
}

sub make_eval_op {
    return ">=";
}

package Lire::AsciiDlf::FilterExpr::Match;

use Carp;

use vars qw/ @ISA /;

BEGIN {
    @ISA = qw/ Lire::FilterExpr::Match Lire::AsciiDlf::FilterExpr /;
}

sub id {
    my ( $self ) = @_;

    my $val = $self->make_id_value( $self->value );
    my $re  = "/" . $self->make_id_value( $self->re ) . "/";
    $re .= "i" unless $self->case_sensitive;

    return "match($val $re)";
}

sub compile {
    my ( $self ) = @_;

    my $val = $self->make_eval_value( $self->value );
    my $re = $self->re;
    my $flags = "";
    $flags .= "i" unless $self->case_sensitive;
    if ( $re =~ /\$/ ) {
	my $n = substr $re, 1;
	if ( $self->{container}->has_param( $n ) ) {
	    $re = $self->{container}->param( $n )->value();
	} else {
	    my $pos = $self->{container}->schema()->field( $n )->pos();
	    $re = "\$_[0][$pos]";
	}
    }

    my $code = qq|sub { $val =~ m<$re>$flags }|;
    my $sub  = eval $code;
    croak "error compiling expression ($code): $@" if $@;

    return $sub;
}

package Lire::AsciiDlf::FilterExpr::Value;

use vars qw/ @ISA /;

BEGIN {
    @ISA = qw/ Lire::FilterExpr::Value Lire::AsciiDlf::FilterExpr /;
}

sub id {
    my ( $self ) = @_;

    my $val = $self->make_eval_value( $self->value );

    return "value($val)";
}

sub compile {
    my ( $self ) = @_;

    my $val = $self->make_eval_value( $self->value );

    return sub { $val ? 1 : 0 };
}

package Lire::AsciiDlf::FilterExpr::Not;

use vars qw/ @ISA /;

BEGIN {
    @ISA = qw/ Lire::FilterExpr::Not Lire::AsciiDlf::FilterExpr /;
}

sub id {
    my ($self) = @_;

    my $id = $self->expr->id;
    return "not( $id )";
}

sub compile {
    my ($self) = @_;

    my $sub = $self->expr->compile;
    return sub { ! $sub->( $_[0] ) };
}

package Lire::AsciiDlf::FilterExpr::And;

use vars qw/ @ISA /;

BEGIN {
    @ISA = qw/ Lire::FilterExpr::And Lire::AsciiDlf::FilterExpr /;
}

sub id {
    my ($self) = @_;

    my @ids = ();
    foreach my $e ( @{$self->expr()} ) {
	push @ids, $e->id;
    }

    return "and( " . join( ", ", @ids) . " )";
}

sub compile {
    my ($self) = @_;

    my @expr = ();
    foreach my $e ( @{$self->expr()} ) {
	push @expr, $e->compile;
    }

    return sub {
	foreach my $e ( @expr ) {
	    return 0 unless $e->( $_[0] );
	}
	return 1;
    };
}

package Lire::AsciiDlf::FilterExpr::Or;

use vars qw/ @ISA /;

BEGIN {
    @ISA = qw/ Lire::FilterExpr::Or Lire::AsciiDlf::FilterExpr /;
}

sub id {
    my ($self) = @_;

    my @ids = ();
    foreach my $e ( @{$self->expr()} ) {
	push @ids, $e->id;
    }

    return "or( " . join( ", ", @ids) . " )";
}

sub compile {
    my ($self) = @_;

    my @expr = ();
    foreach my $e ( @{$self->expr()} ) {
	push @expr, $e->compile;
    }

    return sub {
	foreach my $e ( @expr ) {
	    return 1 if $e->( $_[0] );
	}
	return 0;
    };
}

# keep perl happy
1;

__END__

=pod

=head1 NAME

Lire::FilterExpr -

=head1 SYNOPSIS


=head1 DESCRIPTION

=head1 VERSION

$Id: FilterExpr.pm,v 1.8 2002/05/13 18:46:56 flacoste 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 or write to the Free Software 
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111, USA.

=head1 AUTHOR

Francis J. Lacoste <flacoste@logreport.org>

=cut
