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