view release on metacpan or  search on metacpan

lib/App/BoolFindGrep/Bool.pm  view on Meta::CPAN

    $self->parse(undef);

    my @token = $self->tokenizer( $self->expression() );

    return unless $self->lazy_checker(@token);

    $self->operands_collector(@token);
    my @expression = @token;

    $self->parse( [@expression] );

    return 1;
} ## end sub parse_expr

sub tokenizer {
    my $self       = shift;
    my $expression = shift;

    my $op = join qq(\N{VERTICAL LINE}), keys %{ $self->operators() };

    my @expression;
    if ( $self->slash_as_delim() ) {
        @expression = extract_multiple(
            $expression,    #
            [ sub { extract_delimited( $_[0], '/' ) } ],    #
        );
    }
    else {
        @expression = $expression;
        $expression[0] =~ s{\N{SOLIDUS}}{\N{REVERSE SOLIDUS}\N{SOLIDUS}}gmsx;
    }

    foreach (@expression) {

        s{\A\p{IsSpace}}{}msx;
        s{\p{IsSpace}\z}{}msx;

        if (   m{\A\N{SOLIDUS}}msx
            && m{(?<!\N{REVERSE SOLIDUS})\N{SOLIDUS}\z}msx )
        {
            croak sprintf q(Syntax Error in expression: '%s'),
                $self->expression()
                if length() < 3;
            next;
        }

        s{(?<!\\)([()])}        # PARENTHESIS
         {\N{LINE FEED}$1\N{LINE FEED}}gmsx;

        s{(?:\A|\s)(${op})(?=\s|\z)}         # OPERATORS
         {\N{LINE FEED}$1\N{LINE FEED}}gimsx;

        s{\A\p{IsSpace}+}{}msx;
        s{\p{IsSpace}+\z}{}msx;

        s{\N{SPACE}*\N{LINE FEED}+\N{SPACE}*}
         {\N{LINE FEED}}gmsx;

    } ## end foreach (@expression)

    my @token = map { split m{\N{LINE FEED}}msx } @expression;
    @token = grep { defined && $_ ne q() } @token;

    foreach my $token (@token) {
        if (   $token eq qq(\N{LEFT PARENTHESIS})
            || $token eq qq(\N{RIGHT PARENTHESIS}) )
        {
            $token = [ q(PARENTHESIS), $token ];
        }
        elsif ( exists $self->operators->{uc $token} ) {
            $token = [ q(OPERATOR), uc $token ],;
        }
        else {
            if ($token =~    #
                m{\A\N{SOLIDUS}
                   (?<token>.*?)
                   (?<!\N{REVERSE SOLIDUS})\N{SOLIDUS}\z
                  }msx
                )
            {
                $token = $LAST_PAREN_MATCH{token};
            }
            $token =~ s{\N{REVERSE SOLIDUS}\N{SOLIDUS}}
                       {\N{SOLIDUS}}gmsx;

            $token = [ q(OPERAND), $token ];
        } ## end else [ if ( $token eq qq(\N{LEFT PARENTHESIS})...)]
    } ## end foreach my $token (@token)

    return @token;
} ## end sub tokenizer

sub lazy_checker {
    my $self  = shift;
    my @token = splice @_;

    my $status;

    foreach my $token (@token) {
        my ( $name, $value ) = @$token;
        if ( $name eq q(OPERAND) ) {
            $token = 1;
        }
        elsif ( $name eq q(OPERATOR) ) {
            $token = $self->operators->{$value};
        }
        else { $token = $value; }
    }

    my $expression = join qq(\N{SPACE}), @token;
    $EVAL_ERROR = q();
    eval $expression;
    if ($EVAL_ERROR) {
        croak sprintf q(Syntax Error in expression: '%s'),
            $self->expression();
    }
    else { $status = 1; }

    return $status;
} ## end sub lazy_checker