42c7dacc32a3e75080f72873686a8c071e7b35ac
[gitmo/Moose.git] / lib / Moose / Exporter.pm
1 package Moose::Exporter;
2
3 use strict;
4 use warnings;
5
6 our $VERSION   = '0.89_01';
7 $VERSION = eval $VERSION;
8 our $AUTHORITY = 'cpan:STEVAN';
9
10 use Class::MOP;
11 use List::MoreUtils qw( first_index uniq );
12 use Moose::Util::MetaRole;
13 use Sub::Exporter 0.980;
14 use Sub::Name qw(subname);
15
16 my %EXPORT_SPEC;
17
18 sub setup_import_methods {
19     my ( $class, %args ) = @_;
20
21     my $exporting_package = $args{exporting_package} ||= caller();
22
23     $class->build_import_methods(
24         %args,
25         install => [qw(import unimport init_meta)]
26     );
27 }
28
29 sub build_import_methods {
30     my ( $class, %args ) = @_;
31
32     my $exporting_package = $args{exporting_package} ||= caller();
33
34     $EXPORT_SPEC{$exporting_package} = \%args;
35
36     my @exports_from = $class->_follow_also( $exporting_package );
37
38     my $export_recorder = {};
39
40     my ( $exports, $is_removable, $groups )
41         = $class->_make_sub_exporter_params(
42         [ @exports_from, $exporting_package ], $export_recorder );
43
44     my $exporter = Sub::Exporter::build_exporter(
45         {
46             exports => $exports,
47             groups  => { default => [':all'], %$groups }
48         }
49     );
50
51     my %methods;
52     # $args{_export_to_main} exists for backwards compat, because
53     # Moose::Util::TypeConstraints did export to main (unlike Moose &
54     # Moose::Role).
55     $methods{import} = $class->_make_import_sub( $exporting_package,
56         $exporter, \@exports_from, $args{_export_to_main} );
57
58     $methods{unimport} = $class->_make_unimport_sub( $exporting_package,
59         $exports, $is_removable, $export_recorder );
60
61     $methods{init_meta} = $class->_make_init_meta( $exporting_package,
62         \%args );
63
64     my $package = Class::MOP::Package->initialize($exporting_package);
65     for my $to_install ( @{ $args{install} || [] } ) {
66         my $symbol = '&' . $to_install;
67         next
68             unless $methods{$to_install}
69                 && !$package->has_package_symbol($symbol);
70         $package->add_package_symbol( $symbol, $methods{$to_install} );
71     }
72
73     return ( $methods{import}, $methods{unimport}, $methods{init_meta} )
74 }
75
76 {
77     my $seen = {};
78
79     sub _follow_also {
80         my $class             = shift;
81         my $exporting_package = shift;
82
83         local %$seen = ( $exporting_package => 1 );
84
85         return uniq( _follow_also_real($exporting_package) );
86     }
87
88     sub _follow_also_real {
89         my $exporting_package = shift;
90
91         if (!exists $EXPORT_SPEC{$exporting_package}) {
92             my $loaded = Class::MOP::is_class_loaded($exporting_package);
93
94             die "Package in also ($exporting_package) does not seem to "
95               . "use Moose::Exporter"
96               . ($loaded ? "" : " (is it loaded?)");
97         }
98
99         my $also = $EXPORT_SPEC{$exporting_package}{also};
100
101         return unless defined $also;
102
103         my @also = ref $also ? @{$also} : $also;
104
105         for my $package (@also)
106         {
107             die "Circular reference in also parameter to Moose::Exporter between $exporting_package and $package"
108                 if $seen->{$package};
109
110             $seen->{$package} = 1;
111         }
112
113         return @also, map { _follow_also_real($_) } @also;
114     }
115 }
116
117 sub _make_sub_exporter_params {
118     my $class             = shift;
119     my $packages          = shift;
120     my $export_recorder   = shift;
121
122     my %groups;
123     my %exports;
124     my %is_removable;
125
126     for my $package ( @{$packages} ) {
127         my $args = $EXPORT_SPEC{$package}
128             or die "The $package package does not use Moose::Exporter\n";
129
130         # one group for each 'also' package
131         $groups{$package} = [
132             @{ $args->{with_caller} || [] },
133             @{ $args->{with_meta}   || [] },
134             @{ $args->{as_is}       || [] },
135             map ":$_",
136             keys %{ $args->{groups} || {} }
137         ];
138
139         for my $name ( @{ $args->{with_caller} } ) {
140             my $sub = do {
141                 no strict 'refs';
142                 \&{ $package . '::' . $name };
143             };
144
145             if ( !defined(&$sub) ) {
146                 Carp::cluck
147                     "Trying to export undefined sub ${package}::${name}";
148                 next;
149             }
150
151             my $fq_name = $package . '::' . $name;
152
153             $exports{$name} = $class->_make_wrapped_sub(
154                 $fq_name,
155                 $sub,
156                 $export_recorder,
157             );
158
159             $is_removable{$name} = 1;
160         }
161
162         for my $name ( @{ $args->{with_meta} } ) {
163             my $sub = do {
164                 no strict 'refs';
165                 \&{ $package . '::' . $name };
166             };
167
168             if ( !defined(&$sub) ) {
169                 Carp::cluck
170                     "Trying to export undefined sub ${package}::${name}";
171                 next;
172             }
173
174             my $fq_name = $package . '::' . $name;
175
176             $exports{$name} = $class->_make_wrapped_sub_with_meta(
177                 $fq_name,
178                 $sub,
179                 $export_recorder,
180             );
181
182             $is_removable{$name} = 1;
183         }
184
185         for my $name ( @{ $args->{as_is} } ) {
186             my ($sub, $coderef_name);
187
188             if ( ref $name ) {
189                 $sub  = $name;
190
191                 # Even though Moose re-exports things from Carp &
192                 # Scalar::Util, we don't want to remove those at
193                 # unimport time, because the importing package may
194                 # have imported them explicitly ala
195                 #
196                 # use Carp qw( confess );
197                 #
198                 # This is a hack. Since we can't know whether they
199                 # really want to keep these subs or not, we err on the
200                 # safe side and leave them in.
201                 my $coderef_pkg;
202                 ( $coderef_pkg, $coderef_name )
203                     = Class::MOP::get_code_info($name);
204
205                 $is_removable{$coderef_name} = $coderef_pkg eq $package ? 1 : 0;
206             }
207             else {
208                 $sub = do {
209                     no strict 'refs';
210                     \&{ $package . '::' . $name };
211                 };
212
213                 if ( !defined(&$sub) ) {
214                     Carp::cluck
215                         "Trying to export undefined sub ${package}::${name}";
216                     next;
217                 }
218
219                 $is_removable{$name} = 1;
220                 $coderef_name = $name;
221             }
222
223             $export_recorder->{$sub} = 1;
224
225             $exports{$coderef_name} = sub {$sub};
226         }
227
228         for my $name ( keys %{ $args->{groups} } ) {
229             my $group = $args->{groups}{$name};
230
231             if (ref $group eq 'CODE') {
232                 $groups{$name} = $class->_make_wrapped_group(
233                     $package,
234                     $group,
235                     $export_recorder,
236                     \%exports,
237                     \%is_removable
238                 );
239             }
240             elsif (ref $group eq 'ARRAY') {
241                 $groups{$name} = $group;
242             }
243         }
244     }
245
246     return ( \%exports, \%is_removable, \%groups );
247 }
248
249 our $CALLER;
250
251 sub _make_wrapped_sub {
252     my $self            = shift;
253     my $fq_name         = shift;
254     my $sub             = shift;
255     my $export_recorder = shift;
256
257     # We need to set the package at import time, so that when
258     # package Foo imports has(), we capture "Foo" as the
259     # package. This lets other packages call Foo::has() and get
260     # the right package. This is done for backwards compatibility
261     # with existing production code, not because this is a good
262     # idea ;)
263     return sub {
264         my $caller = $CALLER;
265
266         my $wrapper = $self->_curry_wrapper($sub, $fq_name, $caller);
267
268         my $sub = subname($fq_name => $wrapper);
269
270         $export_recorder->{$sub} = 1;
271
272         return $sub;
273     };
274 }
275
276 sub _make_wrapped_sub_with_meta {
277     my $self            = shift;
278     my $fq_name         = shift;
279     my $sub             = shift;
280     my $export_recorder = shift;
281
282     return sub {
283         my $caller = $CALLER;
284
285         my $wrapper = $self->_late_curry_wrapper($sub, $fq_name,
286             sub { Class::MOP::class_of(shift) } => $caller);
287
288         my $sub = subname($fq_name => $wrapper);
289
290         $export_recorder->{$sub} = 1;
291
292         return $sub;
293     };
294 }
295
296 sub _make_wrapped_group {
297     my $class           = shift;
298     my $package         = shift; # package calling use Moose::Exporter
299     my $sub             = shift;
300     my $export_recorder = shift;
301     my $keywords        = shift;
302     my $is_removable    = shift;
303
304     return sub {
305         my $caller = $CALLER; # package calling use PackageUsingMooseExporter -group => {args}
306
307         # there are plenty of ways to deal with telling the code which
308         # package it lives in. the last arg (collector hashref) is
309         # otherwise unused, so we'll stick the original package in
310         # there and act like 'with_caller' by putting the calling
311         # package name as the first arg
312         $_[0] = $caller;
313         $_[3]{from} = $package;
314
315         my $named_code = $sub->(@_);
316         $named_code ||= { };
317
318         # send invalid return value error up to Sub::Exporter
319         unless (ref $named_code eq 'HASH') {
320             return $named_code;
321         }
322
323         for my $name (keys %$named_code) {
324             my $code = $named_code->{$name};
325
326             my $fq_name = $package . '::' . $name;
327             my $wrapper = $class->_curry_wrapper(
328                 $code,
329                 $fq_name,
330                 $caller
331             );
332
333             my $sub = subname( $fq_name => $wrapper );
334             $named_code->{$name} = $sub;
335
336             # mark each coderef as ours
337             $keywords->{$name} = 1;
338             $is_removable->{$name} = 1;
339             $export_recorder->{$sub} = 1;
340         }
341
342         return $named_code;
343     };
344 }
345
346 sub _curry_wrapper {
347     my $class   = shift;
348     my $sub     = shift;
349     my $fq_name = shift;
350     my @extra   = @_;
351
352     my $wrapper = sub { $sub->(@extra, @_) };
353     if (my $proto = prototype $sub) {
354         # XXX - Perl's prototype sucks. Use & to make set_prototype
355         # ignore the fact that we're passing "private variables"
356         &Scalar::Util::set_prototype($wrapper, $proto);
357     }
358     return $wrapper;
359 }
360
361 sub _late_curry_wrapper {
362     my $class   = shift;
363     my $sub     = shift;
364     my $fq_name = shift;
365     my $extra   = shift;
366     my @ex_args = @_;
367
368     my $wrapper = sub {
369         # resolve curried arguments at runtime via this closure
370         my @curry = ( $extra->( @ex_args ) );
371         return $sub->(@curry, @_);
372     };
373
374     if (my $proto = prototype $sub) {
375         # XXX - Perl's prototype sucks. Use & to make set_prototype
376         # ignore the fact that we're passing "private variables"
377         &Scalar::Util::set_prototype($wrapper, $proto);
378     }
379     return $wrapper;
380 }
381
382 sub _make_import_sub {
383     shift;
384     my $exporting_package = shift;
385     my $exporter          = shift;
386     my $exports_from      = shift;
387     my $export_to_main    = shift;
388
389     return sub {
390
391         # I think we could use Sub::Exporter's collector feature
392         # to do this, but that would be rather gross, since that
393         # feature isn't really designed to return a value to the
394         # caller of the exporter sub.
395         #
396         # Also, this makes sure we preserve backwards compat for
397         # _get_caller, so it always sees the arguments in the
398         # expected order.
399         my $traits;
400         ( $traits, @_ ) = _strip_traits(@_);
401
402         my $metaclass;
403         ( $metaclass, @_ ) = _strip_metaclass(@_);
404         $metaclass = Moose::Util::resolve_metaclass_alias(
405             'Class' => $metaclass
406         ) if defined $metaclass && length $metaclass;
407
408         # Normally we could look at $_[0], but in some weird cases
409         # (involving goto &Moose::import), $_[0] ends as something
410         # else (like Squirrel).
411         my $class = $exporting_package;
412
413         $CALLER = _get_caller(@_);
414
415         # this works because both pragmas set $^H (see perldoc
416         # perlvar) which affects the current compilation -
417         # i.e. the file who use'd us - which is why we don't need
418         # to do anything special to make it affect that file
419         # rather than this one (which is already compiled)
420
421         strict->import;
422         warnings->import;
423
424         # we should never export to main
425         if ( $CALLER eq 'main' && !$export_to_main ) {
426             warn
427                 qq{$class does not export its sugar to the 'main' package.\n};
428             return;
429         }
430
431         my $did_init_meta;
432         for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) {
433             # init_meta can apply a role, which when loaded uses
434             # Moose::Exporter, which in turn sets $CALLER, so we need
435             # to protect against that.
436             local $CALLER = $CALLER;
437             $c->init_meta( for_class => $CALLER, metaclass => $metaclass );
438             $did_init_meta = 1;
439         }
440
441         if ( $did_init_meta && @{$traits} ) {
442             # The traits will use Moose::Role, which in turn uses
443             # Moose::Exporter, which in turn sets $CALLER, so we need
444             # to protect against that.
445             local $CALLER = $CALLER;
446             _apply_meta_traits( $CALLER, $traits );
447         }
448         elsif ( @{$traits} ) {
449             require Moose;
450             Moose->throw_error(
451                 "Cannot provide traits when $class does not have an init_meta() method"
452             );
453         }
454
455         goto $exporter;
456     };
457 }
458
459
460 sub _strip_traits {
461     my $idx = first_index { $_ eq '-traits' } @_;
462
463     return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
464
465     my $traits = $_[ $idx + 1 ];
466
467     splice @_, $idx, 2;
468
469     $traits = [ $traits ] unless ref $traits;
470
471     return ( $traits, @_ );
472 }
473
474 sub _strip_metaclass {
475     my $idx = first_index { $_ eq '-metaclass' } @_;
476
477     return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1;
478
479     my $metaclass = $_[ $idx + 1 ];
480
481     splice @_, $idx, 2;
482
483     return ( $metaclass, @_ );
484 }
485
486 sub _apply_meta_traits {
487     my ( $class, $traits ) = @_;
488
489     return unless @{$traits};
490
491     my $meta = Class::MOP::class_of($class);
492
493     my $type = ( split /::/, ref $meta )[-1]
494         or Moose->throw_error(
495         'Cannot determine metaclass type for trait application . Meta isa '
496         . ref $meta );
497
498     my @resolved_traits
499         = map {
500             ref $_ ? $_ : Moose::Util::resolve_metatrait_alias( $type => $_ )
501         }
502         @$traits;
503
504     return unless @resolved_traits;
505
506     Moose::Util::MetaRole::apply_metaclass_roles(
507         for_class       => $class,
508         metaclass_roles => \@resolved_traits,
509     );
510 }
511
512 sub _get_caller {
513     # 1 extra level because it's called by import so there's a layer
514     # of indirection
515     my $offset = 1;
516
517     return
518           ( ref $_[1] && defined $_[1]->{into} ) ? $_[1]->{into}
519         : ( ref $_[1] && defined $_[1]->{into_level} )
520         ? caller( $offset + $_[1]->{into_level} )
521         : caller($offset);
522 }
523
524 sub _make_unimport_sub {
525     shift;
526     my $exporting_package = shift;
527     my $exports           = shift;
528     my $is_removable      = shift;
529     my $export_recorder   = shift;
530
531     return sub {
532         my $caller = scalar caller();
533         Moose::Exporter->_remove_keywords(
534             $caller,
535             [ keys %{$exports} ],
536             $is_removable,
537             $export_recorder,
538         );
539     };
540 }
541
542 sub _remove_keywords {
543     shift;
544     my $package          = shift;
545     my $keywords         = shift;
546     my $is_removable     = shift;
547     my $recorded_exports = shift;
548
549     no strict 'refs';
550
551     foreach my $name ( @{ $keywords } ) {
552         next unless $is_removable->{$name};
553
554         if ( defined &{ $package . '::' . $name } ) {
555             my $sub = \&{ $package . '::' . $name };
556
557             # make sure it is from us
558             next unless $recorded_exports->{$sub};
559
560             # and if it is from us, then undef the slot
561             delete ${ $package . '::' }{$name};
562         }
563     }
564 }
565
566 sub _make_init_meta {
567     shift;
568     my $class = shift;
569     my $args  = shift;
570
571     my %metaclass_roles;
572     for my $role (
573         map {"${_}_roles"}
574         qw(metaclass
575         attribute_metaclass
576         method_metaclass
577         wrapped_method_metaclass
578         instance_metaclass
579         constructor_class
580         destructor_class
581         error_class
582         application_to_class_class
583         application_to_role_class
584         application_to_instance_class)
585         ) {
586         $metaclass_roles{$role} = $args->{$role} if exists $args->{$role};
587     }
588
589     my %base_class_roles;
590     %base_class_roles = ( roles => $args->{base_class_roles} )
591         if exists $args->{base_class_roles};
592
593     return unless %metaclass_roles || %base_class_roles;
594
595     return sub {
596         shift;
597         my %options = @_;
598
599         return unless Class::MOP::class_of( $options{for_class} );
600
601         Moose::Util::MetaRole::apply_metaclass_roles(
602             for_class => $options{for_class},
603             %metaclass_roles,
604         );
605
606         Moose::Util::MetaRole::apply_base_class_roles(
607             for_class => $options{for_class},
608             %base_class_roles,
609             )
610             if Class::MOP::class_of( $options{for_class} )
611                 ->isa('Moose::Meta::Class');
612
613         return Class::MOP::class_of( $options{for_class} );
614     };
615 }
616
617 sub import {
618     strict->import;
619     warnings->import;
620 }
621
622 1;
623
624 __END__
625
626 =head1 NAME
627
628 Moose::Exporter - make an import() and unimport() just like Moose.pm
629
630 =head1 SYNOPSIS
631
632   package MyApp::Moose;
633
634   use Moose ();
635   use Moose::Exporter;
636
637   Moose::Exporter->setup_import_methods(
638       with_caller => [ 'has_rw', 'sugar2' ],
639       as_is       => [ 'sugar3', \&Some::Random::thing ],
640       also        => 'Moose',
641   );
642
643   sub has_rw {
644       my ($caller, $name, %options) = @_;
645       Class::MOP::class_of($caller)->add_attribute($name,
646           is => 'rw',
647           %options,
648       );
649   }
650
651   # then later ...
652   package MyApp::User;
653
654   use MyApp::Moose;
655
656   has 'name';
657   has_rw 'size';
658   thing;
659
660   no MyApp::Moose;
661
662 =head1 DESCRIPTION
663
664 This module encapsulates the exporting of sugar functions in a
665 C<Moose.pm>-like manner. It does this by building custom C<import>,
666 C<unimport>, and C<init_meta> methods for your module, based on a spec you
667 provide.
668
669 It also lets you "stack" Moose-alike modules so you can export Moose's sugar
670 as well as your own, along with sugar from any random C<MooseX> module, as
671 long as they all use C<Moose::Exporter>. This feature exists to let you bundle
672 a set of MooseX modules into a policy module that developers can use directly
673 instead of using Moose itself.
674
675 To simplify writing exporter modules, C<Moose::Exporter> also imports
676 C<strict> and C<warnings> into your exporter module, as well as into
677 modules that use it.
678
679 =head1 METHODS
680
681 This module provides two public methods:
682
683 =over 4
684
685 =item  B<< Moose::Exporter->setup_import_methods(...) >>
686
687 When you call this method, C<Moose::Exporter> builds custom C<import>,
688 C<unimport>, and C<init_meta> methods for your module. The C<import> method
689 will export the functions you specify, and can also re-export functions
690 exported by some other module (like C<Moose.pm>).
691
692 The C<unimport> method cleans the caller's namespace of all the exported
693 functions.
694
695 If you pass any parameters for L<Moose::Util::MetaRole>, this method will
696 generate an C<init_meta> for you as well (see below for details). This
697 C<init_meta> will call C<Moose::Util::MetaRole::apply_metaclass_roles> and
698 C<Moose::Util::MetaRole::apply_base_class_roles> as needed.
699
700 Note that if any of these methods already exist, they will not be
701 overridden, you will have to use C<build_import_methods> to get the
702 coderef that would be installed.
703
704 This method accepts the following parameters:
705
706 =over 8
707
708 =item * with_caller => [ ... ]
709
710 This list of function I<names only> will be wrapped and then exported. The
711 wrapper will pass the name of the calling package as the first argument to the
712 function. Many sugar functions need to know their caller so they can get the
713 calling package's metaclass object.
714
715 =item * as_is => [ ... ]
716
717 This list of function names or sub references will be exported as-is. You can
718 identify a subroutine by reference, which is handy to re-export some other
719 module's functions directly by reference (C<\&Some::Package::function>).
720
721 If you do export some other package's function, this function will never be
722 removed by the C<unimport> method. The reason for this is we cannot know if
723 the caller I<also> explicitly imported the sub themselves, and therefore wants
724 to keep it.
725
726 =item * also => $name or \@names
727
728 This is a list of modules which contain functions that the caller
729 wants to export. These modules must also use C<Moose::Exporter>. The
730 most common use case will be to export the functions from C<Moose.pm>.
731 Functions specified by C<with_caller> or C<as_is> take precedence over
732 functions exported by modules specified by C<also>, so that a module
733 can selectively override functions exported by another module.
734
735 C<Moose::Exporter> also makes sure all these functions get removed
736 when C<unimport> is called.
737
738 =back
739
740 Any of the C<*_roles> options for
741 C<Moose::Util::MetaRole::apply_metaclass_roles> and
742 C<Moose::Util::MetaRole::base_class_roles> are also acceptable.
743
744 =item B<< Moose::Exporter->build_import_methods(...) >>
745
746 Returns two or three code refs, one for C<import>, one for
747 C<unimport>, and optionally one for C<init_meta>, if the appropriate
748 options are passed in.
749
750 Accepts the additional C<install> option, which accepts an arrayref of method
751 names to install into your exporting package. The valid options are C<import>,
752 C<unimport>, and C<init_meta>. Calling C<setup_import_methods> is equivalent
753 to calling C<build_import_methods> with C<< install => [qw(import unimport
754 init_meta)] >> except that it doesn't also return the methods.
755
756 Used by C<setup_import_methods>.
757
758 =back
759
760 =head1 IMPORTING AND init_meta
761
762 If you want to set an alternative base object class or metaclass class, see
763 above for details on how this module can call L<Moose::Util::MetaRole> for
764 you.
765
766 If you want to do something that is not supported by this module, simply
767 define an C<init_meta> method in your class. The C<import> method that
768 C<Moose::Exporter> generates for you will call this method (if it exists). It
769 will always pass the caller to this method via the C<for_class> parameter.
770
771 Most of the time, your C<init_meta> method will probably just call C<<
772 Moose->init_meta >> to do the real work:
773
774   sub init_meta {
775       shift; # our class name
776       return Moose->init_meta( @_, metaclass => 'My::Metaclass' );
777   }
778
779 Keep in mind that C<build_import_methods> will return an C<init_meta>
780 method for you, which you can also call from within your custom
781 C<init_meta>:
782
783   my ( $import, $unimport, $init_meta ) =
784       Moose::Exporter->build_import_methods( ... );
785
786   sub import {
787      my $class = shift;
788
789      ...
790
791      $class->$import(...);
792
793      ...
794   }
795
796   sub unimport { goto &$unimport }
797
798   sub init_meta {
799      my $class = shift;
800
801      ...
802
803      $class->$init_meta(...);
804
805      ...
806   }
807
808 =head1 METACLASS TRAITS
809
810 The C<import> method generated by C<Moose::Exporter> will allow the
811 user of your module to specify metaclass traits in a C<-traits>
812 parameter passed as part of the import:
813
814   use Moose -traits => 'My::Meta::Trait';
815
816   use Moose -traits => [ 'My::Meta::Trait', 'My::Other::Trait' ];
817
818 These traits will be applied to the caller's metaclass
819 instance. Providing traits for an exporting class that does not create
820 a metaclass for the caller is an error.
821
822 =head1 AUTHOR
823
824 Dave Rolsky E<lt>autarch@urth.orgE<gt>
825
826 This is largely a reworking of code in Moose.pm originally written by
827 Stevan Little and others.
828
829 =head1 COPYRIGHT AND LICENSE
830
831 Copyright 2009 by Infinity Interactive, Inc.
832
833 L<http://www.iinteractive.com>
834
835 This library is free software; you can redistribute it and/or modify
836 it under the same terms as Perl itself.
837
838 =cut