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