git.maemo.org Git - pkg-perl/blob - deb-src/libclass-accessor-chained-perl/libclass-accessor-chained-perl-0.01.1~debian/lib/Class/Accessor/Chained.pm

   1 use strict;
   2 package Class::Accessor::Chained;
   3 use base 'Class::Accessor';
   4 our $VERSION = '0.01';
   5
   6 sub make_accessor {
   7     my($class, $field) = @_;
   8
   9     # Build a closure around $field.
  10     return sub {
  11         my($self) = shift;
  12
  13         if (@_) {
  14             $self->set($field, @_);
  15             return $self;
  16         }
  17         else {
  18             return $self->get($field);
  19         }
  20     };
  21 }
  22
  23 sub make_wo_accessor {
  24     my($class, $field) = @_;
  25
  26     return sub {
  27         my($self) = shift;
  28
  29         unless (@_) {
  30             my $caller = caller;
  31             require Carp;
  32             Carp::croak("'$caller' cannot access the value of '$field' on ".
  33                         "objects of class '$class'");
  34         }
  35         else {
  36             $self->set($field, @_);
  37             return $self;
  38         }
  39     };
  40 }
  41
  42 1;
  43 __END__
  44
  45 =head1 NAME
  46
  47 Class::Accessor::Chained - make chained accessors
  48
  49 =head1 SYNOPSIS
  50
  51  package Foo;
  52  use base qw( Class::Accessor::Chained );
  53  __PACKAGE__->mk_accessors(qw( foo bar baz ));
  54
  55  my $foo = Foo->new->foo(1)->bar(2)->baz(4);
  56  print $foo->bar; # prints 2
  57
  58 =head1 DESCRIPTION
  59
  60 A chained accessor is one that always returns the object when called
  61 with parameters (to set), and the value of the field when called with
  62 no arguments.
  63
  64 This module subclasses Class::Accessor in order to provide the same
  65 mk_accessors interface.
  66
  67 =head1 AUTHOR
  68
  69 Richard Clamp <richardc@unixbeard.net>
  70
  71 =head1 COPYRIGHT
  72
  73 Copyright (C) 2003 Richard Clamp.  All Rights Reserved.
  74
  75 This module is free software; you can redistribute it and/or modify it
  76 under the same terms as Perl itself.
  77
  78 =head1 SEE ALSO
  79
  80 L<Class::Accessor>, L<Class::Accessor::Chained::Fast>
  81
  82 =cut