view release on metacpan or  search on metacpan

lib/Switch/Right.pm  view on Meta::CPAN

            $BLOCK = _augment_block(given => "$BLOCK", $JUNC);

            # Topicalize the "given" argument...
            $EXPR = _apply_term_magic($EXPR);
            substr($BLOCK, 1, 0) = qq{local *_ = \\($EXPR);};

            # Implement "given" as a (trivial) "if" block...
            $REPLACEMENT_CODE = qq{ if (1) $BLOCK };

            # At what line should the "given" end???
            my $end_line = (caller)[2] + $GIVEN =~ tr/\n//;

            # Append the trailing code (at the right line number)...
            $REPLACEMENT_CODE .= "\n#line $end_line\n$TRAILING_CODE";
        }

        # Otherwise, report the error in context...
        elsif (exists $result{EXPR}) {
            $REPLACEMENT_CODE = q{ BEGIN { warn  q{Invalid code somewhere in "given" block starting} } }
                            . q{ BEGIN { warn qq{(Note: the error reported below may be misleading)\\n}}}
                            . qq{ if ${$source_ref} };

lib/Switch/Right.pm  view on Meta::CPAN

        # Is the current "given" junctive???
        my $given_junc = $^H{'Switch::Right/GivenJunctive'} // q{};

        # Implement the "when" as an "if"...
        $REPLACEMENT_CODE = qq{if(1)\{local \$Switch::Right::when_value = }
                          . qq{smartmatch($given_junc \$_, $JUNC scalar($EXPR));}
                          . qq{if(1){if (\$Switch::Right::when_value) $BLOCK }\}};

        # At what line should the "when" end???
        my $end_line = (caller)[2] + $WHEN =~ tr/\n//;

        # Append the trailing code (at the right line number)...
        $REPLACEMENT_CODE .= "\n#line $end_line\n$TRAILING_CODE";
    }

    # Otherwise, reject the "when" with extreme prejudice...
    elsif (defined $matched{MODIFIER}) {
        $REPLACEMENT_CODE = qq{ BEGIN { die q{Can't specify postfix "when" modifier outside a "given"} } };
    }
    elsif (exists $matched{INVALID_BLOCK}) {

lib/Switch/Right.pm  view on Meta::CPAN

    # Implement the "default" block...
    if (defined $matched{BLOCK}) {
        # Install the necessary extras...
        my $BLOCK = _augment_block(default => $matched{BLOCK});

        # Build the implementation of the "default"...
        my $REPLACEMENT_CODE = qq{ if (1) $BLOCK };

        # At what line should the "default" end???
        my $end_line = (caller)[2] + $matched{DEFAULT} =~ tr/\n//;

        # Append the trailing code (at the right line number)...
        ${$source_ref} = "$REPLACEMENT_CODE\n#line $end_line\n$matched{TRAILING_CODE}";
    }

    # Report the error...
    else {
        ${$source_ref}
            = qq{ BEGIN { die q{Incomprehensible "default" (near: $matched{INCOMPREHENSIBLE})} } };
    }