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;