/usr/share/perl5/HTML/Widget/Accessor.pm is in libhtml-widget-perl 1.11-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 | 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 compatibility to support:
$w->attributes->{key} = $value;
L</attrs> is an alias for L</attributes>.
=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<sri@oook.de>
=head1 LICENSE
This library is free software, you can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
1;
|