X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FUtil%2FTypeConstraints.pm;h=92652b994a3d52392ee1c097ff862b9e0db8f41a;hb=7605e87a6728e38c0b532430958bb52efb8139ff;hp=3e533c2199d5353710825978acfa74a662561186;hpb=16db8ee65fcdf2a4d44a08457202e05f42826515;p=gitmo%2FMoose.git diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index 3e533c2..92652b9 100644 --- a/lib/Moose/Util/TypeConstraints.pm +++ b/lib/Moose/Util/TypeConstraints.pm @@ -6,10 +6,6 @@ use List::MoreUtils qw( all any ); use Scalar::Util qw( blessed reftype ); use Moose::Exporter; -our $VERSION = '1.07'; -$VERSION = eval $VERSION; -our $AUTHORITY = 'cpan:STEVAN'; - ## -------------------------------------------------------- # Prototyped subs must be predeclared because we have a # circular dependency with Moose::Meta::Attribute et. al. @@ -22,9 +18,11 @@ sub where (&); sub via (&); sub message (&); sub optimize_as (&); +sub inline_as (&); ## -------------------------------------------------------- +use Moose::Deprecated; use Moose::Meta::TypeConstraint; use Moose::Meta::TypeConstraint::Union; use Moose::Meta::TypeConstraint::Parameterized; @@ -36,15 +34,14 @@ use Moose::Meta::TypeConstraint::DuckType; use Moose::Meta::TypeCoercion; use Moose::Meta::TypeCoercion::Union; use Moose::Meta::TypeConstraint::Registry; -use Moose::Util::TypeConstraints::OptimizedConstraints; Moose::Exporter->setup_import_methods( as_is => [ qw( type subtype class_type role_type maybe_type duck_type - as where message optimize_as + as where message optimize_as inline_as coerce from via - enum + enum union find_type_constraint register_type_constraint match_on_type ) @@ -72,13 +69,26 @@ sub export_type_constraints_as_functions { } sub create_type_constraint_union { + _create_type_constraint_union(\@_); +} + +sub create_named_type_constraint_union { + my $name = shift; + _create_type_constraint_union($name, \@_); +} + +sub _create_type_constraint_union { + my $name; + $name = shift if @_ > 1; + my @tcs = @{ shift() }; + my @type_constraint_names; - if ( scalar @_ == 1 && _detect_type_constraint_union( $_[0] ) ) { - @type_constraint_names = _parse_type_constraint_union( $_[0] ); + if ( scalar @tcs == 1 && _detect_type_constraint_union( $tcs[0] ) ) { + @type_constraint_names = _parse_type_constraint_union( $tcs[0] ); } else { - @type_constraint_names = @_; + @type_constraint_names = @tcs; } ( scalar @type_constraint_names >= 2 ) @@ -91,10 +101,15 @@ sub create_type_constraint_union { "Could not locate type constraint ($_) for the union"); } @type_constraint_names; - return Moose::Meta::TypeConstraint::Union->new( - type_constraints => \@type_constraints ); + my %options = ( + type_constraints => \@type_constraints + ); + $options{name} = $name if defined $name; + + return Moose::Meta::TypeConstraint::Union->new(%options); } + sub create_parameterized_type_constraint { my $type_constraint_name = shift; my ( $base_type, $type_parameter ) @@ -272,43 +287,17 @@ sub register_type_constraint { # type constructors sub type { - - # back-compat version, called without sugar - if ( !any { ( reftype($_) || '' ) eq 'HASH' } @_ ) { - return _create_type_constraint( $_[0], undef, $_[1] ); - } - my $name = shift; my %p = map { %{$_} } @_; return _create_type_constraint( $name, undef, $p{where}, $p{message}, - $p{optimize_as} + $p{optimize_as}, $p{inline_as}, ); } sub subtype { - - # crazy back-compat code for being called without sugar ... - # - # subtype 'Parent', sub { where }; - if ( scalar @_ == 2 && ( reftype( $_[1] ) || '' ) eq 'CODE' ) { - return _create_type_constraint( undef, @_ ); - } - - # subtype 'Parent', sub { where }, sub { message }; - # subtype 'Parent', sub { where }, sub { message }, sub { optimized }; - if ( scalar @_ >= 3 && all { ( reftype($_) || '' ) eq 'CODE' } - @_[ 1 .. $#_ ] ) { - return _create_type_constraint( undef, @_ ); - } - - # subtype 'Name', 'Parent', ... - if ( scalar @_ >= 2 && all { !ref } @_[ 0, 1 ] ) { - return _create_type_constraint(@_); - } - if ( @_ == 1 && !ref $_[0] ) { __PACKAGE__->_throw_error( 'A subtype cannot consist solely of a name, it must have a parent' @@ -329,7 +318,7 @@ sub subtype { return _create_type_constraint( $name, $p{as}, $p{where}, $p{message}, - $p{optimize_as} + $p{optimize_as}, $p{inline_as}, ); } @@ -393,12 +382,13 @@ sub coerce { # # subtype( 'Foo', as( 'Str', where { ... } ) ); # -# If as() returns all it's extra arguments, this just works, and +# If as() returns all its extra arguments, this just works, and # preserves backwards compatibility. sub as { { as => shift }, @_ } sub where (&) { { where => $_[0] } } sub message (&) { { message => $_[0] } } sub optimize_as (&) { { optimize_as => $_[0] } } +sub inline_as (&) { { inline_as => $_[0] } } sub from {@_} sub via (&) { $_[0] } @@ -410,17 +400,16 @@ sub enum { # if only an array-ref is passed then # you get an anon-enum # - SL - if ( ref $type_name eq 'ARRAY' && !@values ) { + if ( ref $type_name eq 'ARRAY' ) { + @values == 0 + || __PACKAGE__->_throw_error("enum called with an array reference and additional arguments. Did you mean to parenthesize the enum call's parameters?"); + @values = @$type_name; $type_name = undef; } if ( @values == 1 && ref $values[0] eq 'ARRAY' ) { @values = @{ $values[0] }; } - ( scalar @values >= 2 ) - || __PACKAGE__->_throw_error( - "You must have at least two values to enumerate through"); - my %valid = map { $_ => 1 } @values; register_type_constraint( create_enum_type_constraint( @@ -430,6 +419,25 @@ sub enum { ); } +sub union { + my ( $type_name, @constraints ) = @_; + if ( ref $type_name eq 'ARRAY' ) { + @constraints == 0 + || __PACKAGE__->_throw_error("union called with an array reference and additional arguments."); + @constraints = @$type_name; + $type_name = undef; + } + if ( @constraints == 1 && ref $constraints[0] eq 'ARRAY' ) { + @constraints = @{ $constraints[0] }; + } + if ( defined $type_name ) { + return register_type_constraint( + create_named_type_constraint_union( $type_name, @constraints ) + ); + } + return create_type_constraint_union( @constraints ); +} + sub create_enum_type_constraint { my ( $type_name, $values ) = @_; @@ -491,6 +499,7 @@ sub _create_type_constraint ($$$;$$) { my $check = shift; my $message = shift; my $optimized = shift; + my $inlined = shift; my $pkg_defined_in = scalar( caller(1) ); @@ -517,6 +526,7 @@ sub _create_type_constraint ($$$;$$) { ( $check ? ( constraint => $check ) : () ), ( $message ? ( message => $message ) : () ), ( $optimized ? ( optimized => $optimized ) : () ), + ( $inlined ? ( inlined => $inlined ) : () ), ); my $constraint; @@ -573,20 +583,53 @@ sub _install_type_coercions ($$) { my $valid_chars = qr{[\w:\.]}; my $type_atom = qr{ (?>$valid_chars+) }x; - my $ws = qr{ (?>\s*) }x; - - my $any; - - my $type = qr{ $type_atom (?: \[ $ws (??{$any}) $ws \] )? }x; - my $type_capture_parts - = qr{ ($type_atom) (?: \[ $ws ((??{$any})) $ws \] )? }x; - my $type_with_parameter - = qr{ $type_atom \[ $ws (??{$any}) $ws \] }x; - - my $op_union = qr{ $ws \| $ws }x; - my $union = qr{ $type (?> (?: $op_union $type )+ ) }x; + my $ws = qr{ (?>\s*) }x; + my $op_union = qr{ $ws \| $ws }x; + + my ($type, $type_capture_parts, $type_with_parameter, $union, $any); + if (Class::MOP::IS_RUNNING_ON_5_10) { + my $type_pattern + = q{ (?&type_atom) (?: \[ (?&ws) (?&any) (?&ws) \] )? }; + my $type_capture_parts_pattern + = q{ ((?&type_atom)) (?: \[ (?&ws) ((?&any)) (?&ws) \] )? }; + my $type_with_parameter_pattern + = q{ (?&type_atom) \[ (?&ws) (?&any) (?&ws) \] }; + my $union_pattern + = q{ (?&type) (?> (?: (?&op_union) (?&type) )+ ) }; + my $any_pattern + = q{ (?&type) | (?&union) }; + + my $defines = qr{(?(DEFINE) + (? $valid_chars) + (? $type_atom) + (? $ws) + (? $op_union) + (? $type_pattern) + (? $type_capture_parts_pattern) + (? $type_with_parameter_pattern) + (? $union_pattern) + (? $any_pattern) + )}x; + + $type = qr{ $type_pattern $defines }x; + $type_capture_parts = qr{ $type_capture_parts_pattern $defines }x; + $type_with_parameter = qr{ $type_with_parameter_pattern $defines }x; + $union = qr{ $union_pattern $defines }x; + $any = qr{ $any_pattern $defines }x; + } + else { + $type + = qr{ $type_atom (?: \[ $ws (??{$any}) $ws \] )? }x; + $type_capture_parts + = qr{ ($type_atom) (?: \[ $ws ((??{$any})) $ws \] )? }x; + $type_with_parameter + = qr{ $type_atom \[ $ws (??{$any}) $ws \] }x; + $union + = qr{ $type (?> (?: $op_union $type )+ ) }x; + $any + = qr{ $type | $union }x; + } - $any = qr{ $type | $union }x; sub _parse_parameterized_type_constraint { { no warnings 'void'; $any; } # force capture of interpolated lexical @@ -625,8 +668,9 @@ sub _install_type_coercions ($$) { # define some basic built-in types ## -------------------------------------------------------- -# By making these classes immutable before creating all the types we -# below, we avoid repeatedly calling the slow MOP-based accessors. +# By making these classes immutable before creating all the types in +# Moose::Util::TypeConstraints::Builtin , we avoid repeatedly calling the slow +# MOP-based accessors. $_->make_immutable( inline_constructor => 1, constructor_name => "_new", @@ -647,147 +691,8 @@ $_->make_immutable( Moose::Meta::TypeConstraint::Registry ); -type 'Any' => where {1}; # meta-type including all -subtype 'Item' => as 'Any'; # base-type - -subtype 'Undef' => as 'Item' => where { !defined($_) }; -subtype 'Defined' => as 'Item' => where { defined($_) }; - -subtype 'Bool' => as 'Item' => - where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' }; - -subtype 'Value' => as 'Defined' => where { !ref($_) } => - optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Value; - -subtype 'Ref' => as 'Defined' => where { ref($_) } => - optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Ref; - -subtype 'Str' => as 'Value' => where { ref(\$_) eq 'SCALAR' } => - optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Str; - -subtype 'Num' => as 'Str' => - where { Scalar::Util::looks_like_number($_) } => - optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Num; - -subtype 'Int' => as 'Num' => where { "$_" =~ /^-?[0-9]+$/ } => - optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Int; - -subtype 'CodeRef' => as 'Ref' => where { ref($_) eq 'CODE' } => - optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::CodeRef; -subtype 'RegexpRef' => as 'Ref' => where { ref($_) eq 'Regexp' } => - optimize_as - \&Moose::Util::TypeConstraints::OptimizedConstraints::RegexpRef; -subtype 'GlobRef' => as 'Ref' => where { ref($_) eq 'GLOB' } => - optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::GlobRef; - -# NOTE: -# scalar filehandles are GLOB refs, -# but a GLOB ref is not always a filehandle -subtype 'FileHandle' => as 'GlobRef' => where { - Scalar::Util::openhandle($_) || ( blessed($_) && $_->isa("IO::Handle") ); -} => optimize_as - \&Moose::Util::TypeConstraints::OptimizedConstraints::FileHandle; - -# NOTE: -# blessed(qr/.../) returns true,.. how odd -subtype 'Object' => as 'Ref' => - where { blessed($_) && blessed($_) ne 'Regexp' } => - optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Object; - -# This type is deprecated. -subtype 'Role' => as 'Object' => where { $_->can('does') } => - optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Role; - -my $_class_name_checker = sub { }; - -subtype 'ClassName' => as 'Str' => - where { Class::MOP::is_class_loaded($_) } => optimize_as - \&Moose::Util::TypeConstraints::OptimizedConstraints::ClassName; - -subtype 'RoleName' => as 'ClassName' => where { - (Class::MOP::class_of($_) || return)->isa('Moose::Meta::Role'); -} => optimize_as - \&Moose::Util::TypeConstraints::OptimizedConstraints::RoleName; - -## -------------------------------------------------------- -# parameterizable types ... - -$REGISTRY->add_type_constraint( - Moose::Meta::TypeConstraint::Parameterizable->new( - name => 'ScalarRef', - package_defined_in => __PACKAGE__, - parent => find_type_constraint('Ref'), - constraint => sub { ref($_) eq 'SCALAR' || ref($_) eq 'REF' }, - optimized => - \&Moose::Util::TypeConstraints::OptimizedConstraints::ScalarRef, - constraint_generator => sub { - my $type_parameter = shift; - my $check = $type_parameter->_compiled_type_constraint; - return sub { - return $check->(${ $_ }); - }; - } - ) -); - -$REGISTRY->add_type_constraint( - Moose::Meta::TypeConstraint::Parameterizable->new( - name => 'ArrayRef', - package_defined_in => __PACKAGE__, - parent => find_type_constraint('Ref'), - constraint => sub { ref($_) eq 'ARRAY' }, - optimized => - \&Moose::Util::TypeConstraints::OptimizedConstraints::ArrayRef, - constraint_generator => sub { - my $type_parameter = shift; - my $check = $type_parameter->_compiled_type_constraint; - return sub { - foreach my $x (@$_) { - ( $check->($x) ) || return; - } - 1; - } - } - ) -); - -$REGISTRY->add_type_constraint( - Moose::Meta::TypeConstraint::Parameterizable->new( - name => 'HashRef', - package_defined_in => __PACKAGE__, - parent => find_type_constraint('Ref'), - constraint => sub { ref($_) eq 'HASH' }, - optimized => - \&Moose::Util::TypeConstraints::OptimizedConstraints::HashRef, - constraint_generator => sub { - my $type_parameter = shift; - my $check = $type_parameter->_compiled_type_constraint; - return sub { - foreach my $x ( values %$_ ) { - ( $check->($x) ) || return; - } - 1; - } - } - ) -); - -$REGISTRY->add_type_constraint( - Moose::Meta::TypeConstraint::Parameterizable->new( - name => 'Maybe', - package_defined_in => __PACKAGE__, - parent => find_type_constraint('Item'), - constraint => sub {1}, - constraint_generator => sub { - my $type_parameter = shift; - my $check = $type_parameter->_compiled_type_constraint; - return sub { - return 1 if not( defined($_) ) || $check->($_); - return; - } - } - ) -); +require Moose::Util::TypeConstraints::Builtins; +Moose::Util::TypeConstraints::Builtins::define_builtins($REGISTRY); my @PARAMETERIZABLE_TYPES = map { $REGISTRY->get_type_constraint($_) } qw[ScalarRef ArrayRef HashRef Maybe]; @@ -822,32 +727,36 @@ sub _throw_error { 1; +# ABSTRACT: Type constraint system for Moose + __END__ =pod -=head1 NAME - -Moose::Util::TypeConstraints - Type constraint system for Moose - =head1 SYNOPSIS use Moose::Util::TypeConstraints; - subtype 'Natural' - => as 'Int' - => where { $_ > 0 }; + subtype 'Natural', + as 'Int', + where { $_ > 0 }; + + subtype 'NaturalLessThanTen', + as 'Natural', + where { $_ < 10 }, + message { "This number ($_) is not less than ten!" }; + + coerce 'Num', + from 'Str', + via { 0+$_ }; - subtype 'NaturalLessThanTen' - => as 'Natural' - => where { $_ < 10 } - => message { "This number ($_) is not less than ten!" }; + class_type 'DateTimeish', { class => 'DateTime' }; - coerce 'Num' - => from 'Str' - => via { 0+$_ }; + role_type 'Barks', { role => 'Some::Library::Role::Barks' }; - enum 'RGBColors' => qw(red green blue); + enum 'RGBColors', [qw(red green blue)]; + + union 'StringOrArray', [qw( String Array )]; no Moose::Util::TypeConstraints; @@ -889,7 +798,7 @@ this, as well as future proof your subtypes from classes which have yet to have been created, is to quote the type name: use DateTime; - subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') }; + subtype 'DateTime', as 'Object', where { $_->isa('DateTime') }; =head2 Default Type Constraints @@ -915,7 +824,7 @@ that hierarchy represented visually. CodeRef RegexpRef GlobRef - FileHandle + FileHandle Object B Any type followed by a type parameter C<[`a]> can be @@ -960,7 +869,7 @@ I instead. This module can play nicely with other constraint modules with some slight tweaking. The C clause in types is expected to be a -C reference which checks it's first argument and returns a +C reference which checks its first argument and returns a boolean. Since most constraint modules work in a similar way, it should be simple to adapt them to work with Moose. @@ -968,21 +877,21 @@ For instance, this is how you could use it with L to declare a completely new type. type 'HashOfArrayOfObjects', - { - where => IsHashRef( - -keys => HasLength, - -values => IsArrayRef(IsObject) - ) - }; - -For more examples see the F test + where { + IsHashRef( + -keys => HasLength, + -values => IsArrayRef(IsObject) + )->(@_); + }; + +For more examples see the F test file. -Here is an example of using L and it's non-test +Here is an example of using L and its non-test related C function. - type 'ArrayOfHashOfBarsAndRandomNumbers' - => where { + type 'ArrayOfHashOfBarsAndRandomNumbers', + where { eq_deeply($_, array_each(subhashof({ bar => isa('Bar'), @@ -991,7 +900,23 @@ related C function. }; For a complete example see the -F test file. +F test file. + +=head2 Error messages + +Type constraints can also specify custom error messages, for when they fail to +validate. This is provided as just another coderef, which receives the invalid +value in C<$_>, as in: + + subtype 'PositiveInt', + as 'Int', + where { $_ > 0 }, + message { "$_ is not a positive integer!" }; + +If no message is specified, a default message will be used, which indicates +which type constraint was being used and what value failed. If +L (version 0.14 or higher) is installed, it will be used to +display the invalid value, otherwise it will just be printed as is. =head1 FUNCTIONS @@ -1005,7 +930,7 @@ See the L for an example of how to use these. =over 4 -=item B<< subtype 'Name' => as 'Parent' => where { } ... >> +=item B<< subtype 'Name', as 'Parent', where { } ... >> This creates a named subtype. @@ -1021,7 +946,7 @@ name and a hashref of parameters: The valid hashref keys are C (the parent), C, C, and C. -=item B<< subtype as 'Parent' => where { } ... >> +=item B<< subtype as 'Parent', where { } ... >> This creates an unnamed subtype and will return the type constraint meta-object, which will be an instance of @@ -1038,11 +963,31 @@ just a hashref of parameters: Creates a new subtype of C with the name C<$class> and the metaclass L. + # Create a type called 'Box' which tests for objects which ->isa('Box') + class_type 'Box'; + +Additionally, you can create a class_type which is a shorthand for another class. + + # Create a type called 'Box' which tests for objects which ->isa('ObjectLibrary::Box'); + class_type 'Box', { class => 'ObjectLibrary::Box' }; + +But it's only really necessary to do this if you're working with L. + =item B Creates a C type constraint with the name C<$role> and the metaclass L. + # Create a type called 'Walks' which tests for objects which ->does('Walks') + role_type 'Walks'; + +Additionally, you can create a role_type which is a shorthand for another role. + + # Create a type called 'Walks' which tests for objects which ->does('MooseX::Role::Walks'); + role_type 'Walks', { role => 'MooseX::Role::Walks' }; + +But it's only really necessary to do this if you're working with L. + =item B Creates a type constraint for either C or something of the @@ -1089,6 +1034,33 @@ can then be used in an attribute definition like so: isa => enum([qw[ ascending descending ]]), ); +=item B + +This will create a basic subtype where any of the provided constraints +may match in order to satisfy this constraint. + +=item B + +If passed an ARRAY reference as the only parameter instead of the +C<$name>, C<\@constraints> pair, this will create an unnamed union. +This can then be used in an attribute definition like so: + + has 'items' => ( + is => 'ro', + isa => union([qw[ Str ArrayRef ]]), + ); + +This is similar to the existing string union: + + isa => 'Str|ArrayRef' + +except that it supports anonymous elements as child constraints: + + has 'color' => ( + isa => 'ro', + isa => union([ 'Int', enum([qw[ red green blue ]]) ]), + ); + =item B This is just sugar for the type constraint construction syntax. @@ -1113,17 +1085,47 @@ constraint fails, then the code block is run with the value provided in C<$_>. This reference should return a string, which will be used in the text of the exception thrown. +=item B + +This can be used to define a "hand optimized" inlinable version of your type +constraint. + +You provide a subroutine which will be called I on a +L object. It will receive a single parameter, the +name of the variable to check, typically something like C<"$_"> or C<"$_[0]">. + +The subroutine should return a code string suitable for inlining. You can +assume that the check will be wrapped in parentheses when it is inlined. + +The inlined code should include any checks that your type's parent types +do. For example, the C type's inlining sub looks like this: + + sub { + 'defined(' . $_[1] . ')' + . ' && !ref(' . $_[1] . ')' + } + +Note that it checks if the variable is defined, since it is a subtype of +the C type. However, to avoid repeating code, this can be optimized as: + + sub { + $_[0]->parent()->_inline_check($_[1]) + . ' && !ref(' . $_[1] . ')' + } + =item B +B instead.> + This can be used to define a "hand optimized" version of your type constraint which can be used to avoid traversing a subtype constraint hierarchy. -B You should only use this if you know what you are doing, -all the built in types use this, so your subtypes (assuming they +B You should only use this if you know what you are doing. +All the built in types use this, so your subtypes (assuming they are shallow) will not likely need to use this. -=item B<< type 'Name' => where { } ... >> +=item B<< type 'Name', where { } ... >> This creates a base type, which has no parent. @@ -1133,7 +1135,7 @@ parameters: type( 'Foo', { where => ..., message => ... } ); -The valid hashref keys are C, C, and C. +The valid hashref keys are C, C, and C. =back @@ -1222,11 +1224,17 @@ See the L for an example of how to use these. =over 4 -=item B<< coerce 'Name' => from 'OtherName' => via { ... } >> +=item B<< coerce 'Name', from 'OtherName', via { ... } >> This defines a coercion from one type to another. The C argument is the type you are coercing I. +To define multiple coercions, supply more sets of from/via pairs: + + coerce 'Name', + from 'OtherName', via { ... }, + from 'ThirdName', via { ... }; + =item B This is just sugar for the type coercion construction syntax. @@ -1273,6 +1281,8 @@ form. This removes any whitespace in the string. =item B +=item B + This can take a union type specification like C<'Int|ArrayRef[Int]'>, or a list of names. It returns a new L object. @@ -1330,7 +1340,7 @@ global registry. =item B These functions will first call C. If -that function does not return a type, a new anonymous type object will +that function does not return a type, a new type object will be created. The C variant will use C and the @@ -1374,17 +1384,4 @@ Adds C<$type> to the list of parameterizable types See L for details on reporting bugs. -=head1 AUTHOR - -Stevan Little Estevan@iinteractive.comE - -=head1 COPYRIGHT AND LICENSE - -Copyright 2006-2010 by Infinity Interactive, Inc. - -L - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - =cut