X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FExporter.pm;h=dcdef3cbeba1afb3805b1685e46e0e324944d31c;hb=ef487af73b144341c8fd2e4640b93d395dc414ed;hp=53f22497677fcfb2e3a83c876fc0ebe01784deda;hpb=0661fc1a78d4ca877379f78de3761c1a53650dbd;p=gitmo%2FMoose.git diff --git a/lib/Moose/Exporter.pm b/lib/Moose/Exporter.pm index 53f2249..dcdef3c 100644 --- a/lib/Moose/Exporter.pm +++ b/lib/Moose/Exporter.pm @@ -3,13 +3,11 @@ package Moose::Exporter; use strict; use warnings; -our $VERSION = '0.89_01'; -$VERSION = eval $VERSION; -our $AUTHORITY = 'cpan:STEVAN'; - +use Class::Load qw(is_class_loaded); use Class::MOP; use List::MoreUtils qw( first_index uniq ); use Moose::Util::MetaRole; +use Scalar::Util qw(reftype); use Sub::Exporter 0.980; use Sub::Name qw(subname); @@ -18,7 +16,7 @@ my %EXPORT_SPEC; sub setup_import_methods { my ( $class, %args ) = @_; - my $exporting_package = $args{exporting_package} ||= caller(); + $args{exporting_package} ||= caller(); $class->build_import_methods( %args, @@ -31,35 +29,50 @@ sub build_import_methods { my $exporting_package = $args{exporting_package} ||= caller(); + my $meta_lookup = $args{meta_lookup} || sub { Class::MOP::class_of(shift) }; + $EXPORT_SPEC{$exporting_package} = \%args; - my @exports_from = $class->_follow_also( $exporting_package ); + my @exports_from = $class->_follow_also($exporting_package); my $export_recorder = {}; + my $is_reexport = {}; - my ( $exports, $is_removable ) - = $class->_make_sub_exporter_params( - [ @exports_from, $exporting_package ], $export_recorder ); + my $exports = $class->_make_sub_exporter_params( + [ $exporting_package, @exports_from ], + $export_recorder, + $is_reexport, + $args{meta_lookup}, # so that we don't pass through the default + ); - my $exporter = Sub::Exporter::build_exporter( - { - exports => $exports, - groups => { default => [':all'] } - } + my $exporter = $class->_make_exporter( + $exports, + $is_reexport, + $meta_lookup, ); my %methods; - # $args{_export_to_main} exists for backwards compat, because - # Moose::Util::TypeConstraints did export to main (unlike Moose & - # Moose::Role). - $methods{import} = $class->_make_import_sub( $exporting_package, - $exporter, \@exports_from, $args{_export_to_main} ); + $methods{import} = $class->_make_import_sub( + $exporting_package, + $exporter, + \@exports_from, + $is_reexport, + $meta_lookup, + ); - $methods{unimport} = $class->_make_unimport_sub( $exporting_package, - $exports, $is_removable, $export_recorder ); + $methods{unimport} = $class->_make_unimport_sub( + $exporting_package, + $exports, + $export_recorder, + $is_reexport, + $meta_lookup, + ); - $methods{init_meta} = $class->_make_init_meta( $exporting_package, - \%args ); + $methods{init_meta} = $class->_make_init_meta( + $exporting_package, + \%args, + $meta_lookup, + ); my $package = Class::MOP::Package->initialize($exporting_package); for my $to_install ( @{ $args{install} || [] } ) { @@ -70,7 +83,50 @@ sub build_import_methods { $package->add_package_symbol( $symbol, $methods{$to_install} ); } - return ( $methods{import}, $methods{unimport}, $methods{init_meta} ) + return ( $methods{import}, $methods{unimport}, $methods{init_meta} ); +} + +sub _make_exporter { + my ($class, $exports, $is_reexport, $meta_lookup) = @_; + + return Sub::Exporter::build_exporter( + { + exports => $exports, + groups => { default => [':all'] }, + installer => sub { + my ($arg, $to_export) = @_; + my $meta = $meta_lookup->($arg->{into}); + + goto &Sub::Exporter::default_installer unless $meta; + + # don't overwrite existing symbols with our magically flagged + # version of it if we would install the same sub that's already + # in the importer + + my @filtered_to_export; + my %installed; + for (my $i = 0; $i < @{ $to_export }; $i += 2) { + my ($as, $cv) = @{ $to_export }[$i, $i + 1]; + + next if !ref($as) + && $meta->has_package_symbol('&' . $as) + && $meta->get_package_symbol('&' . $as) == $cv; + + push @filtered_to_export, $as, $cv; + $installed{$as} = 1 unless ref $as; + } + + Sub::Exporter::default_installer($arg, \@filtered_to_export); + + for my $name ( keys %{$is_reexport} ) { + no strict 'refs'; + no warnings 'once'; + next unless exists $installed{$name}; + _flag_as_reexport( \*{ join q{::}, $arg->{into}, $name } ); + } + }, + } + ); } { @@ -88,12 +144,12 @@ sub build_import_methods { sub _follow_also_real { my $exporting_package = shift; - if (!exists $EXPORT_SPEC{$exporting_package}) { - my $loaded = Class::MOP::is_class_loaded($exporting_package); + if ( !exists $EXPORT_SPEC{$exporting_package} ) { + my $loaded = is_class_loaded($exporting_package); die "Package in also ($exporting_package) does not seem to " - . "use Moose::Exporter" - . ($loaded ? "" : " (is it loaded?)"); + . "use Moose::Exporter" + . ( $loaded ? "" : " (is it loaded?)" ); } my $also = $EXPORT_SPEC{$exporting_package}{also}; @@ -102,9 +158,9 @@ sub build_import_methods { my @also = ref $also ? @{$also} : $also; - for my $package (@also) - { - die "Circular reference in also parameter to Moose::Exporter between $exporting_package and $package" + for my $package (@also) { + die + "Circular reference in 'also' parameter to Moose::Exporter between $exporting_package and $package" if $seen->{$package}; $seen->{$package} = 1; @@ -114,23 +170,53 @@ sub build_import_methods { } } +sub _parse_trait_aliases { + my $class = shift; + my ($package, $aliases) = @_; + + my @ret; + for my $alias (@$aliases) { + my $name; + if (ref($alias)) { + reftype($alias) eq 'ARRAY' + or Moose->throw_error(reftype($alias) . " references are not " + . "valid arguments to the 'trait_aliases' " + . "option"); + + ($alias, $name) = @$alias; + } + else { + ($name = $alias) =~ s/.*:://; + } + push @ret, subname "${package}::${name}" => sub () { $alias }; + } + + return @ret; +} + sub _make_sub_exporter_params { - my $class = shift; - my $packages = shift; - my $export_recorder = shift; + my $class = shift; + my $packages = shift; + my $export_recorder = shift; + my $is_reexport = shift; + my $meta_lookup_override = shift; my %exports; - my %is_removable; + my $current_meta_lookup; for my $package ( @{$packages} ) { my $args = $EXPORT_SPEC{$package} or die "The $package package does not use Moose::Exporter\n"; + $current_meta_lookup = $meta_lookup_override || $args->{meta_lookup}; + $meta_lookup_override = $current_meta_lookup; + + my $meta_lookup = $current_meta_lookup + || sub { Class::MOP::class_of(shift) }; + for my $name ( @{ $args->{with_meta} } ) { - my $sub = do { - no strict 'refs'; - \&{ $package . '::' . $name }; - }; + my $sub = $class->_sub_from_package( $package, $name ) + or next; my $fq_name = $package . '::' . $name; @@ -138,16 +224,13 @@ sub _make_sub_exporter_params { $fq_name, $sub, $export_recorder, - ); - - $is_removable{$name} = 1; + $meta_lookup, + ) unless exists $exports{$name}; } for my $name ( @{ $args->{with_caller} } ) { - my $sub = do { - no strict 'refs'; - \&{ $package . '::' . $name }; - }; + my $sub = $class->_sub_from_package( $package, $name ) + or next; my $fq_name = $package . '::' . $name; @@ -155,48 +238,58 @@ sub _make_sub_exporter_params { $fq_name, $sub, $export_recorder, - ); - - $is_removable{$name} = 1; + ) unless exists $exports{$name}; } - for my $name ( @{ $args->{as_is} } ) { - my $sub; + my @extra_exports = $class->_parse_trait_aliases( + $package, $args->{trait_aliases}, + ); + for my $name ( @{ $args->{as_is} }, @extra_exports ) { + my ( $sub, $coderef_name ); if ( ref $name ) { - $sub = $name; - - # Even though Moose re-exports things from Carp & - # Scalar::Util, we don't want to remove those at - # unimport time, because the importing package may - # have imported them explicitly ala - # - # use Carp qw( confess ); - # - # This is a hack. Since we can't know whether they - # really want to keep these subs or not, we err on the - # safe side and leave them in. + $sub = $name; + my $coderef_pkg; - ( $coderef_pkg, $name ) = Class::MOP::get_code_info($name); + ( $coderef_pkg, $coderef_name ) + = Class::MOP::get_code_info($name); - $is_removable{$name} = $coderef_pkg eq $package ? 1 : 0; + if ( $coderef_pkg ne $package ) { + $is_reexport->{$coderef_name} = 1; + } } else { - $sub = do { - no strict 'refs'; - \&{ $package . '::' . $name }; - }; + $sub = $class->_sub_from_package( $package, $name ) + or next; - $is_removable{$name} = 1; + $coderef_name = $name; } $export_recorder->{$sub} = 1; - $exports{$name} = sub {$sub}; + $exports{$coderef_name} = sub { $sub } + unless exists $exports{$coderef_name}; } } - return ( \%exports, \%is_removable ); + return \%exports; +} + +sub _sub_from_package { + my $sclass = shift; + my $package = shift; + my $name = shift; + + my $sub = do { + no strict 'refs'; + \&{ $package . '::' . $name }; + }; + + return $sub if defined &$sub; + + Carp::cluck "Trying to export undefined sub ${package}::${name}"; + + return; } our $CALLER; @@ -216,9 +309,9 @@ sub _make_wrapped_sub { return sub { my $caller = $CALLER; - my $wrapper = $self->_curry_wrapper($sub, $fq_name, $caller); + my $wrapper = $self->_curry_wrapper( $sub, $fq_name, $caller ); - my $sub = subname($fq_name => $wrapper); + my $sub = subname( $fq_name => $wrapper ); $export_recorder->{$sub} = 1; @@ -231,14 +324,17 @@ sub _make_wrapped_sub_with_meta { my $fq_name = shift; my $sub = shift; my $export_recorder = shift; + my $meta_lookup = shift; return sub { my $caller = $CALLER; - my $wrapper = $self->_late_curry_wrapper($sub, $fq_name, - sub { Class::MOP::class_of(shift) } => $caller); + my $wrapper = $self->_late_curry_wrapper( + $sub, $fq_name, + $meta_lookup => $caller + ); - my $sub = subname($fq_name => $wrapper); + my $sub = subname( $fq_name => $wrapper ); $export_recorder->{$sub} = 1; @@ -246,67 +342,18 @@ sub _make_wrapped_sub_with_meta { }; } -sub _make_wrapped_group { - my $class = shift; - my $package = shift; # package calling use Moose::Exporter - my $sub = shift; - my $export_recorder = shift; - my $keywords = shift; - my $is_removable = shift; - - return sub { - my $caller = $CALLER; # package calling use PackageUsingMooseExporter -group => {args} - - # there are plenty of ways to deal with telling the code which - # package it lives in. the last arg (collector hashref) is - # otherwise unused, so we'll stick the original package in - # there and act like 'with_caller' by putting the calling - # package name as the first arg - $_[0] = $caller; - $_[3]{from} = $package; - - my $named_code = $sub->(@_); - $named_code ||= { }; - - # send invalid return value error up to Sub::Exporter - unless (ref $named_code eq 'HASH') { - return $named_code; - } - - for my $name (keys %$named_code) { - my $code = $named_code->{$name}; - - my $fq_name = $package . '::' . $name; - my $wrapper = $class->_curry_wrapper( - $code, - $fq_name, - $caller - ); - - my $sub = subname( $fq_name => $wrapper ); - $named_code->{$name} = $sub; - - # mark each coderef as ours - $keywords->{$name} = 1; - $is_removable->{$name} = 1; - $export_recorder->{$sub} = 1; - } - - return $named_code; - }; -} - sub _curry_wrapper { my $class = shift; my $sub = shift; my $fq_name = shift; my @extra = @_; - my $wrapper = sub { $sub->(@extra, @_) }; - if (my $proto = prototype $sub) { + my $wrapper = sub { $sub->( @extra, @_ ) }; + if ( my $proto = prototype $sub ) { + # XXX - Perl's prototype sucks. Use & to make set_prototype # ignore the fact that we're passing "private variables" - &Scalar::Util::set_prototype($wrapper, $proto); + &Scalar::Util::set_prototype( $wrapper, $proto ); } return $wrapper; } @@ -319,15 +366,17 @@ sub _late_curry_wrapper { my @ex_args = @_; my $wrapper = sub { + # resolve curried arguments at runtime via this closure - my @curry = ( $extra->( @ex_args ) ); - return $sub->(@curry, @_); + my @curry = ( $extra->(@ex_args) ); + return $sub->( @curry, @_ ); }; - if (my $proto = prototype $sub) { + if ( my $proto = prototype $sub ) { + # XXX - Perl's prototype sucks. Use & to make set_prototype # ignore the fact that we're passing "private variables" - &Scalar::Util::set_prototype($wrapper, $proto); + &Scalar::Util::set_prototype( $wrapper, $proto ); } return $wrapper; } @@ -337,7 +386,8 @@ sub _make_import_sub { my $exporting_package = shift; my $exporter = shift; my $exports_from = shift; - my $export_to_main = shift; + my $is_reexport = shift; + my $meta_lookup = shift; return sub { @@ -354,9 +404,12 @@ sub _make_import_sub { my $metaclass; ( $metaclass, @_ ) = _strip_metaclass(@_); - $metaclass = Moose::Util::resolve_metaclass_alias( - 'Class' => $metaclass - ) if defined $metaclass && length $metaclass; + $metaclass + = Moose::Util::resolve_metaclass_alias( 'Class' => $metaclass ) + if defined $metaclass && length $metaclass; + + my $meta_name; + ( $meta_name, @_ ) = _strip_meta_name(@_); # Normally we could look at $_[0], but in some weird cases # (involving goto &Moose::import), $_[0] ends as something @@ -374,29 +427,28 @@ sub _make_import_sub { strict->import; warnings->import; - # we should never export to main - if ( $CALLER eq 'main' && !$export_to_main ) { - warn - qq{$class does not export its sugar to the 'main' package.\n}; - return; - } - my $did_init_meta; for my $c ( grep { $_->can('init_meta') } $class, @{$exports_from} ) { + # init_meta can apply a role, which when loaded uses # Moose::Exporter, which in turn sets $CALLER, so we need # to protect against that. local $CALLER = $CALLER; - $c->init_meta( for_class => $CALLER, metaclass => $metaclass ); + $c->init_meta( + for_class => $CALLER, + metaclass => $metaclass, + meta_name => $meta_name, + ); $did_init_meta = 1; } if ( $did_init_meta && @{$traits} ) { + # The traits will use Moose::Role, which in turn uses # Moose::Exporter, which in turn sets $CALLER, so we need # to protect against that. local $CALLER = $CALLER; - _apply_meta_traits( $CALLER, $traits ); + _apply_meta_traits( $CALLER, $traits, $meta_lookup ); } elsif ( @{$traits} ) { require Moose; @@ -405,13 +457,21 @@ sub _make_import_sub { ); } - goto $exporter; + my ( undef, @args ) = @_; + my $extra = shift @args if ref $args[0] eq 'HASH'; + + $extra ||= {}; + if ( !$extra->{into} ) { + $extra->{into_level} ||= 0; + $extra->{into_level}++; + } + + $class->$exporter( $extra, @args ); }; } - sub _strip_traits { - my $idx = first_index { $_ eq '-traits' } @_; + my $idx = first_index { ( $_ || '' ) eq '-traits' } @_; return ( [], @_ ) unless $idx >= 0 && $#_ >= $idx + 1; @@ -419,13 +479,13 @@ sub _strip_traits { splice @_, $idx, 2; - $traits = [ $traits ] unless ref $traits; + $traits = [$traits] unless ref $traits; return ( $traits, @_ ); } sub _strip_metaclass { - my $idx = first_index { $_ eq '-metaclass' } @_; + my $idx = first_index { ( $_ || '' ) eq '-metaclass' } @_; return ( undef, @_ ) unless $idx >= 0 && $#_ >= $idx + 1; @@ -436,33 +496,52 @@ sub _strip_metaclass { return ( $metaclass, @_ ); } +sub _strip_meta_name { + my $idx = first_index { ( $_ || '' ) eq '-meta_name' } @_; + + return ( 'meta', @_ ) unless $idx >= 0 && $#_ >= $idx + 1; + + my $meta_name = $_[ $idx + 1 ]; + + splice @_, $idx, 2; + + return ( $meta_name, @_ ); +} + sub _apply_meta_traits { - my ( $class, $traits ) = @_; + my ( $class, $traits, $meta_lookup ) = @_; return unless @{$traits}; - my $meta = Class::MOP::class_of($class); + my $meta = $meta_lookup->($class); my $type = ( split /::/, ref $meta )[-1] or Moose->throw_error( 'Cannot determine metaclass type for trait application . Meta isa ' - . ref $meta ); + . ref $meta ); - my @resolved_traits - = map { - ref $_ ? $_ : Moose::Util::resolve_metatrait_alias( $type => $_ ) - } - @$traits; + my @resolved_traits = map { + ref $_ + ? $_ + : Moose::Util::resolve_metatrait_alias( $type => $_ ) + } @$traits; return unless @resolved_traits; - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => $class, - metaclass_roles => \@resolved_traits, - ); + my %args = ( for => $class ); + + if ( $meta->isa('Moose::Meta::Role') ) { + $args{role_metaroles} = { role => \@resolved_traits }; + } + else { + $args{class_metaroles} = { class => \@resolved_traits }; + } + + Moose::Util::MetaRole::apply_metaroles(%args); } sub _get_caller { + # 1 extra level because it's called by import so there's a layer # of indirection my $offset = 1; @@ -478,16 +557,17 @@ sub _make_unimport_sub { shift; my $exporting_package = shift; my $exports = shift; - my $is_removable = shift; my $export_recorder = shift; + my $is_reexport = shift; + my $meta_lookup = shift; return sub { my $caller = scalar caller(); Moose::Exporter->_remove_keywords( $caller, [ keys %{$exports} ], - $is_removable, $export_recorder, + $is_reexport, ); }; } @@ -496,20 +576,25 @@ sub _remove_keywords { shift; my $package = shift; my $keywords = shift; - my $is_removable = shift; my $recorded_exports = shift; + my $is_reexport = shift; no strict 'refs'; - foreach my $name ( @{ $keywords } ) { - next unless $is_removable->{$name}; - + foreach my $name ( @{$keywords} ) { if ( defined &{ $package . '::' . $name } ) { my $sub = \&{ $package . '::' . $name }; # make sure it is from us next unless $recorded_exports->{$sub}; + if ( $is_reexport->{$name} ) { + no strict 'refs'; + next + unless _export_is_flagged( + \*{ join q{::} => $package, $name } ); + } + # and if it is from us, then undef the slot delete ${ $package . '::' }{$name}; } @@ -518,13 +603,15 @@ sub _remove_keywords { sub _make_init_meta { shift; - my $class = shift; - my $args = shift; + my $class = shift; + my $args = shift; + my $meta_lookup = shift; - my %metaclass_roles; + my %old_style_roles; for my $role ( map {"${_}_roles"} - qw(metaclass + qw( + metaclass attribute_metaclass method_metaclass wrapped_method_metaclass @@ -532,38 +619,43 @@ sub _make_init_meta { constructor_class destructor_class error_class - application_to_class_class - application_to_role_class - application_to_instance_class) + ) ) { - $metaclass_roles{$role} = $args->{$role} if exists $args->{$role}; + $old_style_roles{$role} = $args->{$role} + if exists $args->{$role}; } my %base_class_roles; %base_class_roles = ( roles => $args->{base_class_roles} ) if exists $args->{base_class_roles}; - return unless %metaclass_roles || %base_class_roles; + my %new_style_roles = map { $_ => $args->{$_} } + grep { exists $args->{$_} } qw( class_metaroles role_metaroles ); + + return unless %new_style_roles || %old_style_roles || %base_class_roles; return sub { shift; my %options = @_; - return unless Class::MOP::class_of( $options{for_class} ); + return unless $meta_lookup->( $options{for_class} ); - Moose::Util::MetaRole::apply_metaclass_roles( - for_class => $options{for_class}, - %metaclass_roles, - ); + if ( %new_style_roles || %old_style_roles ) { + Moose::Util::MetaRole::apply_metaroles( + for => $options{for_class}, + %new_style_roles, + %old_style_roles, + ); + } Moose::Util::MetaRole::apply_base_class_roles( for_class => $options{for_class}, %base_class_roles, ) - if Class::MOP::class_of( $options{for_class} ) + if $meta_lookup->( $options{for_class} ) ->isa('Moose::Meta::Class'); - return Class::MOP::class_of( $options{for_class} ); + return $meta_lookup->( $options{for_class} ); }; } @@ -574,11 +666,9 @@ sub import { 1; -__END__ - -=head1 NAME +# ABSTRACT: make an import() and unimport() just like Moose.pm -Moose::Exporter - make an import() and unimport() just like Moose.pm +__END__ =head1 SYNOPSIS @@ -644,11 +734,13 @@ will export the functions you specify, and can also re-export functions exported by some other module (like C). The C method cleans the caller's namespace of all the exported -functions. +functions. This includes any functions you re-export from other +packages. However, if the consumer of your package also imports those +functions from the original package, they will I be cleaned. If you pass any parameters for L, this method will generate an C for you as well (see below for details). This -C will call C and +C will call C and C as needed. Note that if any of these methods already exist, they will not be @@ -678,6 +770,14 @@ removed by the C method. The reason for this is we cannot know if the caller I explicitly imported the sub themselves, and therefore wants to keep it. +=item * trait_aliases => [ ... ] + +This is a list of package names which should have shortened aliases exported, +similar to the functionality of L. Each element in the list can be +either a package name, in which case the export will be named as the last +namespace component of the package, or an arrayref, whose first element is the +package to alias to, and second element is the alias to export. + =item * also => $name or \@names This is a list of modules which contain functions that the caller @@ -690,11 +790,28 @@ can selectively override functions exported by another module. C also makes sure all these functions get removed when C is called. +=item * meta_lookup => sub { ... } + +This is a function which will be called to provide the metaclass +to be operated upon by the exporter. This is an advanced feature +intended for use by package generator modules in the vein of +L in order to simplify reusing sugar +from other modules that use C. This function is +used, for example, to select the metaclass to bind to functions +that are exported using the C option. + +This function will receive one parameter: the class name into which +the sugar is being exported. The default implementation is: + + sub { Class::MOP::class_of(shift) } + +Accordingly, this function is expected to return a metaclass. + =back -Any of the C<*_roles> options for -C and -C are also acceptable. +You can also provide parameters for C +and C. Specifically, valid parameters +are "class_metaroles", "role_metaroles", and "base_class_roles". =item B<< Moose::Exporter->build_import_methods(...) >> @@ -708,6 +825,10 @@ C, and C. Calling C is equivalent to calling C with C<< install => [qw(import unimport init_meta)] >> except that it doesn't also return the methods. +The C method is built using L. This means that it can +take a hashref of the form C<< { into => $package } >> to specify the package +it operates on. + Used by C. =back @@ -735,29 +856,32 @@ Keep in mind that C will return an C method for you, which you can also call from within your custom C: - my ( $import, $unimport, $init_meta ) = - Moose::Exporter->build_import_methods( ... ); + my ( $import, $unimport, $init_meta ) + = Moose::Exporter->build_import_methods(...); sub import { - my $class = shift; + my $class = shift; - ... + ... - $class->$import(...); + # You can either pass an explicit package to import into ... + $class->$import( { into => scalar(caller) }, ... ); - ... + ...; } + # ... or you can use 'goto' to provide the correct caller info to the + # generated method sub unimport { goto &$unimport } sub init_meta { - my $class = shift; + my $class = shift; - ... + ... - $class->$init_meta(...); + $class->$init_meta(...); - ... + ... } =head1 METACLASS TRAITS @@ -774,20 +898,8 @@ These traits will be applied to the caller's metaclass instance. Providing traits for an exporting class that does not create a metaclass for the caller is an error. -=head1 AUTHOR - -Dave Rolsky Eautarch@urth.orgE - -This is largely a reworking of code in Moose.pm originally written by -Stevan Little and others. - -=head1 COPYRIGHT AND LICENSE - -Copyright 2009 by Infinity Interactive, Inc. - -L +=head1 BUGS -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. +See L for details on reporting bugs. =cut