view release on metacpan or  search on metacpan

lib/Regexp/Debugger.pm  view on Meta::CPAN

    if (index($msg,'forgetting') >= 0 || index($msg,'Forgetting') >= 0) {
        return \&_info_colourer;
    }
    if (index($msg,'try') >= 0 || index($msg,'Try') >= 0) {
        return \&_try_colourer;
    }
    if (index($msg,'failed') >= 0 || index($msg,'Failed') >= 0) {
        return \&_fail_colourer;
    }
    if (index($msg,'matched') >= 0 || index($msg,'Matched') >= 0) {
        return \&_match_colourer;
    }
    return \&_info_colourer;
}

# Set up interaction as spiffily as possible...

if (eval{ require Term::ReadKey }) {
    *_interact = sub {
        # No interactions when piping output to a filehandle...
        return 'c' if $lexical_config->{save_to_fh};

        # Otherwise grab a single key and return it...
        Term::ReadKey::ReadMode('raw');
        my $input = Term::ReadKey::ReadKey(0);
        Term::ReadKey::ReadMode('restore');
        return $input;
    }
}
else {
    *_interact = sub {
        # No interactions when piping output to a filehandle...
        return 'c' if $lexical_config->{save_to_fh};

        # Otherwise return the first letter typed...
        my $input = readline;
        return substr($input, 0, 1);
    }
}


#====[ REPL (a.k.a. rxrx) ]=======================

# Deal with v5.16 weirdness...
BEGIN {
    if ($] >= 5.016) {
        require feature;
        feature->import('evalbytes');
        *evaluate = \&CORE::evalbytes;
    }
    else {
        *evaluate = sub{ eval shift };
    }
}

my $FROM_START = 0;

sub rxrx {
    # Handle: rxrx <filename>
    if (@_) {
        local @ARGV = @_;

        # If file is a debugger dump, decode and step through it...
        my $filetext = do { local $/; <> };
        my $dumped_data = eval { $JSON_decoder->($filetext) };
        if (ref($dumped_data) eq 'HASH' && defined $dumped_data->{regex_ID} ) {
            # Reconstruct internal state...
            my $regex_ID                = $dumped_data->{regex_ID};
            %history_of                 = %{ $dumped_data->{visualization} };
            $history_of{match_heatmap}  = $dumped_data->{match_heatmap};
            $history_of{string_heatmap} = $dumped_data->{string_heatmap};
            $display_mode               = $dumped_data->{config}{display_mode};
            $state{$regex_ID}{location} = $dumped_data->{regex_location};

            # Display...
            my $step = $FROM_START;
            my $cmd;
            while (1) {
                ($cmd, $step) = _revisualize($regex_ID, '-', $step);
                last if lc($cmd) eq 'q';
                $step = min($step, @{$history_of{visual}}-1);
            }
            exit;
        }

        # Otherwise, assume it's a perl source file and debug it...
        else {
            exec $^X, '-MRegexp::Debugger', @_
                or die "Couldn't invoke perl: $!";
        }
    }

    # Otherwise, be interactive...

    # Track input history...
    my $str_history   = [];
    my $regex_history = [];

    # Start with empty data...
    my $input_regex = '';
    my $regex       = '';
    my $regex_flags = '';
    my $string      = '';

    # And display it...
    _display($string, $input_regex,q{});

    INPUT:
    while (1) {
        my $input = _prompt('>');

        # String history mode?
        if ($input =~ /^['"]$/) {
            $input = _rxrx_history($str_history);
        }

        # Regex history mode?
        elsif ($input eq '/') {
            $input = _rxrx_history($regex_history);
        }