File Coverage

blib/lib/HTML/GenerateUtil.pm

Criterion	Covered	Total	%
statement	40	60	66.6
branch	0	16	0.0
condition	3	30	10.0
subroutine	14	18	77.7
pod	1	3	33.3
total	58	127	45.6

package HTML::GenerateUtil;

use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

# This allows declaration	use HTML::GenerateUtil ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = (
  'all' => [ qw(
    escape_html generate_attributes generate_tag escape_uri escape_path set_paranoia
    EH_INPLACE EH_LFTOBR EH_SPTONBSP EH_LEAVEKNOWN
    GT_ESCAPEVAL GT_ADDNEWLINE GT_CLOSETAG
    EU_INPLACE
    $H $E a div span label ul ol li h1 h2 h3 h4
  ) ],
  'consts' => [ qw(
    EH_INPLACE EH_LFTOBR EH_SPTONBSP EH_LEAVEKNOWN
    GT_ESCAPEVAL GT_ADDNEWLINE GT_CLOSETAG
    EU_INPLACE
  ) ]
);

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw();

our $VERSION = '1.20';

our $H = 'HTML::GenerateUtil';
our $E = 'HTML::GenerateUtil::Escape';

# Not comprehensive, just for nicer output html with newlines on end
my %BlockishTags = map { $_ => 1 } qw(h1 h2 h3 h4 h5 h6 li ol ul div p blockquote dd dl form hr pre table tr td th tbody tfoot thead);

require XSLoader;
XSLoader::load('HTML::GenerateUtil', $VERSION);

use constant EH_INPLACE => 1;
use constant EH_LFTOBR => 2;
use constant EH_SPTONBSP => 4;
use constant EH_LEAVEKNOWN => 8;

use constant GT_ESCAPEVAL => 1;
use constant GT_ADDNEWLINE => 2;
use constant GT_CLOSETAG => 4;

use constant EU_INPLACE => 1;

# Preloaded methods go here.

my $escape_all = '"#$%&+,/:;<=>?@[]^`{}|\\' . "\x7f";
my $escape_lite = '"$+,/:;<=>@[]^`{}|\\' . "\x7f";
my $escape_path = q{'"` <>;};

sub escape_uri { return escape_uri_internal($_[0], $_[2] || $escape_all, $_[1] || 0) }
sub escape_uri_lite { return escape_uri_internal($_[0], $_[2] || $escape_lite, $_[1] || 0) }
sub escape_path { return escape_uri_internal($_[0], $_[2] || $escape_path, $_[1] || 0) }

# If an unknown function is called, fill in some parameters and
# call generate_tag
# e.g.
#                 font( $html )
#      maps to    generate_tag('font',undef,$html, 0 )
#                 font( { size => 1 }, $html )
#      maps to    generate_tag('font',{ size => 1},$html, 0 )
#                 font( $html, GT_ADDNEWLINE )
#      maps to    generate_tag('font',{ size => 1},$html, GT_ADDNEWLINE )
sub AUTOLOAD {

  # assume the function name is the tag name
  my $Tag = our $AUTOLOAD;
  $Tag =~ s{.*::}{};

  # if the function was called on the class name, strip out the class name
  if ($_[0] eq $H) { shift; }

  # if the first parameter was not a ref, assume no attributes passed,
  # so we use an empty attr list
  unshift @_, undef unless ($_[0] && ref($_[0]));

  # Use the tag as the first parameter
  unshift @_, lc $Tag;

  # Set default flags
  $_[3] ||= 0;

  goto &generate_tag;
}

1;

package HTML::GenerateUtil::Escape;

use strict;
use warnings;

use constant GT_ADDNEWLINE => HTML::GenerateUtil::GT_ADDNEWLINE;
*escape_html = \&HTML::GenerateUtil::escape_html;
*generate_tag = \&HTML::GenerateUtil::generate_tag;

sub AUTOLOAD {

  # assume the function name is the tag name
  (my $Tag = our $AUTOLOAD) =~ s{.*::}{};
  my $lcTag = lc $Tag;

  # Assume always called as $E->
  shift;

  # If the first parameter was not a hash ref, assume no
  # attributes passed, so we use an empty attr list
  my $Attr = $_[0] && ref $_[0] eq 'HASH' ? shift : undef;
  my $EHFlags = $Attr && delete $Attr->{_ehflags} || 0;
  my $GTFlags = $Attr && delete $Attr->{_gtflags} || 0;

  return join "", map {
    generate_tag($lcTag, $Attr, $_, $GTFlags | ($BlockishTags{$lcTag} && defined $_ ? GT_ADDNEWLINE : 0));
  } map {
    ref $_ eq 'ARRAY' ?
      join "", map { ref $_ eq 'SCALAR' ? $$_ : escape_html($_, $EHFlags) } @$_ :
      ref $_ eq 'SCALAR' ? $$_ : escape_html($_, $EHFlags)
  } (@_ ? @_ : \undef);
}

1;


__END__