HTML::Widget::Accessor - Accessor Class

HTML-Widget documentation Contained in the HTML-Widget distribution.

Index

Code Index:

NAME

Top

HTML::Widget::Accessor - Accessor Class

SYNOPSIS

Top

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

DESCRIPTION

Top

Accessor Class.

METHODS

Top

attributes

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 $w-attributes( { } );>. Instead, you may use %{ $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;

attrs is an alias for attributes.

mk_attr_accessors

Arguments: @names

Return Value: @names

AUTHOR

Top

Sebastian Riedel, sri@oook.de

LICENSE

Top

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

HTML-Widget documentation Contained in the HTML-Widget distribution. 
package HTML::Widget::Accessor;

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

*attrs = \&attributes;


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;
}


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);
}


1;