File Coverage

blib/lib/HTML/Widget/Plugin/Attrs.pm

Criterion	Covered	Total	%
statement	29	30	96.6
branch	9	14	64.2
condition	4	6	66.6
subroutine	7	7	100.0
pod	3	3	100.0
total	52	60	86.6

use strict;
use warnings;
package HTML::Widget::Plugin::Attrs;
# ABSTRACT: an HTML attribute string
$HTML::Widget::Plugin::Attrs::VERSION = '0.202';
use parent 'HTML::Widget::Plugin';

#pod =head1 DESCRIPTION
#pod
#pod This plugin produces HTML attribute strings.
#pod
#pod =cut

use HTML::Element;

#pod =head1 METHODS
#pod
#pod =head2 C< provided_widgets >
#pod
#pod This plugin provides the following widgets: attrs
#pod
#pod =cut

sub provided_widgets { qw(attrs) }

#pod =head2 C< attrs >
#pod
#pod This method returns HTML attribute strings, so:
#pod
#pod   $factory->attrs({
#pod     size => 10,
#pod     name => q(Michael "Five-Toes" O'Gambini),
#pod   });
#pod
#pod will produce something like:
#pod
#pod   size="10" name="Michael "Five-Toes""
#pod
#pod None of the standard argument rewriting applies.  These are the valid
#pod arguments:
#pod
#pod =over
#pod
#pod =item -tag
#pod
#pod This may be the name of an HTML element.  If given, it will be used to look up
#pod what attributes are boolean.
#pod
#pod =item -bool
#pod
#pod This may be an arrayref of attribute names to treat as boolean arguments.
#pod
#pod =back
#pod
#pod All attributes not beginning with a dash will be treated as attributes for the
#pod attribute string.  Boolean attributes will always have the attribute name as
#pod the value if true, and will be omitted if false.
#pod
#pod If both C<-tag> and C<-bool> are given, they are unioned.
#pod
#pod =cut

# Note that we're totally replacing the standard args rewriting!  This is not
# going to act quite like existing widget plugins! -- rjbs, 2008-05-05
# ALL unless they are boolean args.
sub rewrite_arg { return $_[1] }

sub attrs {
  my ($self, $factor, $arg) = @_;

  my $attr = {};

  my %bool;
  $bool{lc $_} = 1 for @{ $arg->{-bool} || [] };

  require HTML::Tagset;
  if ($arg->{-tag} and my $entry = $HTML::Tagset::boolean_attr{$arg->{-tag}}) {
    $bool{lc $_} = 1 for (ref $entry ? keys %$entry : $entry);
  }

  my $str = '';
  for my $key (sort grep { $_ !~ /^-/ and defined $arg->{$_} } keys %$arg) {
    my $is_bool = $bool{ lc $key };
    next if $is_bool and not $arg->{$key};

    $str .= HTML::Entities::encode_entities($key)
         .  '="'
         . ($is_bool ? HTML::Entities::encode_entities($key)
                     : HTML::Entities::encode_entities($arg->{$key}))
         .  '" ';
  }

  # Remove the trailing space that we're sure to have -- rjbs, 2008-05-05
  substr $str, -1, 1, '' if length $str;

  return $str;
}

1;

__END__