File Coverage

blib/lib/HTML/Widget/Accessor.pm

Criterion	Covered	Total	%
statement	38	38	100.0
branch	10	12	83.3
condition	2	6	33.3
subroutine	9	9	100.0
pod	2	2	100.0
total	61	67	91.0

package HTML::Widget::Accessor;

use warnings;
use strict;
use base 'Class::Accessor::Chained::Fast';
use Carp qw/croak/;

*attrs = \&attributes;

=head1 NAME

HTML::Widget::Accessor - Accessor Class

=head1 SYNOPSIS

    use base 'HTML::Widget::Accessor';

=head1 DESCRIPTION

Accessor Class.

=head1 METHODS

=head2 attributes

=head2 attrs

Arguments: %attributes

Arguments: \%attributes

Return Value: $self

Arguments: none

Return Value: \%attributes

Accepts either a list of key/value pairs, or a hash-ref.

    $w->attributes( $key => $value );
    $w->attributes( { $key => $value } );

Returns the object reference, to allow method chaining.

As of v1.10, passing a hash-ref no longer deletes current
attributes, instead the attributes are added to the current attributes
hash.

This means the attributes hash-ref can no longer be emptied using
C<$w->attributes( { } );>. Instead, you may use
C<%{ $w->attributes } = ();>.

As a special case, if no arguments are passed, the return value is a
hash-ref of attributes instead of the object reference. This provides
backwards compatability to support:

    $w->attributes->{key} = $value;

L is an alias for L.

=cut

sub attributes {
    my $self = shift;

    $self->{attributes} = {} if not defined $self->{attributes};

    # special-case to support $w->attrs->{key} = value
    return $self->{attributes} unless @_;

    my %attrs =
        ( scalar(@_) == 1 )
        ? %{ $_[0] }
        : @_;

    $self->{attributes}->{$_} = $attrs{$_} for keys %attrs;

    return $self;
}

=head2 mk_attr_accessors

Arguments: @names

Return Value: @names

=cut

sub mk_attr_accessors {
    my ( $self, @names ) = @_;
    my $class = ref $self || $self;
    for my $name (@names) {
        no strict 'refs';
        *{"$class\::$name"} = sub {
            return ( $_[0]->{attributes}->{$name} || $_[0] ) unless @_ > 1;
            my $self = shift;
            $self->{attributes}->{$name} = ( @_ == 1 ? $_[0] : [@_] );
            return $self;
            }
    }
}

sub _instantiate {
    my ( $self, $class, @args ) = @_;
    my $file = $class . ".pm";
    $file =~ s{::}{/}g;
    eval { require $file };
    croak qq/Couldn't load class "$class", "$@"/ if $@;
    return $class->new(@args);
}

=head1 AUTHOR

Sebastian Riedel, C

=head1 LICENSE

This library is free software, you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut

1;