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