lib/MooseX/Storage/Traits/DisableCycleDetection.pm

   1 package MooseX::Storage::Traits::DisableCycleDetection;
   2 use Moose::Role;
   3
   4 our $VERSION   = '0.18';
   5 our $AUTHORITY = 'cpan:STEVAN';
   6
   7 requires 'pack';
   8 requires 'unpack';
   9
  10 around 'pack' => sub {
  11     my ($orig, $self, %args) = @_;
  12     $args{engine_traits} ||= [];
  13     push(@{$args{engine_traits}}, 'DisableCycleDetection');
  14     $self->$orig(%args);
  15 };
  16
  17 around 'unpack' => sub {
  18     my ($orig, $self, $data, %args) = @_;
  19     $args{engine_traits} ||= [];
  20     push(@{$args{engine_traits}}, 'DisableCycleDetection');
  21     $self->$orig($data, %args);
  22 };
  23
  24 1;
  25
  26 __END__
  27
  28 =pod
  29
  30 =head1 NAME
  31
  32 MooseX::Storage::Traits::DisableCycleDetection - A custom trait to bypass cycle detection
  33
  34 =head1 SYNOPSIS
  35
  36
  37     package Double;
  38     use Moose;
  39     use MooseX::Storage;
  40     with Storage( traits => ['DisableCycleDetection'] );
  41
  42     has 'x' => ( is => 'rw', isa => 'HashRef' );
  43     has 'y' => ( is => 'rw', isa => 'HashRef' );
  44
  45     my $ref = {};
  46
  47     my $double = Double->new( 'x' => $ref, 'y' => $ref );
  48
  49     $double->pack;
  50
  51
  52 =head1 DESCRIPTION
  53
  54 C<MooseX::Storage> implements a primitive check for circular references.
  55 This check also triggers on simple cases as shown in the Synopsis.
  56 Providing the C<DisableCycleDetection> traits disables checks for any cyclical
  57 references, so if you know what you are doing, you can bypass this check.
  58
  59 This trait is applied to all objects that inherit from it. To use this
  60 on a per-case basis, see C<disable_cycle_check> in L<MooseX::Storage::Basic>.
  61
  62 See the SYNOPSIS for a nice example that can be easily cargo-culted.
  63
  64 =head1 METHODS
  65
  66 =head2 Introspection
  67
  68 =over 4
  69
  70 =item B<meta>
  71
  72 =back
  73
  74 =head1 BUGS
  75
  76 All complex software has bugs lurking in it, and this module is no
  77 exception. If you find a bug please either email me, or add the bug
  78 to cpan-RT.
  79
  80 =head1 AUTHOR
  81
  82 Stevan Little E<lt>stevan.little@iinteractive.comE<gt>
  83
  84 =head1 COPYRIGHT AND LICENSE
  85
  86 Copyright 2007-2008 by Infinity Interactive, Inc.
  87
  88 L<http://www.iinteractive.com>
  89
  90 This library is free software; you can redistribute it and/or modify
  91 it under the same terms as Perl itself.
  92
  93 =cut