package GO::MsgLite;

use strict;
use lib '/Users/gwg/go/scratch/tools';
#use Carp;
use Exporter;
use Data::Dumper;

use vars qw($AUTOLOAD @EXPORT @EXPORT_OK);

#@EXPORT = 
@EXPORT_OK = qw(startme debugme printerr);


my $error_levels = [ 'info', 'warning', 'fatal' ];

my $secret_error_levels = [ 'catastrophe' ];


=head2 new

Initialize a MsgLite object

input:  class, optional param hash including verbosity level
output: MsgLite object

=cut

sub new 
{	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self = {};

	bless $self, $class;

print STDERR "Creating a new MsgLite!\n";

	my $params = shift;

print STDERR "params: ".Dumper($params);

	# if there is a verbosity param in the initialization hash, adjust the
	# verbosity level accordingly
	if ($params->{verbosity} || $params->{verbosity_level} || $params->{verbose} || $ENV{VERBOSE} )
	{	$self->set_verbosity( $params->{verbosity} || $params->{verbosity_level} || $params->{verbose} || $ENV{VERBOSE});
	}
	else
	{	# set the verbosity level to an environmental variable or to off
		$self->{__VERBOSITY} = 0;
		print STDERR "Setting verbosity to OFF\n";
	}

	return $self;
}


=head2 set_verbosity

Set the level of STDERR disturbance you want from MsgLite

input:  self, verbosity level indicator
output: MsgLite object with verbosity set

Possible values for verbosity:

off => no debugme, startme or endme warnings.

1 || verbose || low => low verbosity; debugme stuff is printed

superverbose || super || high => high verbosity; debugme, startme, endme all printed

=cut

sub set_verbosity {
	my $self = shift;
	my $verbosity_level = shift;
	return if ! defined $verbosity_level;
	
	# set the verbosity level
	if ($verbosity_level eq '0' || $verbosity_level eq 'off')
	{	$self->{__VERBOSITY} = 0;
		$self->debugme("setting the verbosity level...");
		print STDERR "Verbosity is OFF!\n";
	}
	elsif ($verbosity_level eq '1' || $verbosity_level eq 'verbose' || $verbosity_level eq 'low')
	{	$self->{__VERBOSITY} = 'verbose';
		print STDERR "Setting verbosity to 'verbose'\n";
	}
	elsif ($verbosity_level eq 'superverbose' || $verbosity_level eq 'super' || $verbosity_level eq 'high')
	{	$self->{__VERBOSITY} = 'superverbose';
		print STDERR "Setting verbosity to 'superverbose'\n";
	}
	else
	{	# don't understand this verbosity level!
		$self->printerr("Invalid verbosity level: $verbosity_level!");
	}
	
}

=head2 verbosity

Find out what the verbosity level is

=cut

sub verbosity {
	my $self = shift;
	
#	print STDERR "ref of $self\n";
	if (! ref $self)
	{	print STDERR "$self has no ref!\n" unless $self =~ /GO::(Boolean|MsgLite)/;
		return $ENV{VERBOSE} || 0;
	}
	
	return $self->{__VERBOSITY} || 'Verbosity is OFF';
}

=head2 info_msg, warning_msg, fatal_msg

Methods to add a message to the current list

input:	$self, $message

output:	none (message added to $self)

Messages can be in one of two forms;

- string
- hash with the message as a value with the key 'MSG', 'MSG_CODE' or 'MSG_HTML'

# MSG_CODE is a code for a standard message
# MSG is an unformatted string, suitable for outputting as a <p>
# MSG_HTML is an HTML-formatted string

=cut

sub info_msg {
	my $self = shift;
	$self->_add_message(shift, { class => 'info' });
}

*add_info = \&info_msg;

sub warning_msg {
	my $self = shift;
	$self->_add_message(shift, { class => 'warning' });
}

*add_warning = \&warning_msg;
*warning_error = \&warning_msg;
*warning_err = \&warning_msg;

sub fatal_msg {
	my $self = shift;
	$self->_add_message(shift, { class => 'fatal' });
}

*add_fatal = \&fatal_msg;
*fatal_error = \&fatal_msg;
*fatal_err = \&fatal_msg;


=head2 add_message_list

Add a list of messages

=cut

sub add_message_list {
	my $self = shift;
	my $list = shift;
	my $arg_h = shift;
	$self->_add_message($_, $arg_h) foreach @$list;
}

*add_errors = \&add_message_list;
*add_error_list = \&add_message_list;
*add_messages = \&add_message_list;
*add_msg_list = \&add_message_list;
*add_msgs = \&add_message_list;


sub _add_message {
	my $self = shift;
	my $msg = shift;
	my $arg_h = shift || {};

	my $message;

	# if it's just a string, add it to the list of messages
	if (! ref $msg)
	{	# make sure it's actually defined!
		if (! defined $msg)
		{	$self->printerr("No message defined! Error from ".
			join "; ", map{ (caller($_))[3] } (0..5));
			return;
		}

		$message = { MSG => $msg };

		if (! $arg_h->{class} )
		{	$arg_h->{class} = $arg_h->{CLASS} || undef;
		}

		if (! defined $arg_h->{class})
		{	$self->debugme("No class supplied for message! Adding as a warning");
			$message->{CLASS} = 'warning';
		}
		elsif (! grep { $arg_h->{class} eq $_ } @$error_levels)
		{	$self->debugme("Message class is not valid!");
			$message->{CLASS} = 'warning';
		}
		else
		{	$message->{CLASS} = $arg_h->{class};
		}
	}
	elsif (ref $msg eq 'HASH')
	{	foreach my $key (keys %$msg)
		{	# convert keys to uppercase
			if (! $message->{ uc($key) })
			{	$message->{ uc($key) } = $msg->{$key};
			}
			else
			{	$self->debugme("Duplicate values for $key?");
			}
		}
		
		# check we have a message!
		if (! defined $message->{MSG} && ! defined $message->{MSG_CODE} && ! defined $message->{MSG_HTML} )
		{	$self->printerr("Message not defined in hash!\nHash: ".Dumper($message)."Error from " .
			join "; ", map{ (caller($_))[3] } (0..5));
			return;
		}
		
		if (! $message->{CLASS} )
		{	$message->{CLASS} = $arg_h->{class} || $arg_h->{CLASS} || undef;
		}
		
		# check the message class is OK

		if (! defined $message->{CLASS})
		{	$self->debugme("No class supplied for message! Adding as a warning");
			$message->{CLASS} = 'warning';
		}
		elsif (! grep { $message->{CLASS} eq $_ } @$error_levels)
		{	$self->debugme("Message class is not valid!");
			$message->{CLASS} = 'warning';
		}


	}
	elsif (ref $msg eq 'ARRAY')
	{	$self->_add_message($_) foreach @$msg;
	}
	else
	{	$self->printerr("msg is of the wrong type: ".(ref $msg)."\n".Dumper($msg));
	}

	# add any info we don't have
	if (! $message->{CALLER_LIST} )
	{	my $acc = 1;
		my $n_callers = 0;
		# add the caller
		while ($n_callers < 5)
		{	last if ! (caller($acc))[3];
			if ((caller($acc))[3] !~ /GO::MsgLite::/)
			{	push @{$message->{CALLER_LIST}}, (caller($acc))[3];
				$n_callers++;
			}
			$acc++;
		}
	}
	if (! $message->{CALLER} )
	{	$message->{CALLER} = join("; ", @{$message->{CALLER_LIST}});
	}

	push @{$self->{__MSG_LIST}}, $message;
	$self->_printmsg($message);
}


=head2 get_all_msgs

Get the current list of errors, either as a plain array, or formatted as a hash
with an indication of the maximum error level that occurred

input:  $self, $with_level (optional)
output: # with_level present:
        error list in the form
        level => ( 'fatal' | 'warning' | 'info' ), # max err level
        list => [ ... ] # list of all the errors found

        # with_level absent
        [ ... ] # list of all errors found

        or undef if there is no error list

=cut

sub get_all_msgs {
	my $self = shift;
	my $with_level = shift;

	return undef unless $self->{__MSG_LIST} && @{$self->{__MSG_LIST}};

	return $self->{__MSG_LIST} if ! $with_level;

	# find out the maximum level of error seen
	my $seen_h;
	foreach (@{$self->{__MSG_LIST}})
	{	$seen_h->{ $_->{CLASS} }++;
	}

	my $max;
	foreach (reverse @{$error_levels})
	{	if ($seen_h->{$_})
		{	$max = $_;
			last;
		}
	}
	return { level => $max, list => $self->{__MSG_LIST} };
}

*get_all_errors = \&get_all_msgs;
*get_error_list = \&get_all_msgs;
*get_msg_list = \&get_all_msgs;


=head2 get_last_msg

Get the last error, formatted as a hash
Returns undef if there are no errors at present

=cut

sub get_last_msg {
	my $self = shift;
	if ($self->{__MSG_LIST} && @{$self->{__MSG_LIST}})
	{	return $self->{__MSG_LIST}[-1];
	}
	return undef;
}


=head2 clear_all_msgs

Delete the entire message list

=cut

sub clear_all_msgs {
	my $self = shift;
	if ($self->{__MSG_LIST})
	{	$self->debugme("Clearing all errors!");
		delete $self->{__MSG_LIST};
	}
}


=head2 clear_last_msg

Delete the last message from the message list

=cut

sub clear_last_msg {
	my $self = shift;
	if ($self->{__MSG_LIST})
	{	$self->debugme("Clearing last error!");
		pop @{$self->{__MSG_LIST}};
	}
}


=head2 get_msg_by_class

Retrieve messages of a certain class

=cut

sub get_msg_by_class {
	my $self = shift;
	my $msg_class = shift || $self->printerr("No error class specified") && return undef;

	# return if there's no error list
	return undef if ! defined $self->{__MSG_LIST}
	|| ! @{$self->{__MSG_LIST}};
	
	# check the error level specified is valid
	if (! grep { $msg_class eq $_ } @$error_levels)
	{	$self->printerr("Error class $msg_class does not exist!");
		return undef;
	}

	my @msgs = grep {
		$_->{CLASS} eq $msg_class
	} @{$self->{__MSG_LIST}};

	return undef if !@msgs;

	return [ @msgs ];

}

=head2 has_msgs

A check for whether the object has any errors attached to it or not.
Returns 1 if there are errors; undef otherwise.

=cut

sub has_msgs {
	my $self = shift;
	my $msg_class = shift;

	# return undefined if there's no __MSG_LIST parameter or it's an empty list
	return undef if ! defined $self->{__MSG_LIST}
		|| ! @{$self->{__MSG_LIST}}
		|| ! defined $self->{__MSG_LIST}[0];

	if ($msg_class)
	{	# check the error level specified is valid
		if (! grep { $msg_class eq $_ } @$error_levels)
		{	$self->printerr("Error class $msg_class does not exist!");
			return undef;
		}
	
		my @msgs = grep {
			$_->{CLASS} eq $msg_class
		} @{$self->{__MSG_LIST}};

		return undef if !@msgs;

	}
	
	return 1;

}

*has_errors = \&has_msgs;
*has_error_list = \&has_msgs;


=head2 has_n_msgs

A check for whether the object has any errors attached to it or not.
Returns 1 if there are errors; undef otherwise.

=cut

sub has_n_msgs {
	my $self = shift;
	my $msg_class = shift;

	# return undefined if there's no __MSG_LIST parameter or it's an empty list
	return 0 if ! defined $self->{__MSG_LIST}
		|| ! @{$self->{__MSG_LIST}}
		|| ! defined $self->{__MSG_LIST}[0];

	if ($msg_class)
	{	# check the error level specified is valid
		if (! grep { $msg_class eq $_ } @$error_levels)
		{	$self->printerr("Error class $msg_class does not exist!");
			return undef;
		}

		my @msgs = grep {
			$_->{CLASS} eq $msg_class
		} @{$self->{__MSG_LIST}};

		return 0 if !@msgs;
		
		return scalar @msgs;
	
	}

	return scalar @{$self->{__MSG_LIST}};

}

*has_n_errors = \&has_n_msgs;

=head2 _printmsg

Internal function to print an info / error message

input:  self, msg hash
output: message details to STDERR

=cut

sub _printmsg {
	my $self = shift;
	my $msg = shift;
#	print STDERR "message: ".Dumper($msg);
	print STDERR $msg->{CALLER_LIST}[0] . " " . $msg->{CLASS} . ": ". ( $msg->{MSG} || $msg->{MSG_CODE} || $msg->{MSG_HTML} ) . "\n";
}


=head2 printerr

External fn to print a Message

input:  self, message (as a text string)
output: message to STDERR

=cut

sub printerr {
	my $self = shift;
	my $msg = shift;
	print STDERR (caller(1))[3] . " line ". (caller(1))[2]
#	. "\n" . join(" - ", map { (caller($_))[3] } (0..5)) 
	. "\n$msg\n";
}

=head2 debugme

External fn to print a debugging message

input:  self, message (as a text string)
output: message to STDERR if verbosity is set to 'verbose' or 'superverbose'

=cut

sub debugme {
	my $self = shift;
	my $msg = shift;
	my $printall = shift;
	
	print STDERR "self: $self\nmsg: ".Dumper($msg) if $printall;
	
	if ($self->verbosity =~ /verbose/)
	{	print STDERR (caller(1))[3] . " line ". (caller(1))[2];
		print STDERR "\n$msg\n";
	}
}


=head2 startme

External fn to print a debugging message indicating a function is starting

input:  self
output: message to STDERR if verbosity is set to 'superverbose'

=cut

sub startme {
	my $self = shift;
	if ($self->verbosity eq 'superverbose')
	{	print STDERR "Starting ".(caller(1))[3]."\n";
	}
}

=head2 endme

External fn to print a debugging message indicating a function is finishing

input:  self
output: message to STDERR if verbosity is set to 'superverbose'

=cut

sub endme {
	my $self = shift;
	if ($self->verbosity eq 'superverbose')
	{	print STDERR "Finished ".(caller(1))[3]."\n";
	}
}

1;