# Copyright (c) 2006 Ondrej Vostal
#
# All rights reserved.  This program is free software; you can
# redistribute it and/or modify it under the same terms as Perl
# itself.

package Debug::Message;

=head1 NAME

Debug::Message - Eases the use of debug print with level, indentation and color.

=head1 SYNOPSIS

    use Debug::Message;
    use Log::Dispatch;
    use Log::Dispatch::Screen;

    my $dispatcher = Log::Dispatch->new;
    $dispatcher->add( Log::Dispatch::Screen->new( name => 'screen',
                                                  min_level => '0' ));

    my $info = Debug::Message->new(1);
    $info->add_dispatcher($dispatcher);
    $info->print("print");
    $info->yellow("warn");
    $info->red("err");
    $info->printcn("error message", 'bold red');

    my $critical = Debug::Message->new(5);
    $critical->add_dispatcher($dispatcher);
    $critical->redn("err");

For disabling the debugging simply do not attach any dispatchers.

    $critical->disable;  # Will detach the attached backend

=head1 DESCRIPTION

There was no module for simple debug messages supporting debug/verbosity levels
and indentation. So this is the one, that is supposed to take this
place.

This module is an art of frontend to Log::Dispatch as Log::Dispatch
itself supports levels, but no colors and the function's calling is
tedious.

There are some methods defined. Each outputs a different color,
optionally it can add a newline after the messaage. They dispatch the
messages to all added dispatchers, but generaly only one will be
needed as the Log::Dispatch itself can have more backends.

=head1 DETAILS

In theory the use is simple. You have to create some Debug::Message
objects. Each of these with different importance level. You connect
them to the same Log::Dispatch.

Then you set the min_level of Log::Dispatch according to the command
line or what ever. Only those messages, wich have enough high level
(larger or equal to the Log::Dispatche's one) are outputed. For more
complicated scenarios refer to Log::Dispatch(3).

=cut

use strict;
use warnings;
use Carp;
use Params::Validate qw(:all);
Params::Validate::validation_options( on_fail => sub { confess $_[0] } );
use Term::ANSIColor;
use SelfLoader;

our $VERSION = '1.00';

__DATA__
###############################################################################
# not exported subroutines
###############################################################################

=head2 Constructors

   use Debug::Message;
   my $debug = Debug::Message->new( $importance );

Will constuct and return new instance of Debug::Message with
importance level set to $importance. The level is a number in range from 0 to 7.

=cut

sub new {
    my $class = shift;
    my $self;
    $self = {};
    $self->{'indent_level'} = 0;
    $self->{'importance'} = shift;
    $self->{'dispatcher'} = '';

    bless($self, $class);
    return $self;
}

# Subroutines

=head2 Output functions

=head3 print( $message, ... );

=head3 printc( $message, ..., $colorspecs );

=head3 COLOR( $message, ... );

=head3 FUNCTIONn( $mssage, ... );

=cut

sub print {
  my $self = shift;
  $self->_begin;
  $self->_send(@_);
}
sub printn {
  my $self = shift;
  push(@_, "\n");
  $self->print(@_);
}

sub printc {
  my $self = shift;
  my $color = pop;
  $self->_begin;
  $self->_send(colored(@_, $color));
}
sub printcn {
  my $self = shift;
  my $color = pop;
  $self->_begin;
  $self->_send(colored(@_, $color));
  $self->_send("\n");
}

sub yellow {
  my $self = shift;
  $self->printc(@_, 'yellow');
}
sub red {
  my $self = shift;
  $self->printc(@_, 'red');
}
sub green {
  my $self = shift;
  $self->printc(@_, 'green');
}
sub blue {
  my $self = shift;
  $self->printc(@_, 'blue');
}
sub magenta {
  my $self = shift;
  $self->printc(@_, 'magenta');
}

sub yellown {
  my $self = shift;
  $self->yellow( @_ );
  $self->_send("\n");
}
sub redn {
  my $self = shift;
  $self->red( @_ );
  $self->_send("\n");
}
sub greenn {
  my $self = shift;
  $self->green( @_ );
  $self->_send("\n");
}
sub bluen {
  my $self = shift;
  $self->blue( @_ );
  $self->_send("\n");
}
sub magentan {
  my $self = shift;
  $self->magenta( @_ );
  $self->_send("\n");
}

=pod

All functions output is effected by the indentation level. The
I<print()> function will output an uncolored string. The I<COLOR>
fuctions output a colorizes string. The COLOR can be one of blue,
magenta, yellow, red, green. The I<FUNCTIONn> (printn, yellown, etc.) 
add a trailing newline to the messgage. And finaly the I<printc()>
function colorizes its message according to $colorspecs.

=over 2

=item B<$message>

Is a string to send to connected dispatcher modules (Log::Dispatch(3)).

=item B<$colorspecs>

Is color according to Term::ANSIColor(3) man page.

=back

=head2 Properties functions

=head3 add_dispatcher( $dispatcher );

Adds an output module to the object.

=over 2

=item B<$dispatcher>

This is the Log::Dispatch(3) object to connect to.

=back

=cut

sub add_dispatcher {           # Do not add the same log more than once!
  my $self = shift;
  my $log  = shift;		# Logger to connect to

  $self->{'dispatcher'} = $log;
}

=head3 disable();

Unsets the dispatcher thus disables the debugging. Returns the former
dispatcher.

=cut

sub disable {
  my $self = shift;
  my $d = $self->{'dispatcher'};
  $self->{'dispatcher'} = '';
  return $d;
}

=head2 Indentation level TODO, BUT WORKING

=head3 level( $level );

Assigns a level $level and returns a new value. If $level is omited
nothing is set and the old value is returned

=cut

sub level {
  my $self = shift;
  if (@_) { $self->{'indent_level'} = shift }
  return $self->{'indent_level'};
}

=head3 inc( $number );

Increases level by $number. If $number is omited the function behaves
as if it was one. The new level value is returned.

=cut

sub inc {
  my $self = shift;
  if (@_) {
    $self->{'indent_level'} = $self->{'indent_level'} + shift;
  }else{
    $self->{'indent_level'} += 1;
  }
  return $self->{'indent_level'};
}

=head3 dec( $number );

Decreases level by $number. If $number is omited the function behaves
as if it was one. The new value of level is returned.

=cut

sub dec {
  my $self = shift;
  if (@_) {
    $self->{'indent_level'} = $self->{'indent_level'} - shift;
  }else{
    $self->{'indent_level'} -= 1;
  }
  return $self->{'indent_level'};
}

###############################################################################
# packages private subroutines
###############################################################################
sub _send {
  my $self = shift;
  if($self->{'dispatcher'}) {
      $self->{'dispatcher'}->log( level => $self->{'importance'},
				  message => join(' ', @_) );
  }
}

# print out the begining of the line coresponding with the form hash and the calling function(the second parameter)
sub _begin {
  my $self = shift;

  my $method  = shift; # stdout/stderr
  my $cont = '  ';
  $self->_send( $cont x ($self->{level}) ); # number of spaces before the line begin...
}

# MAIN

1;

__END__


=head1 TODO

=over

=item *

test and retreve the user's ideas

=item *

somehow connect with a preprocessor to remove the debug-related calls in working environment

=back

=head1 NOTES

The best experience is to copy the initial setup from the synopsis. It
saves a lot of writing. Or from here; the more complicated one.

    ### Set-up debuggung facilities
    use Debug::Message;
    use Log::Dispatch;
    use Log::Dispatch::Screen;

    our $Verbosity_Level = '0';
    my $dispatcher = Log::Dispatch->new;
    $dispatcher->add( Log::Dispatch::Screen->new( name => 'screen',
                                                  min_level => $Verbosity_Level ));
    my $info = Debug::Message->new(2);
    $info->add_dispatcher($dispatcher);
    my $data = Debug::Message->new(0);
    $data->add_dispatcher($dispatcher);
    my $warning = Debug::Message->new(4);
    $warning->add_dispatcher($dispatcher);

=head1 WARNINGS

=head1 BUGS

No known.
The new found please report on <ondra@elfove.cz>

=head1 HISTORY

=item 12.8.2006

Some of the ideas evolved: Colors insted of semantics in function
names. Initial release 0.51.

=item 8.8.2006

Continued writing after a long pause. Rewritten much of the code.

=item 14.10.2003.

I began writing with many nice ideals on mind.

=cut