File Coverage

blib/lib/PPIx/Regexp/Constant.pm

Criterion	Covered	Total	%
statement	142	145	97.9
branch	6	10	60.0
condition	3	6	50.0
subroutine	51	54	94.4
pod			n/a
total	202	215	93.9

package PPIx::Regexp::Constant;

# Yes, I know this is horrible style. But I need a separate package for
# overloading to work, and I do *NOT* want stray files lying around if I
# end up ditching this mess.
package PPIx::Regexp::Constant::Inf;	## no critic (ProhibitMultiplePackages)

use 5.006;

use strict;
use warnings;

use Carp;
use Scalar::Util qw{ refaddr };

our $VERSION = '0.087';

use overload
    # Arithmetic
    '+'		=> \&__preserve,
    '-'		=> \&__subtract,
    '*'		=> \&__preserve,
    neg		=> \&__err_neg_inf,
    # Comparison
    '<=>'	=> \&__space_ship,
    cmp		=> \&__cmp,
    # Conversion
    '""'	=> \&__stringify,
    '0+'	=> \&__stringify,	# For looks_like_number
    bool	=> \&__bool,
    # Catch all
    nomethod	=> \&__bug_unimplemented,
    ;

{
    my $inf;

    # Scheduled block because __pos_inf() can be called at compile time.
    BEGIN {
	$inf = bless( \( my $x = 1 ), __PACKAGE__ );
    }

    sub __pos_inf { return $inf }

    sub __is_inf { return ref $_[0] && refaddr( $_[0] ) == refaddr( $inf ) }
}

sub __bool { return 1 }

sub __bug_unimplemented {
    confess "Bug - Operation '$_[3]' is unimplemented";
}

sub __cmp {
    my ( $x, $y, $swap ) = @_;
    $swap
	and return "$y" cmp "$x";
    return "$x" cmp "$y";
}

sub __err_nan {
    croak 'NaN not supported';
}

sub __err_neg_inf {
    croak 'Negative infinity not supported';
}

# Any operation that does not change the value
sub __preserve { return $_[0] };

sub __space_ship {
    my ( undef, $y, $swap ) = @_;	# We don't need our invocant
    # Infinity is equal to itself
    __is_inf( $y )
	and return 0;
    # Any number is less than infinity
    $swap
	and return -1;
    # Infinity is greater than any number
    return 1;
}

sub __stringify {
    return 'Inf';
}

sub __subtract {
    my ( $x, $y, $swap ) = @_;
    __is_inf( $y )
	and __err_nan();	# Which croaks
    $swap
	and __err_neg_inf();	# Which croaks
    return $x;
}

1;

package PPIx::Regexp::Constant;	## no critic (ProhibitMultiplePackages)

use strict;
use warnings;

use base qw{ Exporter };

# CAVEAT: do not include any other PPIx-Regexp modules in this one, or
# you will end up with a circular dependency.

our $VERSION = '0.085_04';

our @EXPORT_OK = qw{
    ARRAY_REF
    CODE_REF
    COOKIE_CLASS
    COOKIE_LOOKAROUND_ASSERTION
    COOKIE_QUANT
    COOKIE_QUOTE
    COOKIE_REGEX_SET
    FALSE
    HASH_REF
    INFINITY
    LITERAL_LEFT_CURLY_ALLOWED
    LITERAL_LEFT_CURLY_REMOVED_PHASE_1
    LITERAL_LEFT_CURLY_REMOVED_PHASE_2
    LITERAL_LEFT_CURLY_REMOVED_PHASE_3
    LOCATION_LINE
    LOCATION_CHARACTER
    LOCATION_COLUMN
    LOCATION_LOGICAL_LINE
    LOCATION_LOGICAL_FILE
    MINIMUM_PERL
    MODIFIER_GROUP_MATCH_SEMANTICS
    MSG_LOOK_BEHIND_TOO_LONG
    MSG_PROHIBITED_BY_STRICT
    NODE_UNKNOWN
    RE_CAPTURE_NAME
    REGEXP_REF
    SCALAR_REF
    STRUCTURE_UNKNOWN
    SUFFICIENT_UTF8_SUPPORT_FOR_WEIRD_DELIMITERS
    TOKEN_LITERAL
    TOKEN_UNKNOWN
    TRUE
    VARIABLE_LENGTH_LOOK_BEHIND_INTRODUCED
    @CARP_NOT
};

our @CARP_NOT = qw{
    PPIx::Regexp
    PPIx::Regexp::Constant
    PPIx::Regexp::Dumper
    PPIx::Regexp::Element
    PPIx::Regexp::Lexer
    PPIx::Regexp::Node
    PPIx::Regexp::Node::Range
    PPIx::Regexp::Node::Unknown
    PPIx::Regexp::Structure
    PPIx::Regexp::Structure::Assertion
    PPIx::Regexp::Structure::Atomic_Script_Run
    PPIx::Regexp::Structure::BranchReset
    PPIx::Regexp::Structure::Capture
    PPIx::Regexp::Structure::CharClass
    PPIx::Regexp::Structure::Code
    PPIx::Regexp::Structure::Main
    PPIx::Regexp::Structure::Modifier
    PPIx::Regexp::Structure::NamedCapture
    PPIx::Regexp::Structure::Quantifier
    PPIx::Regexp::Structure::RegexSet
    PPIx::Regexp::Structure::Regexp
    PPIx::Regexp::Structure::Replacement
    PPIx::Regexp::Structure::Script_Run
    PPIx::Regexp::Structure::Subexpression
    PPIx::Regexp::Structure::Switch
    PPIx::Regexp::Structure::Unknown
    PPIx::Regexp::Support
    PPIx::Regexp::Token
    PPIx::Regexp::Token::Assertion
    PPIx::Regexp::Token::Backreference
    PPIx::Regexp::Token::Backtrack
    PPIx::Regexp::Token::CharClass
    PPIx::Regexp::Token::CharClass::POSIX
    PPIx::Regexp::Token::CharClass::POSIX::Unknown
    PPIx::Regexp::Token::CharClass::Simple
    PPIx::Regexp::Token::Code
    PPIx::Regexp::Token::Comment
    PPIx::Regexp::Token::Condition
    PPIx::Regexp::Token::Control
    PPIx::Regexp::Token::Delimiter
    PPIx::Regexp::Token::Greediness
    PPIx::Regexp::Token::GroupType
    PPIx::Regexp::Token::GroupType::Assertion
    PPIx::Regexp::Token::GroupType::Atomic_Script_Run
    PPIx::Regexp::Token::GroupType::BranchReset
    PPIx::Regexp::Token::GroupType::Code
    PPIx::Regexp::Token::GroupType::Modifier
    PPIx::Regexp::Token::GroupType::NamedCapture
    PPIx::Regexp::Token::GroupType::Script_Run
    PPIx::Regexp::Token::GroupType::Subexpression
    PPIx::Regexp::Token::GroupType::Switch
    PPIx::Regexp::Token::Interpolation
    PPIx::Regexp::Token::Literal
    PPIx::Regexp::Token::Modifier
    PPIx::Regexp::Token::NoOp
    PPIx::Regexp::Token::Operator
    PPIx::Regexp::Token::Quantifier
    PPIx::Regexp::Token::Recursion
    PPIx::Regexp::Token::Reference
    PPIx::Regexp::Token::Structure
    PPIx::Regexp::Token::Unknown
    PPIx::Regexp::Token::Unmatched
    PPIx::Regexp::Token::Whitespace
    PPIx::Regexp::Tokenizer
    PPIx::Regexp::Util
};

use constant COOKIE_CLASS	=> ']';
use constant COOKIE_QUANT	=> '}';
use constant COOKIE_QUOTE	=> '\\E';
use constant COOKIE_REGEX_SET	=> '])';
use constant COOKIE_LOOKAROUND_ASSERTION	=> 'lookaround';

use constant FALSE		=> 0;
use constant TRUE		=> 1;

# This hack is because it appears that Strawberry Perl evaluates 0 +
# 'inf' as zero under Perl 5.12.3 and below. But the real problem is
# from a pure portability standpoint I can not count on IEEE 754 being
# in use. So if 0 + 'Inf' (documented in perldata) is zero or an error I
# fall back to an object that mimics its behavior to the extent I think
# I need.
# NOTE that the only way I have to test the ::Inf object is to comment
# out the eval{} code. This is ugly, but I can not think of anything
# better.
BEGIN {
    local $@ = undef;
    require constant;
    constant->import( INFINITY =>
	eval { 0 + 'Inf' } ||
	PPIx::Regexp::Constant::Inf->__pos_inf() );
}

use constant ARRAY_REF		=> ref [];
use constant CODE_REF		=> ref sub {};
use constant HASH_REF		=> ref {};
use constant REGEXP_REF		=> ref qr{};
use constant SCALAR_REF		=> ref \0;

# In the cases where an unescaped literal left curly 'could not' be a
# quantifier, they are allowed. At least, that was the original idea.
# But read on.
use constant LITERAL_LEFT_CURLY_ALLOWED		=> undef;

# 'Most' unescaped literal left curlys were removed in 5.26.
use constant LITERAL_LEFT_CURLY_REMOVED_PHASE_1	=> '5.025001';

# Unescaped literal left curlys after literals and certain other
# elements are scheduled to be removed in 5.30.
use constant LITERAL_LEFT_CURLY_REMOVED_PHASE_2	=> undef;	# x{ 5.30

# In 5.27.8 it was decided that unescaped literal left curlys after an
# open paren will be removed in 5.32. This does not include the case
# where the entire regex is delimited by parens -- they are still legal
# there.
use constant LITERAL_LEFT_CURLY_REMOVED_PHASE_3	=> undef;	# ({ 5.32

# Location constants. Must align with PPI
use constant LOCATION_LINE         => 0;
use constant LOCATION_CHARACTER    => 1;
use constant LOCATION_COLUMN       => 2;
use constant LOCATION_LOGICAL_LINE => 3;
use constant LOCATION_LOGICAL_FILE => 4;

use constant MINIMUM_PERL	=> '5.000';

use constant MODIFIER_GROUP_MATCH_SEMANTICS => 'match_semantics';

use constant MSG_LOOK_BEHIND_TOO_LONG	=>
    'Lookbehind longer than 255 not implemented';
use constant MSG_PROHIBITED_BY_STRICT	=>
    q;

use constant NODE_UNKNOWN	=> 'PPIx::Regexp::Node::Unknown';

# The perlre for Perl 5.010 says:
#
#      Currently NAME is restricted to simple identifiers only.  In
#      other words, it must match "/^[_A-Za-z][_A-Za-z0-9]*\z/" or
#      its Unicode extension (see utf8), though it isn't extended by
#      the locale (see perllocale).

use constant RE_CAPTURE_NAME => ' [_[:alpha:]] \w* ';

use constant STRUCTURE_UNKNOWN	=> 'PPIx::Regexp::Structure::Unknown';

use constant SUFFICIENT_UTF8_SUPPORT_FOR_WEIRD_DELIMITERS => $] ge '5.008003';

use constant TOKEN_LITERAL	=> 'PPIx::Regexp::Token::Literal';
use constant TOKEN_UNKNOWN	=> 'PPIx::Regexp::Token::Unknown';

use constant VARIABLE_LENGTH_LOOK_BEHIND_INTRODUCED	=> '5.029009';

1;

__END__