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