File Coverage

lib/HTML/Accessors.pm

Criterion	Covered	Total	%
statement	103	103	100.0
branch	40	42	95.2
condition	46	51	90.2
subroutine	17	17	100.0
pod	7	7	100.0
total	213	220	96.8

package HTML::Accessors;

use 5.01;
use strict;
use warnings;
use version; our $VERSION = qv( sprintf '0.14.%d', q$Rev: 1 $ =~ /\d+/gmx );

use Carp;
use HTML::GenerateUtil qw( generate_tag :consts );
use HTML::Tagset;
use Scalar::Util       qw( blessed );

my $INP = { checkbox       => 'checkbox',
            hidden         => 'hidden',
            image_button   => 'image',
            password_field => 'password',
            radio_button   => 'radio',
            submit         => 'submit',
            textfield      => 'text' };
my $NUL = q();

# Private functions
my $_hash_merge = sub {
   return { %{ $_[ 0 ] }, %{ $_[ 1 ] || {} } };
};

my $_hashify = sub {
   return $_[ 0 ] ? ref $_[ 0 ] eq 'HASH' ? { %{ $_[ 0 ] } } : { @_ } : {};
};

# Public methods
sub new {
   my ($self, @args) = @_; my $class = blessed $self || $self;

   my $attr = { content_type => 'application/xhtml+xml' };

   return bless $_hash_merge->( $attr, $_hashify->( @args ) ), $class;
}

sub content_type {
   return $_[ 0 ]->{content_type};
}

sub escape_html {
   my ($self, @args) = @_; return HTML::GenerateUtil::escape_html( @args );
}

sub is_xml {
   return $_[ 0 ]->content_type =~ m{ / (.*) xml \z }mx ? 1 : 0;
}

sub popup_menu {
   my ($self, @args) = @_; my $options;

   my $args    = $_hashify->( @args );
   my $classes = delete $args->{classes} || {};
   my $def     = delete $args->{default} || $NUL;
   my $labels  = delete $args->{labels } || {};
   my $values  = delete $args->{values } || [];

   for my $val (grep { defined } @{ $values }) {
      my $opt_attr = $val eq $def ? { selected => $self->is_xml
                                                ? 'selected' : undef } : {};

      exists $classes->{ $val } and $opt_attr->{class} = $classes->{ $val };

      if (exists $labels->{ $val }) {
         $opt_attr->{value} = $val; $val = $labels->{ $val };
      }

      $options .= generate_tag( 'option', $opt_attr, $val, GT_ADDNEWLINE );
   }

   if ($options) { $options = "\n".$options }
   else { $options = generate_tag( 'option', undef, $NUL, GT_ADDNEWLINE ) }

   return generate_tag( 'select', $args, $options, GT_ADDNEWLINE );
}

sub radio_group {
   my ($self, @args) = @_;

   my $args        = $_hashify->( @args );
   my $cols        = $args->{columns    } || '999999';
   my $def         = $args->{default    } || 0;
   my $labels      = $args->{labels     } || {};
   my $label_class = $args->{label_class} || 'radio_group_label';
   my $name        = $args->{name       } || 'radio';
   my $values      = $args->{values     } || [];
   my $inp_attr    = { name => $name, type => 'radio' };
   my $mode        = $self->is_xml ? GT_CLOSETAG : 0;
   my $html        = $NUL;
   my $i           = 1;

   $args->{onchange} and $inp_attr->{onchange} = $args->{onchange};

   for my $val (grep { defined } @{ $values }) {
      $inp_attr->{value   } = $val;
      $inp_attr->{tabindex} = $i;
      $val =~ m{ \d+ }mx and $def =~ m{ \d+ }mx  and $val == $def
         and $inp_attr->{checked } = $self->is_xml ? 'checked' : undef;
     ($val !~ m{ \d+ }mx or  $def !~ m{ \d+ }mx) and $val eq $def
         and $inp_attr->{checked } = $self->is_xml ? 'checked' : undef;
      $html .= generate_tag( 'input', $inp_attr, undef, $mode );
     (exists $labels->{ $val } and not defined $labels->{ $val })
         or  $html .= generate_tag( 'label',
                                    { class => $label_class },
                                    ($labels->{ $val } || $val),
                                    GT_ADDNEWLINE );
      $i % $cols == 0 and $html .= generate_tag( 'br', undef, undef, $mode );
      delete $inp_attr->{checked};
      $i++;
   }

   return $html;
}

sub scrolling_list {
   my ($self, @args) = @_; my $args = $_hashify->( @args );

   $args->{multiple} = 'multiple';
   return $self->popup_menu( $args );
}

sub AUTOLOAD { ## no critic
   my ($self, @args) = @_; my $args = {};

   my $mode = GT_ADDNEWLINE; my $val = $args[ 0 ];

  (my $elem = lc $HTML::Accessors::AUTOLOAD) =~ s{ .* :: }{}mx;

   if ($val and ref $val eq 'HASH') { $args = { %{ $val } }; $val = $args[ 1 ] }

   if (exists $INP->{ $elem }) {
      $args->{type} = $INP->{ $elem };
      defined $args->{default} and $args->{value} = delete $args->{default};
      defined $args->{value  } or  $args->{value} = $NUL;
      $elem = 'input';
   }

   unless ($HTML::Tagset::isKnown{ $elem }) { ## no critic
      carp "Unknown element $elem"; return;
   }

   $val //= delete $args->{default} // $NUL;

   if ($HTML::Tagset::emptyElement{ $elem }) { ## no critic
      $val = undef; $mode = $self->is_xml ? GT_CLOSETAG : 0;
   }

   return generate_tag( $elem, $args, $val, $mode );
}

sub DESTROY {}

1;

__END__