File Coverage

blib/lib/HTML/Auto.pm

Criterion	Covered	Total	%
statement	55	59	93.2
branch	7	10	70.0
condition			n/a
subroutine	9	9	100.0
pod	3	3	100.0
total	74	81	91.3

package HTML::Auto;

use warnings;
use strict;

use Template;
use HTML::Auto::Templates;
use Data::Dumper;

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(matrix h v);

=encoding utf-8

=head1 NAME

HTML::Auto - automatic write HTML for common elements

=head1 VERSION

Version 0.07

=cut

our $VERSION = '0.07';


=head1 SYNOPSIS

Simple example:

  use HTML::Auto qw/matrix h v/;

  my @cols = qw/c1 c2 c3 c4 c5/;
  my @lines = qw/l1 l2 l3 l4 l5/;
  my $data =
     [ [1,2,3,4,5],
       [6,7,8,9,0],
       [1,1,1,1,1],
       [2,2,2,2,2],
       [3,3,3,3,3] ];

  my $m = matrix(\@cols,\@lines,$data);

  print v(
          h($m,$m,$m),
          h($m,$m),
        );

Using attributes:

  use HTML::Auto qw/matrix h v/;

  my @cols = qw/c1 c2/;
  my @lines = qw/l1 l2/;
  my $data =
     [
       [
         {v => 1, a => { style => 'background: green'}},
         2
       ],
       [
         {v => 3, a => {class => 'foo'}},
         {v => 4, a => {style => 'color: red'}}
       ]
     ];

  my $m = matrix(\@cols,\@lines,$data);

  print v(
          h($m)
        );

With mouse-over span:

  use HTML::Auto qw/matrix h v/;

  my @cols = qw/c1 c2/;
  my @lines = qw/l1 l2/;
  my $data =
     [[1,2],
	  [3,
	  { v=> 4,
	    more_info => "This is a pop-up!"
	  }]
	 ];


  my $m = matrix(\@cols,\@lines,$data);

  print v(
          h($m)
        );

Passing additional CSS:

  use HTML::Auto qw/matrix h v/;

  my @cols = qw/c1 c2/;
  my @lines = qw/l1 l2/;
  my $data =
     [
       [
         {v => 1, a => { class => 'warn'}},
         2
       ],
       [3,4]
     ];

  my $options = { css => '.warn { background-color: yellow !important; }' };

  my $m = matrix(\@cols,\@lines,$data,$options);

  print v(
          h($m)
        );



=head1 FUNCTIONS

=head2 matrix

Build a matrix. Some options are available to pass to the matrix function:

=over 6

=item C

Highlight the diagonal of the matrix.

  my $m = matrix(\@cols,\@lines,$data, {diagonal => 1});

=item C

Pass a string to be used by the C filter in the TT2 template.

  my $m = matrix(\@cols,\@lines,$data, {format => '%.6f'});

=item C

Option to uppercase first letter in columns and lines labels.

  my $m = matrix(\@cols,\@lines,$data, {ucfirst => 1});

=back

=cut

sub matrix {
	my ($cols,$lines,$data,$options) = @_;

	if ($options->{ucfirst}) {
		foreach (@$cols) {
			$_ = ucfirst($_);
		}
		foreach (@$lines) {
			$_ = ucfirst($_);
		}
	}

	my $vals = [];
	my $attrs = [];
	my $more = [];

	foreach my $row (@$data){
		my $vrow = [];
		my $arow = [];
		my $mrow = [];
		foreach(@$row){
			if (ref($_)){
				push @$vrow, $_->{v};
				push @$arow, $_->{a};
				push @$mrow, $_->{more_info};
			}
			else {
				push @$vrow, $_;
				push @$arow, undef;
				push @$mrow, undef;
			}
		}
		push @$vals, $vrow;
		push @$attrs, $arow;
		push @$more, $mrow;
	}

	my $vars = {
			cols => $cols,
			lines => $lines,
			vals => $vals,
			attrs => $attrs,
			more => $more,
		};
	$vars->{css} = $options->{css}
		if $options->{css};
	$vars->{myformat} = $options->{format}
		if $options->{format};
	$vars->{diagonal} = $options->{diagonal}
		if $options->{diagonal};

	my $template_name = 'matrix';
	__process($template_name, $vars);
}

=head2 h

A function to allow horizontal composition.

=cut

sub h {
	my (@list) = @_;

	my $vars = {
			list => [@list],
		};
	my $template_name = 'h';

	__process($template_name, $vars);
}

=head2 v

A function to allow vertical composition.

=cut

sub v {
   my (@list) = @_;

   my $vars = {
         list => [@list],
      };
   my $template_name = 'v';

   __process($template_name, $vars);
}

sub __process {
	my ($template_name,$vars) = @_;

	# build html from template
   my $template_config = {
         INCLUDE_PATH => [ 'templates' ],
      };
   my $template = Template->new({
        LOAD_TEMPLATES => [ HTML::Auto::Templates->new($template_config) ],
   });
	my $html;
   $template->process($template_name, $vars, \$html);

	$html;
}

=head1 AUTHOR

Nuno Carvalho, C<<  >>
André Santos, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.




=head1 SUPPORT

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

    perldoc HTML::Auto


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back


=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

Copyright 2012 Project Natura.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.


=cut

1; # End of HTML::Auto