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