2 package Class::MOP::Class;
8 use Scalar::Util 'blessed', 'reftype';
9 use Sub::Name 'subname';
11 our $VERSION = '0.06';
15 sub meta { Class::MOP::Class->initialize(blessed($_[0]) || $_[0]) }
20 # Metaclasses are singletons, so we cache them here.
21 # there is no need to worry about destruction though
22 # because they should die only when the program dies.
23 # After all, do package definitions even get reaped?
28 my $package_name = shift;
29 (defined $package_name && $package_name && !blessed($package_name))
30 || confess "You must pass a package name and it cannot be blessed";
31 $class->construct_class_instance(':package' => $package_name, @_);
34 # NOTE: (meta-circularity)
35 # this is a special form of &construct_instance
36 # (see below), which is used to construct class
37 # meta-object instances for any Class::MOP::*
38 # class. All other classes will use the more
39 # normal &construct_instance.
40 sub construct_class_instance {
43 my $package_name = $options{':package'};
44 (defined $package_name && $package_name)
45 || confess "You must pass a package name";
46 return $METAS{$package_name} if exists $METAS{$package_name};
47 $class = blessed($class) || $class;
48 # now create the metaclass
50 if ($class =~ /^Class::MOP::/) {
52 '$:package' => $package_name,
54 '$:attribute_metaclass' => $options{':attribute_metaclass'} || 'Class::MOP::Attribute',
55 '$:method_metaclass' => $options{':method_metaclass'} || 'Class::MOP::Method',
60 # it is safe to use meta here because
61 # class will always be a subclass of
62 # Class::MOP::Class, which defines meta
63 $meta = bless $class->meta->construct_instance(%options) => $class
65 # and check the metaclass compatibility
66 $meta->check_metaclass_compatability();
67 $METAS{$package_name} = $meta;
70 sub check_metaclass_compatability {
73 # this is always okay ...
74 return if blessed($self) eq 'Class::MOP::Class';
76 my @class_list = $self->class_precedence_list;
77 shift @class_list; # shift off $self->name
79 foreach my $class_name (@class_list) {
80 my $meta = $METAS{$class_name};
81 ($self->isa(blessed($meta)))
82 || confess $self->name . "->meta => (" . (blessed($self)) . ")" .
83 " is not compatible with the " .
84 $class_name . "->meta => (" . (blessed($meta)) . ")";
90 my ($class, $package_name, $package_version, %options) = @_;
91 (defined $package_name && $package_name)
92 || confess "You must pass a package name";
93 my $code = "package $package_name;";
94 $code .= "\$$package_name\:\:VERSION = '$package_version';"
95 if defined $package_version;
97 confess "creation of $package_name failed : $@" if $@;
98 my $meta = $class->initialize($package_name);
100 $meta->add_method('meta' => sub {
101 Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
104 $meta->superclasses(@{$options{superclasses}})
105 if exists $options{superclasses};
107 # process attributes first, so that they can
108 # install accessors, but locally defined methods
109 # can then overwrite them. It is maybe a little odd, but
110 # I think this should be the order of things.
111 if (exists $options{attributes}) {
112 foreach my $attr (@{$options{attributes}}) {
113 $meta->add_attribute($attr);
116 if (exists $options{methods}) {
117 foreach my $method_name (keys %{$options{methods}}) {
118 $meta->add_method($method_name, $options{methods}->{$method_name});
127 # all these attribute readers will be bootstrapped
128 # away in the Class::MOP bootstrap section
130 sub name { $_[0]->{'$:package'} }
131 sub get_attribute_map { $_[0]->{'%:attributes'} }
132 sub attribute_metaclass { $_[0]->{'$:attribute_metaclass'} }
133 sub method_metaclass { $_[0]->{'$:method_metaclass'} }
135 # Instance Construction & Cloning
140 # we need to protect the integrity of the
141 # Class::MOP::Class singletons here, so we
142 # delegate this to &construct_class_instance
143 # which will deal with the singletons
144 return $class->construct_class_instance(@_)
145 if $class->name->isa('Class::MOP::Class');
146 bless $class->construct_instance(@_) => $class->name;
149 sub construct_instance {
150 my ($class, %params) = @_;
152 foreach my $attr ($class->compute_all_applicable_attributes()) {
153 my $init_arg = $attr->init_arg();
154 # try to fetch the init arg from the %params ...
156 $val = $params{$init_arg} if exists $params{$init_arg};
157 # if nothing was in the %params, we can use the
158 # attribute's default value (if it has one)
159 $val ||= $attr->default($instance) if $attr->has_default();
160 $instance->{$attr->name} = $val;
167 my $instance = shift;
168 (blessed($instance) && $instance->isa($class->name))
169 || confess "You must pass an instance ($instance) of the metaclass (" . $class->name . ")";
171 # we need to protect the integrity of the
172 # Class::MOP::Class singletons here, they
173 # should not be cloned.
174 return $instance if $instance->isa('Class::MOP::Class');
175 bless $class->clone_instance($instance, @_) => blessed($instance);
179 my ($class, $instance, %params) = @_;
181 || confess "You can only clone instances, \$self is not a blessed instance";
182 my $clone = { %$instance, %params };
188 # &name should be here too, but it is above
189 # because it gets bootstrapped away
194 ${$self->name . '::VERSION'};
204 @{$self->name . '::ISA'} = @supers;
206 @{$self->name . '::ISA'};
209 sub class_precedence_list {
212 # We need to check for ciruclar inheirtance here.
213 # This will do nothing if all is well, and blow
214 # up otherwise. Yes, it's an ugly hack, better
215 # suggestions are welcome.
216 { $self->name->isa('This is a test for circular inheritance') }
217 # ... and no back to our regularly scheduled program
221 $self->initialize($_)->class_precedence_list()
222 } $self->superclasses()
229 my ($self, $method_name, $method) = @_;
230 (defined $method_name && $method_name)
231 || confess "You must define a method name";
232 # use reftype here to allow for blessed subs ...
233 ('CODE' eq (reftype($method) || ''))
234 || confess "Your code block must be a CODE reference";
235 my $full_method_name = ($self->name . '::' . $method_name);
237 $method = Class::MOP::Method->new($method) unless blessed($method);
240 no warnings 'redefine';
241 *{$full_method_name} = subname $full_method_name => $method;
244 sub add_method_modifier {
249 my ($self, $method_name, $method) = @_;
250 (defined $method_name && $method_name)
251 || confess "You must define a method name";
252 # use reftype here to allow for blessed subs ...
253 ('CODE' eq (reftype($method) || ''))
254 || confess "Your code block must be a CODE reference";
255 my $full_method_name = ($self->name . '::' . $method_name);
257 $method = Class::MOP::Method->new($method) unless blessed($method);
260 no warnings 'redefine';
261 *{$full_method_name} = $method;
265 my ($self, $method_name) = @_;
266 (defined $method_name && $method_name)
267 || confess "You must define a method name";
269 my $sub_name = ($self->name . '::' . $method_name);
272 return 0 if !defined(&{$sub_name});
274 my $method = \&{$sub_name};
275 $method = Class::MOP::Method->new($method) unless blessed($method);
277 return 0 if $method->package_name ne $self->name &&
278 $method->name ne '__ANON__';
283 my ($self, $method_name) = @_;
284 (defined $method_name && $method_name)
285 || confess "You must define a method name";
287 return unless $self->has_method($method_name);
290 return \&{$self->name . '::' . $method_name};
294 my ($self, $method_name) = @_;
295 (defined $method_name && $method_name)
296 || confess "You must define a method name";
298 my $removed_method = $self->get_method($method_name);
301 delete ${$self->name . '::'}{$method_name}
302 if defined $removed_method;
304 return $removed_method;
307 sub get_method_list {
310 grep { $self->has_method($_) } %{$self->name . '::'};
313 sub compute_all_applicable_methods {
316 # keep a record of what we have seen
317 # here, this will handle all the
318 # inheritence issues because we are
319 # using the &class_precedence_list
320 my (%seen_class, %seen_method);
321 foreach my $class ($self->class_precedence_list()) {
322 next if $seen_class{$class};
323 $seen_class{$class}++;
324 # fetch the meta-class ...
325 my $meta = $self->initialize($class);
326 foreach my $method_name ($meta->get_method_list()) {
327 next if exists $seen_method{$method_name};
328 $seen_method{$method_name}++;
330 name => $method_name,
332 code => $meta->get_method($method_name)
339 sub find_all_methods_by_name {
340 my ($self, $method_name) = @_;
341 (defined $method_name && $method_name)
342 || confess "You must define a method name to find";
344 # keep a record of what we have seen
345 # here, this will handle all the
346 # inheritence issues because we are
347 # using the &class_precedence_list
349 foreach my $class ($self->class_precedence_list()) {
350 next if $seen_class{$class};
351 $seen_class{$class}++;
352 # fetch the meta-class ...
353 my $meta = $self->initialize($class);;
355 name => $method_name,
357 code => $meta->get_method($method_name)
358 } if $meta->has_method($method_name);
367 # either we have an attribute object already
368 # or we need to create one from the args provided
369 my $attribute = blessed($_[0]) ? $_[0] : $self->attribute_metaclass->new(@_);
370 # make sure it is derived from the correct type though
371 ($attribute->isa('Class::MOP::Attribute'))
372 || confess "Your attribute must be an instance of Class::MOP::Attribute (or a subclass)";
373 $attribute->attach_to_class($self);
374 $attribute->install_accessors();
375 $self->get_attribute_map->{$attribute->name} = $attribute;
379 my ($self, $attribute_name) = @_;
380 (defined $attribute_name && $attribute_name)
381 || confess "You must define an attribute name";
382 exists $self->get_attribute_map->{$attribute_name} ? 1 : 0;
386 my ($self, $attribute_name) = @_;
387 (defined $attribute_name && $attribute_name)
388 || confess "You must define an attribute name";
389 return $self->get_attribute_map->{$attribute_name}
390 if $self->has_attribute($attribute_name);
394 sub remove_attribute {
395 my ($self, $attribute_name) = @_;
396 (defined $attribute_name && $attribute_name)
397 || confess "You must define an attribute name";
398 my $removed_attribute = $self->get_attribute_map->{$attribute_name};
399 return unless defined $removed_attribute;
400 delete $self->get_attribute_map->{$attribute_name};
401 $removed_attribute->remove_accessors();
402 $removed_attribute->detach_from_class();
403 return $removed_attribute;
406 sub get_attribute_list {
408 keys %{$self->get_attribute_map};
411 sub compute_all_applicable_attributes {
414 # keep a record of what we have seen
415 # here, this will handle all the
416 # inheritence issues because we are
417 # using the &class_precedence_list
418 my (%seen_class, %seen_attr);
419 foreach my $class ($self->class_precedence_list()) {
420 next if $seen_class{$class};
421 $seen_class{$class}++;
422 # fetch the meta-class ...
423 my $meta = $self->initialize($class);
424 foreach my $attr_name ($meta->get_attribute_list()) {
425 next if exists $seen_attr{$attr_name};
426 $seen_attr{$attr_name}++;
427 push @attrs => $meta->get_attribute($attr_name);
435 sub add_package_variable {
436 my ($self, $variable, $initial_value) = @_;
437 (defined $variable && $variable =~ /^[\$\@\%]/)
438 || confess "variable name does not have a sigil";
440 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
441 if (defined $initial_value) {
443 *{$self->name . '::' . $name} = $initial_value;
446 eval $sigil . $self->name . '::' . $name;
447 confess "Could not create package variable ($variable) because : $@" if $@;
451 sub has_package_variable {
452 my ($self, $variable) = @_;
453 (defined $variable && $variable =~ /^[\$\@\%]/)
454 || confess "variable name does not have a sigil";
455 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
457 defined ${$self->name . '::'}{$name} ? 1 : 0;
460 sub get_package_variable {
461 my ($self, $variable) = @_;
462 (defined $variable && $variable =~ /^[\$\@\%]/)
463 || confess "variable name does not have a sigil";
464 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
466 # try to fetch it first,.. see what happens
467 my $ref = eval '\\' . $sigil . $self->name . '::' . $name;
468 confess "Could not get the package variable ($variable) because : $@" if $@;
469 # if we didn't die, then we can return it
473 sub remove_package_variable {
474 my ($self, $variable) = @_;
475 (defined $variable && $variable =~ /^[\$\@\%]/)
476 || confess "variable name does not have a sigil";
477 my ($sigil, $name) = ($variable =~ /^(.)(.*)$/);
479 delete ${$self->name . '::'}{$name};
490 Class::MOP::Class - Class Meta Object
494 # use this for introspection ...
496 # add a method to Foo ...
497 Foo->meta->add_method('bar' => sub { ... })
499 # get a list of all the classes searched
500 # the method dispatcher in the correct order
501 Foo->meta->class_precedence_list()
503 # remove a method from Foo
504 Foo->meta->remove_method('bar');
506 # or use this to actually create classes ...
508 Class::MOP::Class->create('Bar' => '0.01' => (
509 superclasses => [ 'Foo' ],
511 Class::MOP:::Attribute->new('$bar'),
512 Class::MOP:::Attribute->new('$baz'),
515 calculate_bar => sub { ... },
516 construct_baz => sub { ... }
522 This is the largest and currently most complex part of the Perl 5
523 meta-object protocol. It controls the introspection and
524 manipulation of Perl 5 classes (and it can create them too). The
525 best way to understand what this module can do, is to read the
526 documentation for each of it's methods.
530 =head2 Self Introspection
536 This will return a B<Class::MOP::Class> instance which is related
537 to this class. Thereby allowing B<Class::MOP::Class> to actually
540 As with B<Class::MOP::Attribute>, B<Class::MOP> will actually
541 bootstrap this module by installing a number of attribute meta-objects
542 into it's metaclass. This will allow this class to reap all the benifits
543 of the MOP when subclassing it.
547 =head2 Class construction
549 These methods will handle creating B<Class::MOP::Class> objects,
550 which can be used to both create new classes, and analyze
551 pre-existing classes.
553 This module will internally store references to all the instances
554 you create with these methods, so that they do not need to be
555 created any more than nessecary. Basically, they are singletons.
559 =item B<create ($package_name, ?$package_version,
560 superclasses =E<gt> ?@superclasses,
561 methods =E<gt> ?%methods,
562 attributes =E<gt> ?%attributes)>
564 This returns a B<Class::MOP::Class> object, bringing the specified
565 C<$package_name> into existence and adding any of the
566 C<$package_version>, C<@superclasses>, C<%methods> and C<%attributes>
569 =item B<initialize ($package_name)>
571 This initializes and returns returns a B<Class::MOP::Class> object
572 for a given a C<$package_name>.
574 =item B<construct_class_instance (%options)>
576 This will construct an instance of B<Class::MOP::Class>, it is
577 here so that we can actually "tie the knot" for B<Class::MOP::Class>
578 to use C<construct_instance> once all the bootstrapping is done. This
579 method is used internally by C<initialize> and should never be called
580 from outside of that method really.
582 =item B<check_metaclass_compatability>
584 This method is called as the very last thing in the
585 C<construct_class_instance> method. This will check that the
586 metaclass you are creating is compatible with the metaclasses of all
587 your ancestors. For more inforamtion about metaclass compatibility
588 see the C<About Metaclass compatibility> section in L<Class::MOP>.
592 =head2 Object instance construction and cloning
594 These methods are B<entirely optional>, it is up to you whether you want
599 =item B<new_object (%params)>
601 This is a convience method for creating a new object of the class, and
602 blessing it into the appropriate package as well. Ideally your class
603 would call a C<new> this method like so:
606 my ($class, %param) = @_;
607 $class->meta->new_object(%params);
610 Of course the ideal place for this would actually be in C<UNIVERSAL::>
611 but that is considered bad style, so we do not do that.
613 =item B<construct_instance (%params)>
615 This method is used to construct an instace structure suitable for
616 C<bless>-ing into your package of choice. It works in conjunction
617 with the Attribute protocol to collect all applicable attributes.
619 This will construct and instance using a HASH ref as storage
620 (currently only HASH references are supported). This will collect all
621 the applicable attributes and layout out the fields in the HASH ref,
622 it will then initialize them using either use the corresponding key
623 in C<%params> or any default value or initializer found in the
624 attribute meta-object.
626 =item B<clone_object ($instance, %params)>
628 This is a convience method for cloning an object instance, then
629 blessing it into the appropriate package. This method will call
630 C<clone_instance>, which performs a shallow copy of the object,
631 see that methods documentation for more details. Ideally your
632 class would call a C<clone> this method like so:
635 my ($self, %param) = @_;
636 $self->meta->clone_object($self, %params);
639 Of course the ideal place for this would actually be in C<UNIVERSAL::>
640 but that is considered bad style, so we do not do that.
642 =item B<clone_instance($instance, %params)>
644 This method is a compliment of C<construct_instance> (which means if
645 you override C<construct_instance>, you need to override this one too),
646 and clones the instance shallowly.
648 The cloned structure returned is (like with C<construct_instance>) an
649 unC<bless>ed HASH reference, it is your responsibility to then bless
650 this cloned structure into the right class (which C<clone_object> will
653 As of 0.11, this method will clone the C<$instance> structure shallowly,
654 as opposed to the deep cloning implemented in prior versions. After much
655 thought, research and discussion, I have decided that anything but basic
656 shallow cloning is outside the scope of the meta-object protocol. I
657 think Yuval "nothingmuch" Kogman put it best when he said that cloning
658 is too I<context-specific> to be part of the MOP.
668 This is a read-only attribute which returns the package name for the
669 given B<Class::MOP::Class> instance.
673 This is a read-only attribute which returns the C<$VERSION> of the
674 package for the given B<Class::MOP::Class> instance.
678 =head2 Inheritance Relationships
682 =item B<superclasses (?@superclasses)>
684 This is a read-write attribute which represents the superclass
685 relationships of the class the B<Class::MOP::Class> instance is
686 associated with. Basically, it can get and set the C<@ISA> for you.
689 Perl will occasionally perform some C<@ISA> and method caching, if
690 you decide to change your superclass relationship at runtime (which
691 is quite insane and very much not recommened), then you should be
692 aware of this and the fact that this module does not make any
693 attempt to address this issue.
695 =item B<class_precedence_list>
697 This computes the a list of all the class's ancestors in the same order
698 in which method dispatch will be done. This is similair to
699 what B<Class::ISA::super_path> does, but we don't remove duplicate names.
707 =item B<method_metaclass>
709 =item B<add_method ($method_name, $method)>
711 This will take a C<$method_name> and CODE reference to that
712 C<$method> and install it into the class's package.
715 This does absolutely nothing special to C<$method>
716 other than use B<Sub::Name> to make sure it is tagged with the
717 correct name, and therefore show up correctly in stack traces and
720 =item B<add_method_modifier ($modifier_type, $code)>
722 =item B<alias_method ($method_name, $method)>
724 This will take a C<$method_name> and CODE reference to that
725 C<$method> and alias the method into the class's package.
728 Unlike C<add_method>, this will B<not> try to name the
729 C<$method> using B<Sub::Name>, it only aliases the method in
732 =item B<has_method ($method_name)>
734 This just provides a simple way to check if the class implements
735 a specific C<$method_name>. It will I<not> however, attempt to check
736 if the class inherits the method (use C<UNIVERSAL::can> for that).
738 This will correctly handle functions defined outside of the package
739 that use a fully qualified name (C<sub Package::name { ... }>).
741 This will correctly handle functions renamed with B<Sub::Name> and
742 installed using the symbol tables. However, if you are naming the
743 subroutine outside of the package scope, you must use the fully
744 qualified name, including the package name, for C<has_method> to
745 correctly identify it.
747 This will attempt to correctly ignore functions imported from other
748 packages using B<Exporter>. It breaks down if the function imported
749 is an C<__ANON__> sub (such as with C<use constant>), which very well
750 may be a valid method being applied to the class.
752 In short, this method cannot always be trusted to determine if the
753 C<$method_name> is actually a method. However, it will DWIM about
754 90% of the time, so it's a small trade off I think.
756 =item B<get_method ($method_name)>
758 This will return a CODE reference of the specified C<$method_name>,
759 or return undef if that method does not exist.
761 =item B<remove_method ($method_name)>
763 This will attempt to remove a given C<$method_name> from the class.
764 It will return the CODE reference that it has removed, and will
765 attempt to use B<Sub::Name> to clear the methods associated name.
767 =item B<get_method_list>
769 This will return a list of method names for all I<locally> defined
770 methods. It does B<not> provide a list of all applicable methods,
771 including any inherited ones. If you want a list of all applicable
772 methods, use the C<compute_all_applicable_methods> method.
774 =item B<compute_all_applicable_methods>
776 This will return a list of all the methods names this class will
777 respond to, taking into account inheritance. The list will be a list of
778 HASH references, each one containing the following information; method
779 name, the name of the class in which the method lives and a CODE
780 reference for the actual method.
782 =item B<find_all_methods_by_name ($method_name)>
784 This will traverse the inheritence hierarchy and locate all methods
785 with a given C<$method_name>. Similar to
786 C<compute_all_applicable_methods> it returns a list of HASH references
787 with the following information; method name (which will always be the
788 same as C<$method_name>), the name of the class in which the method
789 lives and a CODE reference for the actual method.
791 The list of methods produced is a distinct list, meaning there are no
792 duplicates in it. This is especially useful for things like object
793 initialization and destruction where you only want the method called
794 once, and in the correct order.
800 It should be noted that since there is no one consistent way to define
801 the attributes of a class in Perl 5. These methods can only work with
802 the information given, and can not easily discover information on
803 their own. See L<Class::MOP::Attribute> for more details.
807 =item B<attribute_metaclass>
809 =item B<get_attribute_map>
811 =item B<add_attribute ($attribute_name, $attribute_meta_object)>
813 This stores a C<$attribute_meta_object> in the B<Class::MOP::Class>
814 instance associated with the given class, and associates it with
815 the C<$attribute_name>. Unlike methods, attributes within the MOP
816 are stored as meta-information only. They will be used later to
817 construct instances from (see C<construct_instance> above).
818 More details about the attribute meta-objects can be found in the
819 L<Class::MOP::Attribute> or the L<Class::MOP/The Attribute protocol>
822 It should be noted that any accessor, reader/writer or predicate
823 methods which the C<$attribute_meta_object> has will be installed
824 into the class at this time.
826 =item B<has_attribute ($attribute_name)>
828 Checks to see if this class has an attribute by the name of
829 C<$attribute_name> and returns a boolean.
831 =item B<get_attribute ($attribute_name)>
833 Returns the attribute meta-object associated with C<$attribute_name>,
834 if none is found, it will return undef.
836 =item B<remove_attribute ($attribute_name)>
838 This will remove the attribute meta-object stored at
839 C<$attribute_name>, then return the removed attribute meta-object.
842 Removing an attribute will only affect future instances of
843 the class, it will not make any attempt to remove the attribute from
844 any existing instances of the class.
846 It should be noted that any accessor, reader/writer or predicate
847 methods which the attribute meta-object stored at C<$attribute_name>
848 has will be removed from the class at this time. This B<will> make
849 these attributes somewhat inaccessable in previously created
850 instances. But if you are crazy enough to do this at runtime, then
851 you are crazy enough to deal with something like this :).
853 =item B<get_attribute_list>
855 This returns a list of attribute names which are defined in the local
856 class. If you want a list of all applicable attributes for a class,
857 use the C<compute_all_applicable_attributes> method.
859 =item B<compute_all_applicable_attributes>
861 This will traverse the inheritance heirachy and return a list of all
862 the applicable attributes for this class. It does not construct a
863 HASH reference like C<compute_all_applicable_methods> because all
864 that same information is discoverable through the attribute
869 =head2 Package Variables
871 Since Perl's classes are built atop the Perl package system, it is
872 fairly common to use package scoped variables for things like static
873 class variables. The following methods are convience methods for
874 the creation and inspection of package scoped variables.
878 =item B<add_package_variable ($variable_name, ?$initial_value)>
880 Given a C<$variable_name>, which must contain a leading sigil, this
881 method will create that variable within the package which houses the
882 class. It also takes an optional C<$initial_value>, which must be a
883 reference of the same type as the sigil of the C<$variable_name>
886 =item B<get_package_variable ($variable_name)>
888 This will return a reference to the package variable in
891 =item B<has_package_variable ($variable_name)>
893 Returns true (C<1>) if there is a package variable defined for
894 C<$variable_name>, and false (C<0>) otherwise.
896 =item B<remove_package_variable ($variable_name)>
898 This will attempt to remove the package variable at C<$variable_name>.
904 Stevan Little E<lt>stevan@iinteractive.comE<gt>
906 =head1 COPYRIGHT AND LICENSE
908 Copyright 2006 by Infinity Interactive, Inc.
910 L<http://www.iinteractive.com>
912 This library is free software; you can redistribute it and/or modify
913 it under the same terms as Perl itself.