package ReDIF::Parser::Output;

#  This package is a class, whose objects will manage rech's and
#  rere's text output.  It provides very simple buffering, and
#  optional delayed output. 

##  Copyright (c) 1997-2001 Ivan Kurmanov. All rights reserved.
##
##  This code is free software; you can redistribute it and/or modify it
##  under the same terms as Perl itself.

$VERSION = "0.1";


use strict;

my @message_types_list = (  '',
			    'Notice', 
			    'Warning', 
			    'Error', 
			    'Critical Error' );

my %message_types = ( 
		      0 => "Notice",
		      1 => "Message",
		      2 => "Warning",
		      3 => "Error",
		      4 => "Critical Error",
		      );

my %message_ranks = ( 
		      'notice'   => 0,
		      'message'  => 1,
		      'warning'  => 2,
		      'error'    => 3,
		      'critical error' => 4, 
		      );

sub new {

    my $class = shift;
    my %para = @_;

    my $obj = {
	data => "",
#	data => [],
	data_buffer => '',
	data_prefix => '',
	text => '',
	message_count => 0,

    };

    foreach my $k ( keys %para ) {
	my $v = $para{$k};
	$obj -> {$k} = $v;
    }

    bless $obj, $class;
    return $obj;
}


##############################################################################
##  OUTPUT BUFFERING
##############################################################################

sub messages_count {
    my $self = shift;
    return $self->{message_count} ;
}


sub add_data {
    my $self = shift;
    my $text = shift;
    my $line_num = shift;
# #    my $q = $self->{quote_data} || '';
# #    $self->{data} .= "$q$text\n";
    $self->{data_buffer} .= $text;
    $self->{data_buffer} .= "\n";
}


sub flush_data_buffer {
    my $self = shift;
    if( $self->{data_buffer} ) {
	if( $self->{data} ) {
	    $self->{data} .= $self->{data_buffer};	    
	} else {
	    $self->{data} = $self->{data_buffer};	    
	}
	$self->{data_buffer} = '';	
	return 1;
    }
    return 0;
}


sub print {
    my $self = shift;
    print "\n", $self->{text};
};

sub clear {
    my $self = shift;

    $self->{text} = '';
    $self->{data} = "";
    $self->{data_buffer} = '';
    $self->{data_prefix} = '';
    $self->{messages}    = '';
    $self->{message_count} = 0;
};


sub get_text { 
    my $self = shift;
    return $self->{text};
}

sub get_messages {  
    my $self = shift;
    return $self->{messages};
}


sub error {
    my $self = shift;
    $self->add_message( @_, 3 );
}

sub warning {
    my $self = shift;
    $self->add_message( @_, 2 );
}

sub notice {
    my $self = shift;
    $self->add_message( @_, 1 );
}

sub critical {
    my $self = shift;
    $self->add_message( @_, 4 );
}

###############################################################################
###   message treatment
###############################################################################

sub set_minimal_message_type {
    my $self = shift;

    my $l = shift;

    if( ( $l !~ /^\d+$/ ) 
	or ( ($l < 0) and ($l > 5) ) ) {
	$l = $message_ranks{$l};
	if( not defined $l ) { die; }
    } 
    $self->{threshold} = $l;
}



sub add_message {
    my $self = shift;
    my $text = shift;
    my $rank = shift;

    my $last_attr = shift;

    if ( $rank < $self->{threshold} ) { return; }

    my $type = $message_types{$rank};

    die if not defined $type;

    $self->{message_count} ++;

    if( not $last_attr ) {
	$self->flush_data_buffer() ;
#	    or warn "nothing to flush";	
    } else {
#	if( $self->{data_buffer} ) {
#	    warn "not flushing a buffer";
#	} else {
#	    warn "nothing to flush";	
#	}
    }

    my $_data = $self->{data};

    if( $_data  
#	or ( ($_data->[0] ne "\n") or ($#$_data != 0) ) 
	) {
	$self->{text} .= join ( '', $self->{data_prefix}, 
				$_data, "\n", $type, " ", $text, "\n" ) ;
	$self->{data}      = "";
	$self->{data_prefix} = "\n";
    } else {
	$self->{text} .= "$type $text\n";
    }
    $self->{messages} .= "$type $text\n";
    
}



package ReDIF::Parser::Output::Filter;

use strict;

use vars qw( @ISA );

@ISA = ( 'ReDIF::Parser::Output' );


###  would be incomplete if any messages (above threshold)
###  happened before.

sub print {   
    my $self = shift;
    print $self->{data};
}

sub get_text {  
    my $self = shift;
    return $self->{data};
}




1;
