This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move Object::Accessor from ext/ to cpan/
[perl5.git] / cpan / Object-Accessor / lib / Object / Accessor.pm
1 package Object::Accessor;
2
3 use strict;
4 use Carp            qw[carp croak];
5 use vars            qw[$FATAL $DEBUG $AUTOLOAD $VERSION];
6 use Params::Check   qw[allow];
7 use Data::Dumper;
8
9 ### some objects might have overload enabled, we'll need to
10 ### disable string overloading for callbacks
11 require overload;
12
13 $VERSION    = '0.34';
14 $FATAL      = 0;
15 $DEBUG      = 0;
16
17 use constant VALUE => 0;    # array index in the hash value
18 use constant ALLOW => 1;    # array index in the hash value
19 use constant ALIAS => 2;    # array index in the hash value
20
21 =head1 NAME
22
23 Object::Accessor
24
25 =head1 SYNOPSIS
26
27     ### using the object
28     $obj = Object::Accessor->new;        # create object
29     $obj = Object::Accessor->new(@list); # create object with accessors
30     $obj = Object::Accessor->new(\%h);   # create object with accessors
31                                          # and their allow handlers
32
33     $bool   = $obj->mk_accessors('foo'); # create accessors
34     $bool   = $obj->mk_accessors(        # create accessors with input
35                {foo => ALLOW_HANDLER} ); # validation
36
37     $bool   = $obj->mk_aliases(          # create an alias to an existing
38                 alias_name => 'method'); # method name
39                 
40     $clone  = $obj->mk_clone;            # create a clone of original
41                                          # object without data
42     $bool   = $obj->mk_flush;            # clean out all data
43
44     @list   = $obj->ls_accessors;        # retrieves a list of all
45                                          # accessors for this object
46
47     $bar    = $obj->foo('bar');          # set 'foo' to 'bar'
48     $bar    = $obj->foo();               # retrieve 'bar' again
49
50     $sub    = $obj->can('foo');          # retrieve coderef for
51                                          # 'foo' accessor
52     $bar    = $sub->('bar');             # set 'foo' via coderef
53     $bar    = $sub->();                  # retrieve 'bar' by coderef
54
55     ### using the object as base class
56     package My::Class;
57     use base 'Object::Accessor';
58
59     $obj    = My::Class->new;               # create base object
60     $bool   = $obj->mk_accessors('foo');    # create accessors, etc...
61
62     ### make all attempted access to non-existant accessors fatal
63     ### (defaults to false)
64     $Object::Accessor::FATAL = 1;
65
66     ### enable debugging
67     $Object::Accessor::DEBUG = 1;
68
69     ### advanced usage -- callbacks
70     {   my $obj = Object::Accessor->new('foo');
71         $obj->register_callback( sub { ... } );
72         
73         $obj->foo( 1 ); # these calls invoke the callback you registered
74         $obj->foo()     # which allows you to change the get/set 
75                         # behaviour and what is returned to the caller.
76     }        
77
78     ### advanced usage -- lvalue attributes
79     {   my $obj = Object::Accessor::Lvalue->new('foo');
80         print $obj->foo = 1;            # will print 1
81     }
82
83     ### advanced usage -- scoped attribute values
84     {   my $obj = Object::Accessor->new('foo');
85         
86         $obj->foo( 1 );
87         print $obj->foo;                # will print 1
88
89         ### bind the scope of the value of attribute 'foo'
90         ### to the scope of '$x' -- when $x goes out of 
91         ### scope, 'foo's previous value will be restored
92         {   $obj->foo( 2 => \my $x );
93             print $obj->foo, ' ', $x;   # will print '2 2'
94         }
95         print $obj->foo;                # will print 1
96     }
97
98
99 =head1 DESCRIPTION
100
101 C<Object::Accessor> provides an interface to create per object
102 accessors (as opposed to per C<Class> accessors, as, for example,
103 C<Class::Accessor> provides).
104
105 You can choose to either subclass this module, and thus using its
106 accessors on your own module, or to store an C<Object::Accessor>
107 object inside your own object, and access the accessors from there.
108 See the C<SYNOPSIS> for examples.
109
110 =head1 METHODS
111
112 =head2 $object = Object::Accessor->new( [ARGS] );
113
114 Creates a new (and empty) C<Object::Accessor> object. This method is
115 inheritable.
116
117 Any arguments given to C<new> are passed straight to C<mk_accessors>.
118
119 If you want to be able to assign to your accessors as if they
120 were C<lvalue>s, you should create your object in the 
121 C<Object::Acccessor::Lvalue> namespace instead. See the section
122 on C<LVALUE ACCESSORS> below.
123
124 =cut
125
126 sub new {
127     my $class   = shift;
128     my $obj     = bless {}, $class;
129     
130     $obj->mk_accessors( @_ ) if @_;
131     
132     return $obj;
133 }
134
135 =head2 $bool = $object->mk_accessors( @ACCESSORS | \%ACCESSOR_MAP );
136
137 Creates a list of accessors for this object (and C<NOT> for other ones
138 in the same class!).
139 Will not clobber existing data, so if an accessor already exists,
140 requesting to create again is effectively a C<no-op>.
141
142 When providing a C<hashref> as argument, rather than a normal list,
143 you can specify a list of key/value pairs of accessors and their
144 respective input validators. The validators can be anything that
145 C<Params::Check>'s C<allow> function accepts. Please see its manpage
146 for details.
147
148 For example:
149
150     $object->mk_accessors( {
151         foo     => qr/^\d+$/,       # digits only
152         bar     => [0,1],           # booleans
153         zot     => \&my_sub         # a custom verification sub
154     } );        
155
156 Returns true on success, false on failure.
157
158 Accessors that are called on an object, that do not exist return
159 C<undef> by default, but you can make this a fatal error by setting the
160 global variable C<$FATAL> to true. See the section on C<GLOBAL
161 VARIABLES> for details.
162
163 Note that you can bind the values of attributes to a scope. This allows
164 you to C<temporarily> change a value of an attribute, and have it's 
165 original value restored up on the end of it's bound variable's scope;
166
167 For example, in this snippet of code, the attribute C<foo> will 
168 temporarily be set to C<2>, until the end of the scope of C<$x>, at 
169 which point the original value of C<1> will be restored.
170
171     my $obj = Object::Accessor->new;
172     
173     $obj->mk_accessors('foo');
174     $obj->foo( 1 );
175     print $obj->foo;                # will print 1
176
177     ### bind the scope of the value of attribute 'foo'
178     ### to the scope of '$x' -- when $x goes out of 
179     ### scope, 'foo' previous value will be restored
180     {   $obj->foo( 2 => \my $x );
181         print $obj->foo, ' ', $x;   # will print '2 2'
182     }
183     print $obj->foo;                # will print 1
184     
185
186 Note that all accessors are read/write for everyone. See the C<TODO>
187 section for details.
188
189 =cut
190
191 sub mk_accessors {
192     my $self    = $_[0];
193     my $is_hash = UNIVERSAL::isa( $_[1], 'HASH' );
194     
195     ### first argument is a hashref, which means key/val pairs
196     ### as keys + allow handlers
197     for my $acc ( $is_hash ? keys %{$_[1]} : @_[1..$#_] ) {
198     
199         ### already created apparently
200         if( exists $self->{$acc} ) {
201             __PACKAGE__->___debug( "Accessor '$acc' already exists");
202             next;
203         }
204
205         __PACKAGE__->___debug( "Creating accessor '$acc'");
206
207         ### explicitly vivify it, so that exists works in ls_accessors()
208         $self->{$acc}->[VALUE] = undef;
209         
210         ### set the allow handler only if one was specified
211         $self->{$acc}->[ALLOW] = $_[1]->{$acc} if $is_hash;
212     }
213
214     return 1;
215 }
216
217 =head2 @list = $self->ls_accessors;
218
219 Returns a list of accessors that are supported by the current object.
220 The corresponding coderefs can be retrieved by passing this list one
221 by one to the C<can> method.
222
223 =cut
224
225 sub ls_accessors {
226     ### metainformation is stored in the stringified 
227     ### key of the object, so skip that when listing accessors
228     return sort grep { $_ ne "$_[0]" } keys %{$_[0]};
229 }
230
231 =head2 $ref = $self->ls_allow(KEY)
232
233 Returns the allow handler for the given key, which can be used with
234 C<Params::Check>'s C<allow()> handler. If there was no allow handler
235 specified, an allow handler that always returns true will be returned.
236
237 =cut
238
239 sub ls_allow {
240     my $self = shift;
241     my $key  = shift or return;
242     return exists $self->{$key}->[ALLOW]
243                 ? $self->{$key}->[ALLOW] 
244                 : sub { 1 };
245 }
246
247 =head2 $bool = $self->mk_aliases( alias => method, [alias2 => method2, ...] );
248
249 Creates an alias for a given method name. For all intents and purposes,
250 these two accessors are now identical for this object. This is akin to
251 doing the following on the symbol table level:
252
253   *alias = *method
254
255 This allows you to do the following:
256
257   $self->mk_accessors('foo');
258   $self->mk_aliases( bar => 'foo' );
259   
260   $self->bar( 42 );
261   print $self->foo;     # will print 42
262
263 =cut
264
265 sub mk_aliases {
266     my $self    = shift;
267     my %aliases = @_;
268     
269     while( my($alias, $method) = each %aliases ) {
270
271         ### already created apparently
272         if( exists $self->{$alias} ) {
273             __PACKAGE__->___debug( "Accessor '$alias' already exists");
274             next;
275         }
276
277         $self->___alias( $alias => $method );
278     }
279
280     return 1;
281 }
282
283 =head2 $clone = $self->mk_clone;
284
285 Makes a clone of the current object, which will have the exact same
286 accessors as the current object, but without the data stored in them.
287
288 =cut
289
290 ### XXX this creates an object WITH allow handlers at all times.
291 ### even if the original didnt
292 sub mk_clone {
293     my $self    = $_[0];
294     my $class   = ref $self;
295
296     my $clone   = $class->new;
297     
298     ### split out accessors with and without allow handlers, so we
299     ### don't install dummy allow handers (which makes O::A::lvalue
300     ### warn for example)
301     my %hash; my @list;
302     for my $acc ( $self->ls_accessors ) {
303         my $allow = $self->{$acc}->[ALLOW];
304         $allow ? $hash{$acc} = $allow : push @list, $acc;
305
306         ### is this an alias?
307         if( my $org = $self->{ $acc }->[ ALIAS ] ) {
308             $clone->___alias( $acc => $org );
309         }
310     }
311
312     ### copy the accessors from $self to $clone
313     $clone->mk_accessors( \%hash ) if %hash;
314     $clone->mk_accessors( @list  ) if @list;
315
316     ### copy callbacks
317     #$clone->{"$clone"} = $self->{"$self"} if $self->{"$self"};
318     $clone->___callback( $self->___callback );
319
320     return $clone;
321 }
322
323 =head2 $bool = $self->mk_flush;
324
325 Flushes all the data from the current object; all accessors will be
326 set back to their default state of C<undef>.
327
328 Returns true on success and false on failure.
329
330 =cut
331
332 sub mk_flush {
333     my $self = $_[0];
334
335     # set each accessor's data to undef
336     $self->{$_}->[VALUE] = undef for $self->ls_accessors;
337
338     return 1;
339 }
340
341 =head2 $bool = $self->mk_verify;
342
343 Checks if all values in the current object are in accordance with their
344 own allow handler. Specifically useful to check if an empty initialised
345 object has been filled with values satisfying their own allow criteria.
346
347 =cut
348
349 sub mk_verify {
350     my $self = $_[0];
351     
352     my $fail;
353     for my $name ( $self->ls_accessors ) {
354         unless( allow( $self->$name, $self->ls_allow( $name ) ) ) {
355             my $val = defined $self->$name ? $self->$name : '<undef>';
356
357             __PACKAGE__->___error("'$name' ($val) is invalid");
358             $fail++;
359         }
360     }
361
362     return if $fail;
363     return 1;
364 }   
365
366 =head2 $bool = $self->register_callback( sub { ... } );
367
368 This method allows you to register a callback, that is invoked
369 every time an accessor is called. This allows you to munge input
370 data, access external data stores, etc.
371
372 You are free to return whatever you wish. On a C<set> call, the
373 data is even stored in the object.
374
375 Below is an example of the use of a callback.
376     
377     $object->some_method( "some_value" );
378     
379     my $callback = sub {
380         my $self    = shift; # the object
381         my $meth    = shift; # "some_method"
382         my $val     = shift; # ["some_value"]  
383                              # could be undef -- check 'exists';
384                              # if scalar @$val is empty, it was a 'get'
385     
386         # your code here
387
388         return $new_val;     # the value you want to be set/returned
389     }        
390
391 To access the values stored in the object, circumventing the
392 callback structure, you should use the C<___get> and C<___set> methods
393 documented further down. 
394
395 =cut
396
397 sub register_callback {
398     my $self    = shift;
399     my $sub     = shift or return;
400     
401     ### use the memory address as key, it's not used EVER as an
402     ### accessor --kane
403     $self->___callback( $sub );
404
405     return 1;
406 }
407
408
409 =head2 $bool = $self->can( METHOD_NAME )
410
411 This method overrides C<UNIVERAL::can> in order to provide coderefs to
412 accessors which are loaded on demand. It will behave just like
413 C<UNIVERSAL::can> where it can -- returning a class method if it exists,
414 or a closure pointing to a valid accessor of this particular object.
415
416 You can use it as follows:
417
418     $sub = $object->can('some_accessor');   # retrieve the coderef
419     $sub->('foo');                          # 'some_accessor' now set
420                                             # to 'foo' for $object
421     $foo = $sub->();                        # retrieve the contents
422                                             # of 'some_accessor'
423
424 See the C<SYNOPSIS> for more examples.
425
426 =cut
427
428 ### custom 'can' as UNIVERSAL::can ignores autoload
429 sub can {
430     my($self, $method) = @_;
431
432     ### it's one of our regular methods
433     if( $self->UNIVERSAL::can($method) ) {
434         __PACKAGE__->___debug( "Can '$method' -- provided by package" );
435         return $self->UNIVERSAL::can($method);
436     }
437
438     ### it's an accessor we provide;
439     if( UNIVERSAL::isa( $self, 'HASH' ) and exists $self->{$method} ) {
440         __PACKAGE__->___debug( "Can '$method' -- provided by object" );
441         return sub { $self->$method(@_); }
442     }
443
444     ### we don't support it
445     __PACKAGE__->___debug( "Cannot '$method'" );
446     return;
447 }
448
449 ### don't autoload this
450 sub DESTROY { 1 };
451
452 ### use autoload so we can have per-object accessors,
453 ### not per class, as that is incorrect
454 sub AUTOLOAD {
455     my $self    = shift;
456     my($method) = ($AUTOLOAD =~ /([^:']+$)/);
457
458     my $val = $self->___autoload( $method, @_ ) or return;
459
460     return $val->[0];
461 }
462
463 sub ___autoload {
464     my $self    = shift;
465     my $method  = shift;
466     my $assign  = scalar @_;    # is this an assignment?
467
468     ### a method on our object
469     if( UNIVERSAL::isa( $self, 'HASH' ) ) {
470         if ( not exists $self->{$method} ) {
471             __PACKAGE__->___error("No such accessor '$method'", 1);
472             return;
473         } 
474    
475     ### a method on something else, die with a descriptive error;
476     } else {     
477         local $FATAL = 1;
478         __PACKAGE__->___error( 
479                 "You called '$AUTOLOAD' on '$self' which was interpreted by ".
480                 __PACKAGE__ . " as an object call. Did you mean to include ".
481                 "'$method' from somewhere else?", 1 );
482     }        
483
484     ### is this is an alias, redispatch to the original method
485     if( my $original = $self->{ $method }->[ALIAS] ) {
486         return $self->___autoload( $original, @_ );
487     }        
488
489     ### assign?
490     my $val = $assign ? shift(@_) : $self->___get( $method );
491
492     if( $assign ) {
493
494         ### any binding?
495         if( $_[0] ) {
496             if( ref $_[0] and UNIVERSAL::isa( $_[0], 'SCALAR' ) ) {
497             
498                 ### tie the reference, so we get an object and
499                 ### we can use it's going out of scope to restore
500                 ### the old value
501                 my $cur = $self->{$method}->[VALUE];
502                 
503                 tie ${$_[0]}, __PACKAGE__ . '::TIE', 
504                         sub { $self->$method( $cur ) };
505     
506                 ${$_[0]} = $val;
507             
508             } else {
509                 __PACKAGE__->___error( 
510                     "Can not bind '$method' to anything but a SCALAR", 1 
511                 );
512             }
513         }
514         
515         ### need to check the value?
516         if( exists $self->{$method}->[ALLOW] ) {
517
518             ### double assignment due to 'used only once' warnings
519             local $Params::Check::VERBOSE = 0;
520             local $Params::Check::VERBOSE = 0;
521             
522             allow( $val, $self->{$method}->[ALLOW] ) or (
523                 __PACKAGE__->___error( 
524                     "'$val' is an invalid value for '$method'", 1), 
525                 return 
526             ); 
527         }
528     }
529     
530     ### callbacks?
531     if( my $sub = $self->___callback ) {
532         $val = eval { $sub->( $self, $method, ($assign ? [$val] : []) ) };
533         
534         ### register the error
535         $self->___error( $@, 1 ), return if $@;
536     }
537
538     ### now we can actually assign it
539     if( $assign ) {
540         $self->___set( $method, $val ) or return;
541     }
542     
543     return [$val];
544 }
545
546 =head2 $val = $self->___get( METHOD_NAME );
547
548 Method to directly access the value of the given accessor in the
549 object. It circumvents all calls to allow checks, callbakcs, etc.
550
551 Use only if you C<Know What You Are Doing>! General usage for 
552 this functionality would be in your own custom callbacks.
553
554 =cut
555
556 ### XXX O::A::lvalue is mirroring this behaviour! if this
557 ### changes, lvalue's autoload must be changed as well
558 sub ___get {
559     my $self    = shift;
560     my $method  = shift or return;
561     return $self->{$method}->[VALUE];
562 }
563
564 =head2 $bool = $self->___set( METHOD_NAME => VALUE );
565
566 Method to directly set the value of the given accessor in the
567 object. It circumvents all calls to allow checks, callbakcs, etc.
568
569 Use only if you C<Know What You Are Doing>! General usage for 
570 this functionality would be in your own custom callbacks.
571
572 =cut 
573
574 sub ___set {
575     my $self    = shift;
576     my $method  = shift or return;
577    
578     ### you didn't give us a value to set!
579     exists $_[0] or return;
580     my $val     = shift;
581  
582     ### if there's more arguments than $self, then
583     ### replace the method called by the accessor.
584     ### XXX implement rw vs ro accessors!
585     $self->{$method}->[VALUE] = $val;
586
587     return 1;
588 }
589
590 =head2 $bool = $self->___alias( ALIAS => METHOD );
591
592 Method to directly alias one accessor to another for
593 this object. It circumvents all sanity checks, etc.
594
595 Use only if you C<Know What You Are Doing>! 
596
597 =cut
598
599 sub ___alias {
600     my $self    = shift;
601     my $alias   = shift or return;
602     my $method  = shift or return;
603     
604     $self->{ $alias }->[ALIAS] = $method;
605     
606     return 1;
607 }
608
609 sub ___debug {
610     return unless $DEBUG;
611
612     my $self = shift;
613     my $msg  = shift;
614     my $lvl  = shift || 0;
615
616     local $Carp::CarpLevel += 1;
617     
618     carp($msg);
619 }
620
621 sub ___error {
622     my $self = shift;
623     my $msg  = shift;
624     my $lvl  = shift || 0;
625     local $Carp::CarpLevel += ($lvl + 1);
626     $FATAL ? croak($msg) : carp($msg);
627 }
628
629 ### objects might be overloaded.. if so, we can't trust what "$self"
630 ### will return, which might get *really* painful.. so check for that
631 ### and get their unoverloaded stringval if needed.
632 sub ___callback {
633     my $self = shift;
634     my $sub  = shift;
635     
636     my $mem  = overload::Overloaded( $self )
637                 ? overload::StrVal( $self )
638                 : "$self";
639
640     $self->{$mem} = $sub if $sub;
641     
642     return $self->{$mem};
643 }
644
645 =head1 LVALUE ACCESSORS
646
647 C<Object::Accessor> supports C<lvalue> attributes as well. To enable
648 these, you should create your objects in the designated namespace,
649 C<Object::Accessor::Lvalue>. For example:
650
651     my $obj = Object::Accessor::Lvalue->new('foo');
652     $obj->foo += 1;
653     print $obj->foo;
654     
655 will actually print C<1> and work as expected. Since this is an
656 optional feature, that's not desirable in all cases, we require
657 you to explicitly use the C<Object::Accessor::Lvalue> class.
658
659 Doing the same on the standard C<Object>>Accessor> class would
660 generate the following code & errors:
661
662     my $obj = Object::Accessor->new('foo');
663     $obj->foo += 1;
664
665     Can't modify non-lvalue subroutine call
666
667 Note that C<lvalue> support on C<AUTOLOAD> routines is a
668 C<perl 5.8.x> feature. See perldoc L<perl58delta> for details.
669
670 =head2 CAVEATS
671
672 =over 4
673
674 =item * Allow handlers
675
676 Due to the nature of C<lvalue subs>, we never get access to the
677 value you are assigning, so we can not check it againt your allow
678 handler. Allow handlers are therefor unsupported under C<lvalue>
679 conditions.
680
681 See C<perldoc perlsub> for details.
682
683 =item * Callbacks
684
685 Due to the nature of C<lvalue subs>, we never get access to the
686 value you are assigning, so we can not check provide this value
687 to your callback. Furthermore, we can not distinguish between
688 a C<get> and a C<set> call. Callbacks are therefor unsupported 
689 under C<lvalue> conditions.
690
691 See C<perldoc perlsub> for details.
692
693
694 =cut
695
696 {   package Object::Accessor::Lvalue;
697     use base 'Object::Accessor';
698     use strict;
699     use vars qw[$AUTOLOAD];
700
701     ### constants needed to access values from the objects
702     *VALUE = *Object::Accessor::VALUE;
703     *ALLOW = *Object::Accessor::ALLOW;
704
705     ### largely copied from O::A::Autoload 
706     sub AUTOLOAD : lvalue {
707         my $self    = shift;
708         my($method) = ($AUTOLOAD =~ /([^:']+$)/);
709
710         $self->___autoload( $method, @_ ) or return;
711
712         ### *dont* add return to it, or it won't be stored
713         ### see perldoc perlsub on lvalue subs
714         ### XXX can't use $self->___get( ... ), as we MUST have
715         ### the container that's used for the lvalue assign as
716         ### the last statement... :(
717         $self->{$method}->[ VALUE() ];
718     }
719
720     sub mk_accessors {
721         my $self    = shift;
722         my $is_hash = UNIVERSAL::isa( $_[0], 'HASH' );
723         
724         $self->___error(
725             "Allow handlers are not supported for '". __PACKAGE__ ."' objects"
726         ) if $is_hash;
727         
728         return $self->SUPER::mk_accessors( @_ );
729     }                    
730     
731     sub register_callback {
732         my $self = shift;
733         $self->___error(
734             "Callbacks are not supported for '". __PACKAGE__ ."' objects"
735         );
736         return;
737     }        
738 }    
739
740
741 ### standard tie class for bound attributes
742 {   package Object::Accessor::TIE;
743     use Tie::Scalar;
744     use Data::Dumper;
745     use base 'Tie::StdScalar';
746
747     my %local = ();
748
749     sub TIESCALAR {
750         my $class   = shift;
751         my $sub     = shift;
752         my $ref     = undef;
753         my $obj     =  bless \$ref, $class;
754
755         ### store the restore sub 
756         $local{ $obj } = $sub;
757         return $obj;
758     }
759     
760     sub DESTROY {
761         my $tied    = shift;
762         my $sub     = delete $local{ $tied };
763
764         ### run the restore sub to set the old value back
765         return $sub->();        
766     }              
767 }
768
769 =back
770
771 =head1 GLOBAL VARIABLES
772
773 =head2 $Object::Accessor::FATAL
774
775 Set this variable to true to make all attempted access to non-existant
776 accessors be fatal.
777 This defaults to C<false>.
778
779 =head2 $Object::Accessor::DEBUG
780
781 Set this variable to enable debugging output.
782 This defaults to C<false>.
783
784 =head1 TODO
785
786 =head2 Create read-only accessors
787
788 Currently all accessors are read/write for everyone. Perhaps a future
789 release should make it possible to have read-only accessors as well.
790
791 =head1 CAVEATS
792
793 If you use codereferences for your allow handlers, you will not be able
794 to freeze the data structures using C<Storable>.
795
796 Due to a bug in storable (until at least version 2.15), C<qr//> compiled 
797 regexes also don't de-serialize properly. Although this bug has been 
798 reported, you should be aware of this issue when serializing your objects.
799
800 You can track the bug here: 
801
802     http://rt.cpan.org/Ticket/Display.html?id=1827
803
804 =head1 BUG REPORTS
805
806 Please report bugs or other issues to E<lt>bug-object-accessor@rt.cpan.orgE<gt>.
807
808 =head1 AUTHOR
809
810 This module by Jos Boumans E<lt>kane@cpan.orgE<gt>.
811
812 =head1 COPYRIGHT
813
814 This library is free software; you may redistribute and/or modify it 
815 under the same terms as Perl itself.
816
817 =cut
818
819 1;