lib/Moose/Meta/Class.pm

   1
   2 package Moose::Meta::Class;
   3
   4 use strict;
   5 use warnings;
   6
   7 use Class::MOP;
   8
   9 use Carp qw( confess );
  10 use Data::OptList;
  11 use List::Util qw( first );
  12 use List::MoreUtils qw( any all uniq first_index );
  13 use Scalar::Util 'weaken', 'blessed';
  14
  15 our $VERSION   = '1.14';
  16 $VERSION = eval $VERSION;
  17 our $AUTHORITY = 'cpan:STEVAN';
  18
  19 use Moose::Meta::Method::Overridden;
  20 use Moose::Meta::Method::Augmented;
  21 use Moose::Error::Default;
  22 use Moose::Meta::Class::Immutable::Trait;
  23 use Moose::Meta::Method::Constructor;
  24 use Moose::Meta::Method::Destructor;
  25 use Moose::Util;
  26 use Class::MOP::MiniTrait;
  27
  28 use base 'Class::MOP::Class';
  29
  30 Class::MOP::MiniTrait::apply(__PACKAGE__, 'Moose::Meta::Object::Trait');
  31
  32 __PACKAGE__->meta->add_attribute('roles' => (
  33     reader  => 'roles',
  34     default => sub { [] }
  35 ));
  36
  37 __PACKAGE__->meta->add_attribute('role_applications' => (
  38     reader  => '_get_role_applications',
  39     default => sub { [] }
  40 ));
  41
  42 __PACKAGE__->meta->add_attribute(
  43     Class::MOP::Attribute->new('immutable_trait' => (
  44         accessor => "immutable_trait",
  45         default  => 'Moose::Meta::Class::Immutable::Trait',
  46     ))
  47 );
  48
  49 __PACKAGE__->meta->add_attribute('constructor_class' => (
  50     accessor => 'constructor_class',
  51     default  => 'Moose::Meta::Method::Constructor',
  52 ));
  53
  54 __PACKAGE__->meta->add_attribute('destructor_class' => (
  55     accessor => 'destructor_class',
  56     default  => 'Moose::Meta::Method::Destructor',
  57 ));
  58
  59 __PACKAGE__->meta->add_attribute('error_class' => (
  60     accessor => 'error_class',
  61     default  => 'Moose::Error::Default',
  62 ));
  63
  64 sub initialize {
  65     my $class = shift;
  66     my $pkg   = shift;
  67     return Class::MOP::get_metaclass_by_name($pkg)
  68         || $class->SUPER::initialize($pkg,
  69                 'attribute_metaclass' => 'Moose::Meta::Attribute',
  70                 'method_metaclass'    => 'Moose::Meta::Method',
  71                 'instance_metaclass'  => 'Moose::Meta::Instance',
  72                 @_
  73             );
  74 }
  75
  76 sub create {
  77     my ($class, $package_name, %options) = @_;
  78
  79     (ref $options{roles} eq 'ARRAY')
  80         || $class->throw_error("You must pass an ARRAY ref of roles", data => $options{roles})
  81             if exists $options{roles};
  82     my $roles = delete $options{roles};
  83
  84     my $new_meta = $class->SUPER::create($package_name, %options);
  85
  86     if ($roles) {
  87         Moose::Util::apply_all_roles( $new_meta, @$roles );
  88     }
  89
  90     return $new_meta;
  91 }
  92
  93 my %ANON_CLASSES;
  94
  95 sub create_anon_class {
  96     my ($self, %options) = @_;
  97
  98     my $cache_ok = delete $options{cache};
  99
 100     my $cache_key
 101         = _anon_cache_key( $options{superclasses}, $options{roles} );
 102
 103     if ($cache_ok && defined $ANON_CLASSES{$cache_key}) {
 104         return $ANON_CLASSES{$cache_key};
 105     }
 106
 107     my $new_class = $self->SUPER::create_anon_class(%options);
 108
 109     $ANON_CLASSES{$cache_key} = $new_class
 110         if $cache_ok;
 111
 112     return $new_class;
 113 }
 114
 115 sub _anon_cache_key {
 116     # Makes something like Super::Class|Super::Class::2=Role|Role::1
 117     return join '=' => (
 118         join( '|', @{ $_[0]      || [] } ),
 119         join( '|', sort @{ $_[1] || [] } ),
 120     );
 121 }
 122
 123 sub reinitialize {
 124     my $self = shift;
 125     my $pkg  = shift;
 126
 127     my $meta = blessed $pkg ? $pkg : Class::MOP::class_of($pkg);
 128
 129     my $cache_key;
 130
 131     my %existing_classes;
 132     if ($meta) {
 133         %existing_classes = map { $_ => $meta->$_() } qw(
 134             attribute_metaclass
 135             method_metaclass
 136             wrapped_method_metaclass
 137             instance_metaclass
 138             constructor_class
 139             destructor_class
 140             error_class
 141         );
 142
 143         $cache_key = _anon_cache_key(
 144             [ $meta->superclasses ],
 145             [ map { $_->name } @{ $meta->roles } ],
 146         ) if $meta->is_anon_class;
 147     }
 148
 149     my $new_meta = $self->SUPER::reinitialize(
 150         $pkg,
 151         %existing_classes,
 152         @_,
 153     );
 154
 155     return $new_meta unless defined $cache_key;
 156
 157     my $new_cache_key = _anon_cache_key(
 158         [ $meta->superclasses ],
 159         [ map { $_->name } @{ $meta->roles } ],
 160     );
 161
 162     delete $ANON_CLASSES{$cache_key};
 163     $ANON_CLASSES{$new_cache_key} = $new_meta;
 164
 165     return $new_meta;
 166 }
 167
 168 sub add_role {
 169     my ($self, $role) = @_;
 170     (blessed($role) && $role->isa('Moose::Meta::Role'))
 171         || $self->throw_error("Roles must be instances of Moose::Meta::Role", data => $role);
 172     push @{$self->roles} => $role;
 173 }
 174
 175 sub role_applications {
 176     my ($self) = @_;
 177
 178     return @{$self->_get_role_applications};
 179 }
 180
 181 sub add_role_application {
 182     my ($self, $application) = @_;
 183     (blessed($application) && $application->isa('Moose::Meta::Role::Application::ToClass'))
 184         || $self->throw_error("Role applications must be instances of Moose::Meta::Role::Application::ToClass", data => $application);
 185     push @{$self->_get_role_applications} => $application;
 186 }
 187
 188 sub calculate_all_roles {
 189     my $self = shift;
 190     my %seen;
 191     grep { !$seen{$_->name}++ } map { $_->calculate_all_roles } @{ $self->roles };
 192 }
 193
 194 sub calculate_all_roles_with_inheritance {
 195     my $self = shift;
 196     my %seen;
 197     grep { !$seen{$_->name}++ }
 198          map { Class::MOP::class_of($_)->can('calculate_all_roles')
 199                    ? Class::MOP::class_of($_)->calculate_all_roles
 200                    : () }
 201              $self->linearized_isa;
 202 }
 203
 204 sub does_role {
 205     my ($self, $role_name) = @_;
 206
 207     (defined $role_name)
 208         || $self->throw_error("You must supply a role name to look for");
 209
 210     foreach my $class ($self->class_precedence_list) {
 211         my $meta = Class::MOP::class_of($class);
 212         # when a Moose metaclass is itself extended with a role,
 213         # this check needs to be done since some items in the
 214         # class_precedence_list might in fact be Class::MOP
 215         # based still.
 216         next unless $meta && $meta->can('roles');
 217         foreach my $role (@{$meta->roles}) {
 218             return 1 if $role->does_role($role_name);
 219         }
 220     }
 221     return 0;
 222 }
 223
 224 sub excludes_role {
 225     my ($self, $role_name) = @_;
 226
 227     (defined $role_name)
 228         || $self->throw_error("You must supply a role name to look for");
 229
 230     foreach my $class ($self->class_precedence_list) {
 231         my $meta = Class::MOP::class_of($class);
 232         # when a Moose metaclass is itself extended with a role,
 233         # this check needs to be done since some items in the
 234         # class_precedence_list might in fact be Class::MOP
 235         # based still.
 236         next unless $meta && $meta->can('roles');
 237         foreach my $role (@{$meta->roles}) {
 238             return 1 if $role->excludes_role($role_name);
 239         }
 240     }
 241     return 0;
 242 }
 243
 244 sub new_object {
 245     my $self   = shift;
 246     my $params = @_ == 1 ? $_[0] : {@_};
 247     my $object = $self->SUPER::new_object($params);
 248
 249     foreach my $attr ( $self->get_all_attributes() ) {
 250
 251         next unless $attr->can('has_trigger') && $attr->has_trigger;
 252
 253         my $init_arg = $attr->init_arg;
 254
 255         next unless defined $init_arg;
 256
 257         next unless exists $params->{$init_arg};
 258
 259         $attr->trigger->(
 260             $object,
 261             (
 262                   $attr->should_coerce
 263                 ? $attr->get_read_method_ref->($object)
 264                 : $params->{$init_arg}
 265             ),
 266         );
 267     }
 268
 269     $object->BUILDALL($params) if $object->can('BUILDALL');
 270
 271     return $object;
 272 }
 273
 274 sub superclasses {
 275     my $self = shift;
 276     my $supers = Data::OptList::mkopt(\@_);
 277     foreach my $super (@{ $supers }) {
 278         my ($name, $opts) = @{ $super };
 279         Class::MOP::load_class($name, $opts);
 280         my $meta = Class::MOP::class_of($name);
 281         $self->throw_error("You cannot inherit from a Moose Role ($name)")
 282             if $meta && $meta->isa('Moose::Meta::Role')
 283     }
 284     return $self->SUPER::superclasses(map { $_->[0] } @{ $supers });
 285 }
 286
 287 ### ---------------------------------------------
 288
 289 sub add_attribute {
 290     my $self = shift;
 291     my $attr =
 292         (blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
 293             ? $_[0]
 294             : $self->_process_attribute(@_));
 295     $self->SUPER::add_attribute($attr);
 296     # it may be a Class::MOP::Attribute, theoretically, which doesn't have
 297     # 'bare' and doesn't implement this method
 298     if ($attr->can('_check_associated_methods')) {
 299         $attr->_check_associated_methods;
 300     }
 301     return $attr;
 302 }
 303
 304 sub add_override_method_modifier {
 305     my ($self, $name, $method, $_super_package) = @_;
 306
 307     (!$self->has_method($name))
 308         || $self->throw_error("Cannot add an override method if a local method is already present");
 309
 310     $self->add_method($name => Moose::Meta::Method::Overridden->new(
 311         method  => $method,
 312         class   => $self,
 313         package => $_super_package, # need this for roles
 314         name    => $name,
 315     ));
 316 }
 317
 318 sub add_augment_method_modifier {
 319     my ($self, $name, $method) = @_;
 320     (!$self->has_method($name))
 321         || $self->throw_error("Cannot add an augment method if a local method is already present");
 322
 323     $self->add_method($name => Moose::Meta::Method::Augmented->new(
 324         method  => $method,
 325         class   => $self,
 326         name    => $name,
 327     ));
 328 }
 329
 330 ## Private Utility methods ...
 331
 332 sub _find_next_method_by_name_which_is_not_overridden {
 333     my ($self, $name) = @_;
 334     foreach my $method ($self->find_all_methods_by_name($name)) {
 335         return $method->{code}
 336             if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overridden');
 337     }
 338     return undef;
 339 }
 340
 341 ## Metaclass compatibility
 342
 343 sub _base_metaclasses {
 344     my $self = shift;
 345     my %metaclasses = $self->SUPER::_base_metaclasses;
 346     for my $class (keys %metaclasses) {
 347         $metaclasses{$class} =~ s/^Class::MOP/Moose::Meta/;
 348     }
 349     return (
 350         %metaclasses,
 351         error_class => 'Moose::Error::Default',
 352     );
 353 }
 354
 355 sub _can_fix_metaclass_incompatibility {
 356     my $self = shift;
 357     return 1 if $self->_can_fix_metaclass_incompatibility_by_role_reconciliation(@_);
 358     return $self->SUPER::_can_fix_metaclass_incompatibility(@_);
 359 }
 360
 361 sub _can_fix_metaclass_incompatibility_by_role_reconciliation {
 362     my $self = shift;
 363     my ($super_meta) = @_;
 364
 365     return 1 if $self->_can_fix_class_metaclass_incompatibility_by_role_reconciliation($super_meta);
 366
 367     my %base_metaclass = $self->_base_metaclasses;
 368     for my $metaclass_type (keys %base_metaclass) {
 369         next unless defined $self->$metaclass_type;
 370         return 1 if $self->_can_fix_single_metaclass_incompatibility_by_role_reconciliation($metaclass_type, $super_meta);
 371     }
 372
 373     return;
 374 }
 375
 376 sub _can_fix_class_metaclass_incompatibility_by_role_reconciliation {
 377     my $self = shift;
 378     my ($super_meta) = @_;
 379
 380     my $super_meta_name = $super_meta->_real_ref_name;
 381
 382     return Moose::Util::_classes_differ_by_roles_only(
 383         blessed($self),
 384         $super_meta_name,
 385     );
 386 }
 387
 388 sub _can_fix_single_metaclass_incompatibility_by_role_reconciliation {
 389     my $self = shift;
 390     my ($metaclass_type, $super_meta) = @_;
 391
 392     my $class_specific_meta_name = $self->$metaclass_type;
 393     return unless $super_meta->can($metaclass_type);
 394     my $super_specific_meta_name = $super_meta->$metaclass_type;
 395     my %metaclasses = $self->_base_metaclasses;
 396
 397     return Moose::Util::_classes_differ_by_roles_only(
 398         $class_specific_meta_name,
 399         $super_specific_meta_name,
 400     );
 401 }
 402
 403 sub _fix_class_metaclass_incompatibility {
 404     my $self = shift;
 405     my ($super_meta) = @_;
 406
 407     $self->SUPER::_fix_class_metaclass_incompatibility(@_);
 408
 409     if ($self->_can_fix_class_metaclass_incompatibility_by_role_reconciliation($super_meta)) {
 410         ($self->is_pristine)
 411             || confess "Can't fix metaclass incompatibility for "
 412                      . $self->name
 413                      . " because it is not pristine.";
 414         my $super_meta_name = $super_meta->_real_ref_name;
 415         my $class_meta_subclass_meta_name = Moose::Util::_reconcile_roles_for_metaclass(blessed($self), $super_meta_name);
 416         my $new_self = $class_meta_subclass_meta_name->reinitialize(
 417             $self->name,
 418         );
 419
 420         $self->_replace_self( $new_self, $class_meta_subclass_meta_name );
 421     }
 422 }
 423
 424 sub _fix_single_metaclass_incompatibility {
 425     my $self = shift;
 426     my ($metaclass_type, $super_meta) = @_;
 427
 428     $self->SUPER::_fix_single_metaclass_incompatibility(@_);
 429
 430     if ($self->_can_fix_single_metaclass_incompatibility_by_role_reconciliation($metaclass_type, $super_meta)) {
 431         ($self->is_pristine)
 432             || confess "Can't fix metaclass incompatibility for "
 433                      . $self->name
 434                      . " because it is not pristine.";
 435         my $super_meta_name = $super_meta->_real_ref_name;
 436         my $class_specific_meta_subclass_meta_name = Moose::Util::_reconcile_roles_for_metaclass($self->$metaclass_type, $super_meta->$metaclass_type);
 437         my $new_self = $super_meta->reinitialize(
 438             $self->name,
 439             $metaclass_type => $class_specific_meta_subclass_meta_name,
 440         );
 441
 442         $self->_replace_self( $new_self, $super_meta_name );
 443     }
 444 }
 445
 446 sub _replace_self {
 447     my $self      = shift;
 448     my ( $new_self, $new_class)   = @_;
 449
 450     %$self = %$new_self;
 451     bless $self, $new_class;
 452
 453     # We need to replace the cached metaclass instance or else when it goes
 454     # out of scope Class::MOP::Class destroy's the namespace for the
 455     # metaclass's class, causing much havoc.
 456     Class::MOP::store_metaclass_by_name( $self->name, $self );
 457     Class::MOP::weaken_metaclass( $self->name ) if $self->is_anon_class;
 458 }
 459
 460 sub _process_attribute {
 461     my ( $self, $name, @args ) = @_;
 462
 463     @args = %{$args[0]} if scalar @args == 1 && ref($args[0]) eq 'HASH';
 464
 465     if (($name || '') =~ /^\+(.*)/) {
 466         return $self->_process_inherited_attribute($1, @args);
 467     }
 468     else {
 469         return $self->_process_new_attribute($name, @args);
 470     }
 471 }
 472
 473 sub _process_new_attribute {
 474     my ( $self, $name, @args ) = @_;
 475
 476     $self->attribute_metaclass->interpolate_class_and_new($name, @args);
 477 }
 478
 479 sub _process_inherited_attribute {
 480     my ($self, $attr_name, %options) = @_;
 481     my $inherited_attr = $self->find_attribute_by_name($attr_name);
 482     (defined $inherited_attr)
 483         || $self->throw_error("Could not find an attribute by the name of '$attr_name' to inherit from in ${\$self->name}", data => $attr_name);
 484     if ($inherited_attr->isa('Moose::Meta::Attribute')) {
 485         return $inherited_attr->clone_and_inherit_options(%options);
 486     }
 487     else {
 488         # NOTE:
 489         # kind of a kludge to handle Class::MOP::Attributes
 490         return $inherited_attr->Moose::Meta::Attribute::clone_and_inherit_options(%options);
 491     }
 492 }
 493
 494 ## Immutability
 495
 496 sub _immutable_options {
 497     my ( $self, @args ) = @_;
 498
 499     $self->SUPER::_immutable_options(
 500         inline_destructor => 1,
 501
 502         # Moose always does this when an attribute is created
 503         inline_accessors => 0,
 504
 505         @args,
 506     );
 507 }
 508
 509 ## -------------------------------------------------
 510
 511 our $error_level;
 512
 513 sub throw_error {
 514     my ( $self, @args ) = @_;
 515     local $error_level = ($error_level || 0) + 1;
 516     $self->raise_error($self->create_error(@args));
 517 }
 518
 519 sub raise_error {
 520     my ( $self, @args ) = @_;
 521     die @args;
 522 }
 523
 524 sub create_error {
 525     my ( $self, @args ) = @_;
 526
 527     require Carp::Heavy;
 528
 529     local $error_level = ($error_level || 0 ) + 1;
 530
 531     if ( @args % 2 == 1 ) {
 532         unshift @args, "message";
 533     }
 534
 535     my %args = ( metaclass => $self, last_error => $@, @args );
 536
 537     $args{depth} += $error_level;
 538
 539     my $class = ref $self ? $self->error_class : "Moose::Error::Default";
 540
 541     Class::MOP::load_class($class);
 542
 543     $class->new(
 544         Carp::caller_info($args{depth}),
 545         %args
 546     );
 547 }
 548
 549 1;
 550
 551 __END__
 552
 553 =pod
 554
 555 =head1 NAME
 556
 557 Moose::Meta::Class - The Moose metaclass
 558
 559 =head1 DESCRIPTION
 560
 561 This class is a subclass of L<Class::MOP::Class> that provides
 562 additional Moose-specific functionality.
 563
 564 To really understand this class, you will need to start with the
 565 L<Class::MOP::Class> documentation. This class can be understood as a
 566 set of additional features on top of the basic feature provided by
 567 that parent class.
 568
 569 =head1 INHERITANCE
 570
 571 C<Moose::Meta::Class> is a subclass of L<Class::MOP::Class>.
 572
 573 =head1 METHODS
 574
 575 =over 4
 576
 577 =item B<< Moose::Meta::Class->initialize($package_name, %options) >>
 578
 579 This overrides the parent's method in order to provide its own
 580 defaults for the C<attribute_metaclass>, C<instance_metaclass>, and
 581 C<method_metaclass> options.
 582
 583 These all default to the appropriate Moose class.
 584
 585 =item B<< Moose::Meta::Class->create($package_name, %options) >>
 586
 587 This overrides the parent's method in order to accept a C<roles>
 588 option. This should be an array reference containing roles
 589 that the class does, each optionally followed by a hashref of options
 590 (C<-excludes> and C<-alias>).
 591
 592   my $metaclass = Moose::Meta::Class->create( 'New::Class', roles => [...] );
 593
 594 =item B<< Moose::Meta::Class->create_anon_class >>
 595
 596 This overrides the parent's method to accept a C<roles> option, just
 597 as C<create> does.
 598
 599 It also accepts a C<cache> option. If this is true, then the anonymous
 600 class will be cached based on its superclasses and roles. If an
 601 existing anonymous class in the cache has the same superclasses and
 602 roles, it will be reused.
 603
 604   my $metaclass = Moose::Meta::Class->create_anon_class(
 605       superclasses => ['Foo'],
 606       roles        => [qw/Some Roles Go Here/],
 607       cache        => 1,
 608   );
 609
 610 Each entry in both the C<superclasses> and the C<roles> option can be
 611 followed by a hash reference with arguments. The C<superclasses>
 612 option can be supplied with a L<-version|Class::MOP/Class Loading
 613 Options> option that ensures the loaded superclass satisfies the
 614 required version. The C<role> option also takes the C<-version> as an
 615 argument, but the option hash reference can also contain any other
 616 role relevant values like exclusions or parameterized role arguments.
 617
 618 =item B<< $metaclass->make_immutable(%options) >>
 619
 620 This overrides the parent's method to add a few options. Specifically,
 621 it uses the Moose-specific constructor and destructor classes, and
 622 enables inlining the destructor.
 623
 624 Since Moose always inlines attributes, it sets the C<inline_accessors> option
 625 to false.
 626
 627 =item B<< $metaclass->new_object(%params) >>
 628
 629 This overrides the parent's method in order to add support for
 630 attribute triggers.
 631
 632 =item B<< $metaclass->superclasses(@superclasses) >>
 633
 634 This is the accessor allowing you to read or change the parents of
 635 the class.
 636
 637 Each superclass can be followed by a hash reference containing a
 638 L<-version|Class::MOP/Class Loading Options> value. If the version
 639 requirement is not satisfied an error will be thrown.
 640
 641 =item B<< $metaclass->add_override_method_modifier($name, $sub) >>
 642
 643 This adds an C<override> method modifier to the package.
 644
 645 =item B<< $metaclass->add_augment_method_modifier($name, $sub) >>
 646
 647 This adds an C<augment> method modifier to the package.
 648
 649 =item B<< $metaclass->calculate_all_roles >>
 650
 651 This will return a unique array of C<Moose::Meta::Role> instances
 652 which are attached to this class.
 653
 654 =item B<< $metaclass->calculate_all_roles_with_inheritance >>
 655
 656 This will return a unique array of C<Moose::Meta::Role> instances
 657 which are attached to this class, and each of this class's ancestors.
 658
 659 =item B<< $metaclass->add_role($role) >>
 660
 661 This takes a L<Moose::Meta::Role> object, and adds it to the class's
 662 list of roles. This I<does not> actually apply the role to the class.
 663
 664 =item B<< $metaclass->role_applications >>
 665
 666 Returns a list of L<Moose::Meta::Role::Application::ToClass>
 667 objects, which contain the arguments to role application.
 668
 669 =item B<< $metaclass->add_role_application($application) >>
 670
 671 This takes a L<Moose::Meta::Role::Application::ToClass> object, and
 672 adds it to the class's list of role applications. This I<does not>
 673 actually apply any role to the class; it is only for tracking role
 674 applications.
 675
 676 =item B<< $metaclass->does_role($role) >>
 677
 678 This returns a boolean indicating whether or not the class does the specified
 679 role. The role provided can be either a role name or a L<Moose::Meta::Role>
 680 object. This tests both the class and its parents.
 681
 682 =item B<< $metaclass->excludes_role($role_name) >>
 683
 684 A class excludes a role if it has already composed a role which
 685 excludes the named role. This tests both the class and its parents.
 686
 687 =item B<< $metaclass->add_attribute($attr_name, %params|$params) >>
 688
 689 This overrides the parent's method in order to allow the parameters to
 690 be provided as a hash reference.
 691
 692 =item B<< $metaclass->constructor_class($class_name) >>
 693
 694 =item B<< $metaclass->destructor_class($class_name) >>
 695
 696 These are the names of classes used when making a class immutable. These
 697 default to L<Moose::Meta::Method::Constructor> and
 698 L<Moose::Meta::Method::Destructor> respectively. These accessors are
 699 read-write, so you can use them to change the class name.
 700
 701 =item B<< $metaclass->error_class($class_name) >>
 702
 703 The name of the class used to throw errors. This defaults to
 704 L<Moose::Error::Default>, which generates an error with a stacktrace
 705 just like C<Carp::confess>.
 706
 707 =item B<< $metaclass->throw_error($message, %extra) >>
 708
 709 Throws the error created by C<create_error> using C<raise_error>
 710
 711 =back
 712
 713 =head1 BUGS
 714
 715 See L<Moose/BUGS> for details on reporting bugs.
 716
 717 =head1 AUTHOR
 718
 719 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 720
 721 =head1 COPYRIGHT AND LICENSE
 722
 723 Copyright 2006-2010 by Infinity Interactive, Inc.
 724
 725 L<http://www.iinteractive.com>
 726
 727 This library is free software; you can redistribute it and/or modify
 728 it under the same terms as Perl itself.
 729
 730 =cut
 731