Blame lib/Class/Accessor/Chained.pm

Packit 647083
use strict;
Packit 647083
package Class::Accessor::Chained;
Packit 647083
use base 'Class::Accessor';
Packit 647083
our $VERSION = '0.01';
Packit 647083
Packit 647083
sub make_accessor {
Packit 647083
    my($class, $field) = @_;
Packit 647083
Packit 647083
    # Build a closure around $field.
Packit 647083
    return sub {
Packit 647083
        my($self) = shift;
Packit 647083
Packit 647083
        if (@_) {
Packit 647083
            $self->set($field, @_);
Packit 647083
            return $self;
Packit 647083
        }
Packit 647083
        else {
Packit 647083
            return $self->get($field);
Packit 647083
        }
Packit 647083
    };
Packit 647083
}
Packit 647083
Packit 647083
sub make_wo_accessor {
Packit 647083
    my($class, $field) = @_;
Packit 647083
Packit 647083
    return sub {
Packit 647083
        my($self) = shift;
Packit 647083
Packit 647083
        unless (@_) {
Packit 647083
            my $caller = caller;
Packit 647083
            require Carp;
Packit 647083
            Carp::croak("'$caller' cannot access the value of '$field' on ".
Packit 647083
                        "objects of class '$class'");
Packit 647083
        }
Packit 647083
        else {
Packit 647083
            $self->set($field, @_);
Packit 647083
            return $self;
Packit 647083
        }
Packit 647083
    };
Packit 647083
}
Packit 647083
Packit 647083
1;
Packit 647083
__END__
Packit 647083
Packit 647083
=head1 NAME
Packit 647083
Packit 647083
Class::Accessor::Chained - make chained accessors
Packit 647083
Packit 647083
=head1 SYNOPSIS
Packit 647083
Packit 647083
 package Foo;
Packit 647083
 use base qw( Class::Accessor::Chained );
Packit 647083
 __PACKAGE__->mk_accessors(qw( foo bar baz ));
Packit 647083
Packit 647083
 my $foo = Foo->new->foo(1)->bar(2)->baz(4);
Packit 647083
 print $foo->bar; # prints 2
Packit 647083
Packit 647083
=head1 DESCRIPTION
Packit 647083
Packit 647083
A chained accessor is one that always returns the object when called
Packit 647083
with parameters (to set), and the value of the field when called with
Packit 647083
no arguments.
Packit 647083
Packit 647083
This module subclasses Class::Accessor in order to provide the same
Packit 647083
mk_accessors interface.
Packit 647083
Packit 647083
=head1 AUTHOR
Packit 647083
Packit 647083
Richard Clamp <richardc@unixbeard.net>
Packit 647083
Packit 647083
=head1 COPYRIGHT
Packit 647083
Packit 647083
Copyright (C) 2003 Richard Clamp.  All Rights Reserved.
Packit 647083
Packit 647083
This module is free software; you can redistribute it and/or modify it
Packit 647083
under the same terms as Perl itself.
Packit 647083
Packit 647083
=head1 SEE ALSO
Packit 647083
Packit 647083
L<Class::Accessor>, L<Class::Accessor::Chained::Fast>
Packit 647083
Packit 647083
=cut