File Coverage

blib/lib/Text/Colorizer.pm

Criterion	Covered	Total	%
statement	64	136	47.0
branch	8	38	21.0
condition	12	30	40.0
subroutine	13	25	52.0
pod	10	10	100.0
total	107	239	44.7

package Text::Colorizer ;

use strict;
use warnings ;
use Carp ;

BEGIN
{

use Sub::Exporter -setup =>
	{
	exports => [ qw() ],
	groups  =>
		{
		all  => [ qw() ],
		}
	};

use vars qw ($VERSION);
$VERSION     = '0.02';
}

#-------------------------------------------------------------------------------

use English qw( -no_match_vars ) ;

use Readonly ;
Readonly my $EMPTY_STRING => q{} ;

use Carp qw(carp croak confess) ;
use Term::ANSIColor qw(colored) ;

#-------------------------------------------------------------------------------

=head1 NAME

Text::Colorizer - Create colored text from text and color descrition. An ANSI to HTML tranformation is provided

=head1 SYNOPSIS

  my $c= Text::Colorizer->new
		(
		NAME => '' ,
		INTERACTION =>
			{
			INFO => sub {print @_},
			WARN => \&Carp::carp,
			DIE => \&Carp::confess,
			}

		FORMAT => 'HTML' | 'ANSI' |'ASCII',

		DEFAULT_COLOR => 'bright_white on_black',
		COLOR_NAMES =>
			{
			HTML =>
				{
				white => "color:#888;",
				black => "color:#000;",
				...
				}
			ANSI => ...
			ASCII => ...
			}
		) ;

  # or

  my $c= Text::Colorizer->new() ;

  my $colored_text = $c->color
			   (
			   'red on_black' => 'string',
			   $color => [... many strings..],
			   'user_defined_color_name' => 'string'
			   ) ;

=head1 DESCRIPTION

This module defined methods to produce colored html from ANSI color description. The generated code use I tags.
The generated HTML can be embeded in your pod documentation.

=head1 DOCUMENTATION

Valid colors:

  black red  green  yellow  blue  magenta  cyan  white

  bright_black  bright_red      bright_green  bright_yellow
  bright_blue   bright_magenta  bright_cyan   bright_white

  on_black  on_red      on_green  on yellow
  on_blue   on_magenta  on_cyan   on_white

  on_bright_black  on_bright_red      on_bright_green  on_bright_yellow
  on_bright_blue   on_bright_magenta  on_bright_cyan   on_bright_white

=begin html



                on_white        on_black        on_green        on_yellow       on_cyan         on_red          on_blue         on_magenta
white           text            text            text            text            text            text            text            text
black           text            text            text            text            text            text            text            text
green           text            text            text            text            text            text            text            text
yellow          text            text            text            text            text            text            text            text
cyan            text            text            text            text            text            text            text            text
red             text            text            text            text            text            text            text            text
blue            text            text            text            text            text            text            text            text
magenta         text            text            text            text            text            text            text            text
bright_white    text            text            text            text            text            text            text            text
bright_black    text            text            text            text            text            text            text            text
bright_green    text            text            text            text            text            text            text            text
bright_yellow   text            text            text            text            text            text            text            text
bright_cyan     text            text            text            text            text            text            text            text
bright_red      text            text            text            text            text            text            text            text
bright_blue     text            text            text            text            text            text            text            text
bright_magenta  text            text            text            text            text            text            text            text


                on_bright_white on_bright_black on_bright_green on_bright_yellowon_bright_cyan  on_bright_red   on_bright_blue  on_bright_magent
white           text            text            text            text            text            text            text            text
black           text            text            text            text            text            text            text            text
green           text            text            text            text            text            text            text            text
yellow          text            text            text            text            text            text            text            text
cyan            text            text            text            text            text            text            text            text
red             text            text            text            text            text            text            text            text
blue            text            text            text            text            text            text            text            text
magenta         text            text            text            text            text            text            text            text
bright_white    text            text            text            text            text            text            text            text
bright_black    text            text            text            text            text            text            text            text
bright_green    text            text            text            text            text            text            text            text
bright_yellow   text            text            text            text            text            text            text            text
bright_cyan     text            text            text            text            text            text            text            text
bright_red      text            text            text            text            text            text            text            text
bright_blue     text            text            text            text            text            text            text            text
bright_magenta  text            text            text            text            text            text            text            text




=end html

=head2 Default background color

B

=head1 SUBROUTINES/METHODS

=cut


#-------------------------------------------------------------------------------

Readonly my $NEW_ARGUMENTS => [qw(NAME INTERACTION VERBOSE JOIN JOIN_FLAT FORMAT DEFAULT_COLOR COLORS)] ;

sub new
{

=head2 new(NAMED_ARGUMENTS)

Create a Text::Colorizer object.

  my $c= Text::Colorizer->new() ;

I - a list of pairs - Option => Value

=over 2

=item * NAME - String - Name of the Data::HexDump::Range object, set to 'Anonymous' by default

=item * INTERACTION - Hash reference - Set of subs that are used to display information to the user

Useful if you use Data::HexDump::Range in an application without terminal.

=item * VERBOSE - Boolean - Display information about the creation of the object. Default is I

=item * JOIN - String - string used to join colored elements. Default is an empty string.

=item * JOIN_FLAT - String - string used to join colored elements passed in array references. Default is an empty string.

=item * FORMAT - String - format of the dump string generated by Data::HexDump::Range.

Default is B which allows for colors. Other formats are 'ASCII' and 'HTML'.

=item * DEFAULT_COLOR -  the color used if no color is defined

	DEFAULT_COLOR => {ANSI => 'bright_white', HTML => 'color:#aaa; '} ;

=item * COLOR - String 'bw' or 'cycle'.

Ranges for which no color has been defined, in 'ANSI' or 'HTML' format mode, will be rendered in
black and white or with a color picked from a cyclic color list. Default is 'bw'.

=item * COLOR_NAMES - A hash reference or a file name

	{
	HTML =>
		{
		white => "color:#888;",
		black => "color:#000;",
		...
		}
	ANSI => ...
	ASCII => ...
	}

=back

I - Text::Colorizer

I - Dies if the color description are not valid

=cut

my ($invocant, @setup_data) = @_ ;

my $class = ref($invocant) || $invocant ;
confess 'Invalid constructor call!' unless defined $class ;

my $object = {} ;

my ($package, $file_name, $line) = caller() ;
bless $object, $class ;

$object->Setup($package, $file_name, $line, @setup_data) ;

return($object) ;
}

#-------------------------------------------------------------------------------

sub Setup
{

=head2 Setup

Helper sub called by new. This is a private sub.

=cut

my ($self, $package, $file_name, $line, @setup_data) = @_ ;

if (@setup_data % 2)
	{
	croak "Invalid number of argument '$file_name, $line'!" ;
	}

my %valid_argument = map {$_ => 1} @{$NEW_ARGUMENTS} ;

$self->{INTERACTION}{INFO} ||= sub {print @_} ;
$self->{INTERACTION}{WARN} ||= \&Carp::carp ;
$self->{INTERACTION}{DIE}  ||= \&Carp::croak ;
$self->{NAME} = 'Anonymous';
$self->{FILE} = $file_name ;
$self->{LINE} = $line ;

$self->CheckOptionNames(\%valid_argument, @setup_data) ;

%{$self} =
	(
	NAME                   => 'Anonymous',
	FILE                   => $file_name,
	LINE                   => $line,

	JOIN => $EMPTY_STRING,
	JOIN_FLAT => $EMPTY_STRING,

	FORMAT => 'ANSI',
	DEFAULT_COLOR => {ANSI => 'bright_white', HTML => 'color:#fff; '},

	COLORS =>
		{
		ANSI =>
			{
			# you can defined aliases too
			# alarm => 'bright_red on_bright_yellwo',
			reset => 'reset',

			white => 'white',
			black => 'black',
			green => 'green',
			yellow => 'yellow',
			cyan => 'cyan',
			red => 'red',
			blue => 'blue',
			magenta => 'magenta',

			bright_white => 'bright_white',
			bright_black => 'bright_black',
			bright_green => 'bright_green',
			bright_yellow => 'bright_yellow',
			bright_cyan => 'bright_cyan',
			bright_red => 'bright_red',
			bright_blue => 'bright_blue',
			bright_magenta => 'bright_magenta',

			on_white => 'on_white',
			on_black => 'on_black',
			on_green => 'on_green',
			on_yellow => 'on_yellow',
			on_cyan => 'on_cyan',
			on_red => 'on_red',
			on_blue => 'on_blue',
			on_magenta => 'on_magenta',

			on_bright_white => 'on_bright_white',
			on_bright_black => 'on_bright_black',
			on_bright_green => 'on_bright_green',
			on_bright_yellow => 'on_bright_yellow',
			on_bright_cyan => 'on_bright_cyan',
			on_bright_red => 'on_bright_red',
			on_bright_blue => 'on_bright_blue',
			on_bright_magenta => 'on_bright_magenta',
			},

		HTML =>
			{
			# any attribute you can put in a span
			reset => $EMPTY_STRING,

			white => 'color:#aaa; ',
			black => 'color:#000; ',
			green => 'color:#0a0; ',
			yellow => 'color:#aa0; ',
			cyan => 'color:#0aa; ',
			red => 'color:#a00; ',
			blue => 'color:#00a; ',
			magenta => 'color:#a0a; ',

			bright_white => 'color:#fff; ',
			bright_black => 'color:#000; ',
			bright_green => 'color:#0f0; ',
			bright_yellow => 'color:#ff0; ',
			bright_cyan => 'color:#0ff; ',
			bright_red => 'color:#f00; ',
			bright_blue => 'color:#00f; ',
			bright_magenta => 'color:#f0f; ',

			on_white => 'background-color:#aaa; ',
			on_black => 'background-color:#000; ',
			on_green => 'background-color:#0a0; ',
			on_yellow => 'background-color:#aa0; ',
			on_cyan => 'background-color:#0aa; ',
			on_red => 'background-color:#a00; ',
			on_blue => 'background-color:#00a; ',
			on_magenta => 'background-color:#a0a; ',

			on_bright_white => 'background-color:#fff; ',
			on_bright_black => 'background-color:#000; ',
			on_bright_green => 'background-color:#0f0; ',
			on_bright_yellow => 'background-color:#ff0; ',
			on_bright_cyan => 'background-color:#0ff; ',
			on_bright_red => 'background-color:#f00; ',
			on_bright_blue => 'background-color:#00f; ',
			on_bright_magenta => 'background-color:#f0f; ',
			},
		},

	@setup_data,
	) ;

my $location = "$self->{FILE}:$self->{LINE}" ;

$self->{INTERACTION}{INFO} ||= sub {print @_} ;
$self->{INTERACTION}{WARN} ||= \&Carp::carp ;
$self->{INTERACTION}{DIE}  ||= \&Carp::confess ;

if($self->{VERBOSE})
	{
	$self->{INTERACTION}{INFO}('Creating ' . ref($self) . " '$self->{NAME}' at $location.\n") ;
	}

if('HASH' ne ref $self->{COLORS})
	{
	my $colors = do $self->{COLORS}
		or  $self->{INTERACTION}{DIE}("Can't load color file '$self->{COLORS}'.\n") ;

	'HASH' eq ref $colors
		or  $self->{INTERACTION}{DIE}("Invalid color file '$self->{COLORS}'.\n") ;

	$self->{COLORS} = $colors ;
	}

return ;
}

#-------------------------------------------------------------------------------

sub CheckOptionNames
{

=head2 CheckOptionNames

Verifies the named options passed to the members of this class. Calls B<{INTERACTION}{DIE}> in case
of error. This shall not be used directly.

=cut

my ($self, $valid_options, @options) = @_ ;

if (@options % 2)
	{
	$self->{INTERACTION}{DIE}->('Invalid number of argument!') ;
	}

if('HASH' eq ref $valid_options)
	{
	# OK
	}
elsif('ARRAY' eq ref $valid_options)
	{
	$valid_options = map{$_ => 1} @{$valid_options} ;
	}
else
	{
	$self->{INTERACTION}{DIE}->("Invalid argument '$valid_options'!") ;
	}

my %options = @options ;

for my $option_name (keys %options)
	{
	unless(exists $valid_options->{$option_name})
		{
		$self->{INTERACTION}{DIE}->("$self->{NAME}: Invalid Option '$option_name' at '$self->{FILE}:$self->{LINE}'!")  ;
		}
	}

if
	(
	   (defined $options{FILE} && ! defined $options{LINE})
	|| (!defined $options{FILE} && defined $options{LINE})
	)
	{
	$self->{INTERACTION}{DIE}->("$self->{NAME}: Incomplete option FILE::LINE!") ;
	}

return(1) ;
}

#-------------------------------------------------------------------------------

sub get_colors
{

=head2 get_colors( )

Returns the  colors defined in the object

 my $colors = $c->get_colors( ) ;

I - None

I -  A hash reference

I - None

=cut

my ($self) = @_ ;

return $self->{COLORS} ;
}

#-------------------------------------------------------------------------------

sub set_colors
{

=head2 set_colors(\%colors)

Copies

  my %colors =
  	(
 	HTML =>
 		{
		white => "style='color:#888;'",
		black => "style='color:#000;'",
		...
		bright_white => "style='color:#fff;'",
		bright_black => "style='color:#000;'",
		bright_green => "style='color:#0f0;'",
		...
		}
	) ;

  $c->set_color(\%colors) ;

I

=over 2

=item * \%colors - A hash reference

=back

I - Nothing

I - dies if the color definitions are invalid

=cut

my ($self, $colors) = @_ ;

$self->{COLORS} = $colors ;

return ;
}

#-------------------------------------------------------------------------------

sub flatten ## no critic (Subroutines::RequireArgUnpacking)
{

=head2 [P] flatten($scalar || \@array)

Transforms array references to a flat list

I -

=over 2

=item * $scalar -

=back

I - a lsit of scalars

=cut

return
	map
		{
		my  $description = $_ ;

		if(ref($description) eq 'ARRAY')
			{
			flatten(@{$description}) ;
			}
		else
			{
			$description
			}
		} @_  ;
}

#-------------------------------------------------------------------------------

sub color
{

=head2 color($color_name, $text, $color_name, \@many_text_strings, ...) ;

Returns colored text. according to the object setting. Default is HTML color coded.

  my $colored_text = $c->color
			   (
			   'red on_black' => 'string',
			   $color => [... many strings..]
			   'user_defined_color_name' => 'string'
			   ) ;

I  - A list of colors and text pairs

=over 2

=item * $color -

=item * $text -

=back

I - A single string

I - Dies if the color is invalid

=cut

my ($self, @colors_and_text) = @_ ;

my ($header, $footer, $colorizer)  = ($EMPTY_STRING, $EMPTY_STRING) ;

my %ascii_to_html =
	(
	q{<} => '<',
	q{>} => '>',
	q{&} => '&',
	q{'} => ''',
	q{"} => '"',
	) ;

for ($self->{FORMAT})
	{
	/ASCII/xsm and do
		{
		$colorizer =
			sub
				{
				#~ my ($text, $color) = @_ ;
				#~ return $text ;

				$_[0] ;
				} ;

		last ;
		} ;

	/ANSI/xsm and do
		{
		$colorizer = sub { my ($text, $color) = @_ ; (defined $color && $color ne $EMPTY_STRING) ? colored($text, $color) : $text ; } ;

		last ;
		} ;

	/HTML/xsm and do
		{
		$header = qq~\n~ ;
		$colorizer =
			sub
			{
			my ($text, $color) = @_ ;

			$text =~ s/(<|>|&|\'|\")/$ascii_to_html{$1}/xsmeg ;

			"" . $text . '' ;
			} ;

		$footer .= "\n\n" ;

		last ;
		} ;

	$self->{INTERACTION}{DIE}("Error: Invalid format '$self->{FORMAT}'.\n");
	}

$self->{INTERACTION}{DIE}("Error: number of elements in argument list'.\n") if @colors_and_text % 2 ;

my @formated ;

while(@colors_and_text)
	{
	my ($color_tag, $text) = (shift @colors_and_text, shift @colors_and_text) ;
	my $colors = $self->{DEFAULT_COLOR}{$self->{FORMAT}} ;

	if(defined $color_tag && $self->{FORMAT} ne 'ASCII')
		{
		for my $color_tag_component (split /\s+/xsm, $color_tag)
			{
			$color_tag_component =~ s/\s+//gxsm ;

			my $color = $self->{COLORS}{$self->{FORMAT}}{$color_tag_component} ;

			$self->{INTERACTION}{DIE}("Error: Invalid color componenent '$self->{FORMAT}::$color_tag_component'.\n") unless defined $color ;

			$colors .= q{ } . $color ;
			}
		}

	push @formated, join $self->{JOIN_FLAT}, map {$colorizer->($_, $colors)} flatten($text) ;
	}

return $header . join($self->{JOIN}, @formated) . $footer ;
}

#-------------------------------------------------------------------------------

sub color_all ## no critic (Subroutines::RequireArgUnpacking)
{

=head2 color_all($color, $string, \@many_text_strings, ...)

Uses a single color to colorize all the strings

  my $colored_text = $c->color_all($color, $string, \@many_text_strings, ...) ;

I

=over 2

=item * $xxx -

=back

I - Nothing

I

=cut

my ($self, $color) = (shift @_, shift @_) ;

return $self->color(map{$color, $_} @_) ;
}

#-------------------------------------------------------------------------------

sub color_with ## no critic (Subroutines::RequireArgUnpacking)
{

=head2 color_with(\%color_definitions, 'color' => 'text', $color => \@many_text_strings, ...) ;

Colors a text, temporarely overridding the colors defined in the object.

  my %colors =
  	{
 	HTML =>
 		{
		white => "style='color:#888;'",
		black => "style='color:#000;'",
		...
		bright_white => "style='color:#fff;'",
		bright_black => "style='color:#000;'",
		bright_green => "style='color:#0f0;'",
		...
		}
	},

  my $colored_text = $c->color
			   (
			   'red on_black' => 'string',
			   'blue on_yellow' => [... many strings..]
			   'user_defined_color_name' => 'string'
			   ) ;

I

=over 2

=item * $ -

=item * $color -

=item * $xxx -

=back

I - Nothing

I -  Dies if  any argument is invalid

=cut

my ($self, $colors) = (shift @_, shift @_) ;

local $self->{COLORS} = $colors ; ## no critic (Variables::ProhibitLocalVars)
return $self->color(@_) ;
}

#-------------------------------------------------------------------------------

sub color_all_with ## no critic (Subroutines::RequireArgUnpacking)
{

=head2 color_all_with($temporary_colors, $color, $text | \@many_text_string, ...) ;

Uses a single color to colorize all the strings, using a temporary color definition

  my $temporary_colors =
  	{
 	HTML =>
 		{
		white => "style='color:#888;'",
		black => "style='color:#000;'",
		...
		bright_white => "style='color:#fff;'",
		bright_black => "style='color:#000;'",
		bright_green => "style='color:#0f0;'",
		...
		}
	},

  my $colored_text = $c->color_all_with($temporary_colors, $color, 'string', [... many strings..], ...) ;

I

=over 2

=item * $xxx -

=back

I - A colorized string

I Dies if invalid input is received

=cut

my ($self, $colors) = (shift @_, shift @_) ;

local $self->{COLORS} = $colors ; ## no critic (Variables::ProhibitLocalVars)
return $self->color_all(@_) ;
}

#-------------------------------------------------------------------------------

1 ;

=head1 BUGS AND LIMITATIONS

None so far.

=head1 AUTHOR

	Nadim ibn hamouda el Khemir
	CPAN ID: NKH
	mailto: [e-mail]

=head1 COPYRIGHT AND LICENSE

Copyright 2010 Nadim Khemir.

This program is free software; you can redistribute it and/or
modify it under the terms of either:

=over 4

=item * the GNU General Public License as published by the Free
Software Foundation; either version 1, or (at your option) any
later version, or

=item * the Artistic License version 2.0.

=back

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Text::Colorizer

You can also look for information at:

=over 4

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * RT: CPAN's request tracker

Please report any bugs or feature requests to  L .

We will be notified, and then you'll automatically be notified of progress on
your bug as we make changes.

=item * Search CPAN

L

=back

=head1 SEE ALSO

L

=cut