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.75_01';
  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 use Moose::Meta::Class::Immutable::Trait;
  22 use Moose::Meta::Method::Constructor;
  23 use Moose::Meta::Method::Destructor;
  24
  25 use base 'Class::MOP::Class';
  26
  27 __PACKAGE__->meta->add_attribute('roles' => (
  28     reader  => 'roles',
  29     default => sub { [] }
  30 ));
  31
  32
  33 __PACKAGE__->meta->add_attribute(
  34     Class::MOP::Attribute->new('immutable_trait' => (
  35         accessor => "immutable_trait",
  36         default  => 'Moose::Meta::Class::Immutable::Trait',
  37     ))
  38 );
  39
  40 __PACKAGE__->meta->add_attribute('constructor_class' => (
  41     accessor => 'constructor_class',
  42     default  => 'Moose::Meta::Method::Constructor',
  43 ));
  44
  45 __PACKAGE__->meta->add_attribute('destructor_class' => (
  46     accessor => 'destructor_class',
  47     default  => 'Moose::Meta::Method::Destructor',
  48 ));
  49
  50 __PACKAGE__->meta->add_attribute('error_class' => (
  51     accessor => 'error_class',
  52     default  => 'Moose::Error::Default',
  53 ));
  54
  55 sub initialize {
  56     my $class = shift;
  57     my $pkg   = shift;
  58     return Class::MOP::get_metaclass_by_name($pkg)
  59         || $class->SUPER::initialize($pkg,
  60                 'attribute_metaclass' => 'Moose::Meta::Attribute',
  61                 'method_metaclass'    => 'Moose::Meta::Method',
  62                 'instance_metaclass'  => 'Moose::Meta::Instance',
  63                 @_
  64             );
  65 }
  66
  67 sub _immutable_options {
  68     my ( $self, @args ) = @_;
  69
  70     $self->SUPER::_immutable_options(
  71         inline_destructor => 1,
  72
  73         # Moose always does this when an attribute is created
  74         inline_accessors => 0,
  75
  76         @args,
  77     );
  78 }
  79
  80 sub create {
  81     my ($self, $package_name, %options) = @_;
  82
  83     (ref $options{roles} eq 'ARRAY')
  84         || $self->throw_error("You must pass an ARRAY ref of roles", data => $options{roles})
  85             if exists $options{roles};
  86     my $roles = delete $options{roles};
  87
  88     my $class = $self->SUPER::create($package_name, %options);
  89
  90     if ($roles) {
  91         Moose::Util::apply_all_roles( $class, @$roles );
  92     }
  93
  94     return $class;
  95 }
  96
  97 sub _check_metaclass_compatibility {
  98     my $self = shift;
  99
 100     if ( my @supers = $self->superclasses ) {
 101         $self->_fix_metaclass_incompatibility(@supers);
 102     }
 103
 104     $self->SUPER::_check_metaclass_compatibility(@_);
 105 }
 106
 107 my %ANON_CLASSES;
 108
 109 sub create_anon_class {
 110     my ($self, %options) = @_;
 111
 112     my $cache_ok = delete $options{cache};
 113
 114     # something like Super::Class|Super::Class::2=Role|Role::1
 115     my $cache_key = join '=' => (
 116         join('|', @{$options{superclasses} || []}),
 117         join('|', sort @{$options{roles}   || []}),
 118     );
 119
 120     if ($cache_ok && defined $ANON_CLASSES{$cache_key}) {
 121         return $ANON_CLASSES{$cache_key};
 122     }
 123
 124     my $new_class = $self->SUPER::create_anon_class(%options);
 125
 126     $ANON_CLASSES{$cache_key} = $new_class
 127         if $cache_ok;
 128
 129     return $new_class;
 130 }
 131
 132 sub add_role {
 133     my ($self, $role) = @_;
 134     (blessed($role) && $role->isa('Moose::Meta::Role'))
 135         || $self->throw_error("Roles must be instances of Moose::Meta::Role", data => $role);
 136     push @{$self->roles} => $role;
 137 }
 138
 139 sub calculate_all_roles {
 140     my $self = shift;
 141     my %seen;
 142     grep { !$seen{$_->name}++ } map { $_->calculate_all_roles } @{ $self->roles };
 143 }
 144
 145 sub does_role {
 146     my ($self, $role_name) = @_;
 147
 148     (defined $role_name)
 149         || $self->throw_error("You must supply a role name to look for");
 150
 151     foreach my $class ($self->class_precedence_list) {
 152         my $meta = Class::MOP::class_of($class);
 153         # when a Moose metaclass is itself extended with a role,
 154         # this check needs to be done since some items in the
 155         # class_precedence_list might in fact be Class::MOP
 156         # based still.
 157         next unless $meta && $meta->can('roles');
 158         foreach my $role (@{$meta->roles}) {
 159             return 1 if $role->does_role($role_name);
 160         }
 161     }
 162     return 0;
 163 }
 164
 165 sub excludes_role {
 166     my ($self, $role_name) = @_;
 167
 168     (defined $role_name)
 169         || $self->throw_error("You must supply a role name to look for");
 170
 171     foreach my $class ($self->class_precedence_list) {
 172         my $meta = Class::MOP::class_of($class);
 173         # when a Moose metaclass is itself extended with a role,
 174         # this check needs to be done since some items in the
 175         # class_precedence_list might in fact be Class::MOP
 176         # based still.
 177         next unless $meta && $meta->can('roles');
 178         foreach my $role (@{$meta->roles}) {
 179             return 1 if $role->excludes_role($role_name);
 180         }
 181     }
 182     return 0;
 183 }
 184
 185 sub new_object {
 186     my $class  = shift;
 187     my $params = @_ == 1 ? $_[0] : {@_};
 188     my $self   = $class->SUPER::new_object($params);
 189
 190     foreach my $attr ( $class->get_all_attributes() ) {
 191
 192         next unless $attr->can('has_trigger') && $attr->has_trigger;
 193
 194         my $init_arg = $attr->init_arg;
 195
 196         next unless defined $init_arg;
 197
 198         next unless exists $params->{$init_arg};
 199
 200         $attr->trigger->(
 201             $self,
 202             (
 203                   $attr->should_coerce
 204                 ? $attr->get_read_method_ref->($self)
 205                 : $params->{$init_arg}
 206             ),
 207         );
 208     }
 209
 210     return $self;
 211 }
 212
 213 sub _construct_instance {
 214     my $class = shift;
 215     my $params = @_ == 1 ? $_[0] : {@_};
 216     my $meta_instance = $class->get_meta_instance;
 217     # FIXME:
 218     # the code below is almost certainly incorrect
 219     # but this is foreign inheritance, so we might
 220     # have to kludge it in the end.
 221     my $instance = $params->{'__INSTANCE__'} || $meta_instance->create_instance();
 222     foreach my $attr ($class->get_all_attributes()) {
 223         $attr->initialize_instance_slot($meta_instance, $instance, $params);
 224     }
 225     return $instance;
 226 }
 227
 228 sub superclasses {
 229     my $self = shift;
 230     my @supers = @_;
 231     foreach my $super (@supers) {
 232         my $meta = Class::MOP::load_class($super);
 233         Moose->throw_error("You cannot inherit from a Moose Role ($super)")
 234             if $meta && $meta->isa('Moose::Meta::Role')
 235     }
 236     return $self->SUPER::superclasses(@supers);
 237 }
 238
 239 ### ---------------------------------------------
 240
 241 sub add_attribute {
 242     my $self = shift;
 243     $self->SUPER::add_attribute(
 244         (blessed $_[0] && $_[0]->isa('Class::MOP::Attribute')
 245             ? $_[0]
 246             : $self->_process_attribute(@_))
 247     );
 248 }
 249
 250 sub add_override_method_modifier {
 251     my ($self, $name, $method, $_super_package) = @_;
 252
 253     (!$self->has_method($name))
 254         || $self->throw_error("Cannot add an override method if a local method is already present");
 255
 256     $self->add_method($name => Moose::Meta::Method::Overridden->new(
 257         method  => $method,
 258         class   => $self,
 259         package => $_super_package, # need this for roles
 260         name    => $name,
 261     ));
 262 }
 263
 264 sub add_augment_method_modifier {
 265     my ($self, $name, $method) = @_;
 266     (!$self->has_method($name))
 267         || $self->throw_error("Cannot add an augment method if a local method is already present");
 268
 269     $self->add_method($name => Moose::Meta::Method::Augmented->new(
 270         method  => $method,
 271         class   => $self,
 272         name    => $name,
 273     ));
 274 }
 275
 276 ## Private Utility methods ...
 277
 278 sub _find_next_method_by_name_which_is_not_overridden {
 279     my ($self, $name) = @_;
 280     foreach my $method ($self->find_all_methods_by_name($name)) {
 281         return $method->{code}
 282             if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overridden');
 283     }
 284     return undef;
 285 }
 286
 287 sub _fix_metaclass_incompatibility {
 288     my ($self, @superclasses) = @_;
 289
 290     foreach my $super (@superclasses) {
 291         next if $self->_superclass_meta_is_compatible($super);
 292
 293         unless ( $self->is_pristine ) {
 294             $self->throw_error(
 295                       "Cannot attempt to reinitialize metaclass for "
 296                     . $self->name
 297                     . ", it isn't pristine" );
 298         }
 299
 300         $self->_reconcile_with_superclass_meta($super);
 301     }
 302 }
 303
 304 sub _superclass_meta_is_compatible {
 305     my ($self, $super) = @_;
 306
 307     my $super_meta = Class::MOP::Class->initialize($super)
 308         or return 1;
 309
 310     next unless $super_meta->isa("Class::MOP::Class");
 311
 312     my $super_meta_name
 313         = $super_meta->is_immutable
 314         ? $super_meta->get_mutable_metaclass_name
 315         : ref($super_meta);
 316
 317     return 1
 318         if $self->isa($super_meta_name)
 319             and
 320            $self->instance_metaclass->isa( $super_meta->instance_metaclass );
 321 }
 322
 323 # I don't want to have to type this >1 time
 324 my @MetaClassTypes =
 325     qw( attribute_metaclass
 326         method_metaclass
 327         wrapped_method_metaclass
 328         instance_metaclass
 329         constructor_class
 330         destructor_class
 331         error_class );
 332
 333 sub _reconcile_with_superclass_meta {
 334     my ($self, $super) = @_;
 335
 336     my $super_meta = Class::MOP::class_of($super);
 337
 338     my $super_meta_name
 339         = $super_meta->is_immutable
 340         ? $super_meta->get_mutable_metaclass_name
 341         : ref($super_meta);
 342
 343     my $self_metaclass = ref $self;
 344
 345     # If neither of these is true we have a more serious
 346     # incompatibility that we just cannot fix (yet?).
 347     if ( $super_meta_name->isa( ref $self )
 348         && all { $super_meta->$_->isa( $self->$_ ) } @MetaClassTypes ) {
 349         $self->_reinitialize_with($super_meta);
 350     }
 351     elsif ( $self->_all_metaclasses_differ_by_roles_only($super_meta) ) {
 352         $self->_reconcile_role_differences($super_meta);
 353     }
 354 }
 355
 356 sub _reinitialize_with {
 357     my ( $self, $new_meta ) = @_;
 358
 359     my $new_self = $new_meta->reinitialize(
 360         $self->name,
 361         attribute_metaclass => $new_meta->attribute_metaclass,
 362         method_metaclass    => $new_meta->method_metaclass,
 363         instance_metaclass  => $new_meta->instance_metaclass,
 364     );
 365
 366     $new_self->$_( $new_meta->$_ )
 367         for qw( constructor_class destructor_class error_class );
 368
 369     %$self = %$new_self;
 370
 371     bless $self, ref $new_self;
 372
 373     # We need to replace the cached metaclass instance or else when it
 374     # goes out of scope Class::MOP::Class destroy's the namespace for
 375     # the metaclass's class, causing much havoc.
 376     Class::MOP::store_metaclass_by_name( $self->name, $self );
 377     Class::MOP::weaken_metaclass( $self->name ) if $self->is_anon_class;
 378 }
 379
 380 # In the more complex case, we share a common ancestor with our
 381 # superclass's metaclass, but each metaclass (ours and the parent's)
 382 # has a different set of roles applied. We reconcile this by first
 383 # reinitializing into the parent class, and _then_ applying our own
 384 # roles.
 385 sub _all_metaclasses_differ_by_roles_only {
 386     my ($self, $super_meta) = @_;
 387
 388     for my $pair (
 389         [ ref $self, ref $super_meta ],
 390         map { [ $self->$_, $super_meta->$_ ] } @MetaClassTypes
 391         ) {
 392
 393         next if $pair->[0] eq $pair->[1];
 394
 395         my $self_meta_meta  = Class::MOP::Class->initialize( $pair->[0] );
 396         my $super_meta_meta = Class::MOP::Class->initialize( $pair->[1] );
 397
 398         my $common_ancestor
 399             = _find_common_ancestor( $self_meta_meta, $super_meta_meta );
 400
 401         return unless $common_ancestor;
 402
 403         return
 404             unless _is_role_only_subclass_of(
 405             $self_meta_meta,
 406             $common_ancestor,
 407             )
 408             && _is_role_only_subclass_of(
 409             $super_meta_meta,
 410             $common_ancestor,
 411             );
 412     }
 413
 414     return 1;
 415 }
 416
 417 # This, and some other functions, could be called as methods, but
 418 # they're not for two reasons. One, we just end up ignoring the first
 419 # argument, because we can't call these directly on one of the real
 420 # arguments, because one of them could be a Class::MOP::Class object
 421 # and not a Moose::Meta::Class. Second, only a completely insane
 422 # person would attempt to subclass this stuff!
 423 sub _find_common_ancestor {
 424     my ($meta1, $meta2) = @_;
 425
 426     # FIXME? This doesn't account for multiple inheritance (not sure
 427     # if it needs to though). For example, is somewhere in $meta1's
 428     # history it inherits from both ClassA and ClassB, and $meta2
 429     # inherits from ClassB & ClassA, does it matter? And what crazy
 430     # fool would do that anyway?
 431
 432     my %meta1_parents = map { $_ => 1 } $meta1->linearized_isa;
 433
 434     return first { $meta1_parents{$_} } $meta2->linearized_isa;
 435 }
 436
 437 sub _is_role_only_subclass_of {
 438     my ($meta, $ancestor) = @_;
 439
 440     return 1 if $meta->name eq $ancestor;
 441
 442     my @roles = _all_roles_until( $meta, $ancestor );
 443
 444     my %role_packages = map { $_->name => 1 } @roles;
 445
 446     my $ancestor_meta = Class::MOP::Class->initialize($ancestor);
 447
 448     my %shared_ancestors = map { $_ => 1 } $ancestor_meta->linearized_isa;
 449
 450     for my $method ( $meta->get_all_methods() ) {
 451         next if $method->name eq 'meta';
 452         next if $method->can('associated_attribute');
 453
 454         next
 455             if $role_packages{ $method->original_package_name }
 456                 || $shared_ancestors{ $method->original_package_name };
 457
 458         return 0;
 459     }
 460
 461     # FIXME - this really isn't right. Just because an attribute is
 462     # defined in a role doesn't mean it isn't _also_ defined in the
 463     # subclass.
 464     for my $attr ( $meta->get_all_attributes ) {
 465         next if $shared_ancestors{ $attr->associated_class->name };
 466
 467         next if any { $_->has_attribute( $attr->name ) } @roles;
 468
 469         return 0;
 470     }
 471
 472     return 1;
 473 }
 474
 475 sub _all_roles {
 476     my $meta = shift;
 477
 478     return _all_roles_until($meta);
 479 }
 480
 481 sub _all_roles_until {
 482     my ($meta, $stop_at_class) = @_;
 483
 484     return unless $meta->can('calculate_all_roles');
 485
 486     my @roles = $meta->calculate_all_roles;
 487
 488     for my $class ( $meta->linearized_isa ) {
 489         last if $stop_at_class && $stop_at_class eq $class;
 490
 491         my $meta = Class::MOP::Class->initialize($class);
 492         last unless $meta->can('calculate_all_roles');
 493
 494         push @roles, $meta->calculate_all_roles;
 495     }
 496
 497     return uniq @roles;
 498 }
 499
 500 sub _reconcile_role_differences {
 501     my ($self, $super_meta) = @_;
 502
 503     my $self_meta = Class::MOP::class_of($self);
 504
 505     my %roles;
 506
 507     if ( my @roles = map { $_->name } _all_roles($self_meta) ) {
 508         $roles{metaclass_roles} = \@roles;
 509     }
 510
 511     for my $thing (@MetaClassTypes) {
 512         my $name = $self->$thing();
 513
 514         my $thing_meta = Class::MOP::Class->initialize($name);
 515
 516         my @roles = map { $_->name } _all_roles($thing_meta)
 517             or next;
 518
 519         $roles{ $thing . '_roles' } = \@roles;
 520     }
 521
 522     $self->_reinitialize_with($super_meta);
 523
 524     Moose::Util::MetaRole::apply_metaclass_roles(
 525         for_class => $self->name,
 526         %roles,
 527     );
 528
 529     return $self;
 530 }
 531
 532 sub _process_attribute {
 533     my ( $self, $name, @args ) = @_;
 534
 535     @args = %{$args[0]} if scalar @args == 1 && ref($args[0]) eq 'HASH';
 536
 537     if (($name || '') =~ /^\+(.*)/) {
 538         return $self->_process_inherited_attribute($1, @args);
 539     }
 540     else {
 541         return $self->_process_new_attribute($name, @args);
 542     }
 543 }
 544
 545 sub _process_new_attribute {
 546     my ( $self, $name, @args ) = @_;
 547
 548     $self->attribute_metaclass->interpolate_class_and_new($name, @args);
 549 }
 550
 551 sub _process_inherited_attribute {
 552     my ($self, $attr_name, %options) = @_;
 553     my $inherited_attr = $self->find_attribute_by_name($attr_name);
 554     (defined $inherited_attr)
 555         || $self->throw_error("Could not find an attribute by the name of '$attr_name' to inherit from in ${\$self->name}", data => $attr_name);
 556     if ($inherited_attr->isa('Moose::Meta::Attribute')) {
 557         return $inherited_attr->clone_and_inherit_options(%options);
 558     }
 559     else {
 560         # NOTE:
 561         # kind of a kludge to handle Class::MOP::Attributes
 562         return $inherited_attr->Moose::Meta::Attribute::clone_and_inherit_options(%options);
 563     }
 564 }
 565
 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