1package Class::Accessor::Fast::Contained; 2 3use strict; 4use warnings FATAL => qw(all); 5 6use base qw(Class::Accessor::Fast); 7 8our $VERSION = '1.01'; 9$VERSION = eval $VERSION; # numify for warning-free dev releases 10 11use Symbol; 12 13# this module does two things differently to the venerable 14# Class::Accessor::Fast, 15# 1) fields are stored at arms-length in a single key of $self 16# 2) new() allows mixin into an existing object 17 18sub new { 19 my ($class, $fields) = @_; 20 21 $fields = {} unless defined $fields; 22 23 my $self = (ref $class ? $class : bless {}, $class); 24 25 my $copy = ("$self" =~ m/=GLOB/ ? *$self : $self); 26 $copy->{ref $self} = {%$fields}; 27 28 return $self; 29} 30 31*{Symbol::qualify_to_ref('setup')} = \&new; 32 33sub make_accessor { 34 my($class, $field) = @_; 35 36 return sub { 37 my $self = shift; 38 my $copy = ("$self" =~ m/=GLOB/ ? *$self : $self); 39 return $copy->{ref $self}->{$field} if scalar @_ == 0; 40 $copy->{ref $self}->{$field} = (@_ == 1 ? $_[0] : [@_]); 41 }; 42} 43 44 45sub make_ro_accessor { 46 my($class, $field) = @_; 47 48 return sub { 49 my $self = shift; 50 my $copy = ("$self" =~ m/=GLOB/ ? *$self : $self); 51 return $copy->{ref $self}->{$field} if scalar @_ == 0; 52 my $caller = caller; 53 $self->_croak("'$caller' cannot alter the value of '$field' on objects of class '$class'"); 54 }; 55} 56 57sub make_wo_accessor { 58 my($class, $field) = @_; 59 60 return sub { 61 my $self = shift; 62 my $copy = ("$self" =~ m/=GLOB/ ? *$self : $self); 63 64 unless (@_) { 65 my $caller = caller; 66 $self->_croak("'$caller' cannot access the value of '$field' on objects of class '$class'"); 67 } 68 else { 69 return $copy->{ref $self}->{$field} = (@_ == 1 ? $_[0] : [@_]); 70 } 71 }; 72} 73 74=head1 NAME 75 76Class::Accessor::Fast::Contained - Fast accessors with data containment 77 78=head1 VERSION 79 80This document refers to version 1.01 of Class::Accessor::Fast::Contained 81 82=head1 SYNOPSIS 83 84 package Foo; 85 use base qw(Class::Accessor::Fast::Contained); 86 87 # The rest is the same as Class::Accessor::Fast 88 89=head1 DESCRIPTION 90 91This module does two things differently to the venerable Class::Accessor::Fast : 92 93=over 4 94 95=item * 96 97Fields are stored at arms-length within a single hash value of $self, rather 98than directly in the $self blessed referent. 99 100=item * 101 102C<new()> allows mixin into an existing object, rather than creating and 103returning a new blessed hashref. To do this, just call something like: 104 105 my $self = Some::Other::Class->new; 106 $self = $self->Class::Accessor::Fast::Contained::new; 107 108Note that the mixin code only supports objects which use a blessed hash 109reference or a blessed typeglob reference. 110 111An alias C<setup()> is available which does the same as C<new()> but might 112make more sense if being used in this way. 113 114=back 115 116=head1 DEPENDENCIES 117 118Other than the standard Perl distribution, you will need the following: 119 120=over 4 121 122=item * 123 124Class::Accessor 125 126=back 127 128=head1 BUGS 129 130If you spot a bug or are experiencing difficulties that are not explained 131within the documentation, please send an email to oliver@cpan.org or submit a 132bug to the RT system (http://rt.cpan.org/). It would help greatly if you are 133able to pinpoint problems or even supply a patch. 134 135=head1 SEE ALSO 136 137L<Class::Accessor> 138 139=head1 AUTHOR 140 141Oliver Gorwits C<< <oliver.gorwits@oucs.ox.ac.uk> >> 142 143=head1 ACKNOWLEDGEMENTS 144 145Thanks to Marty Pauly and Michael G Schwern for L<Class::Accessor> and its 146tests, which I've shamelessly borrowed for this distribution. 147 148=head1 COPYRIGHT & LICENSE 149 150Copyright (c) The University of Oxford 2008. 151 152This library is free software; you can redistribute it and/or modify it under 153the same terms as Perl itself. 154 155=cut 156 1571; 158 159