view release on metacpan or  search on metacpan

lib/FP/Repl/Repl.pm  view on Meta::CPAN

            # (no sorting necessary)

            return $term->completion_matches($text,
                $attribs->{list_completion_function})
        } else {

            # restore defaults.
            $attribs->{completion_append_character} = " ";
            return ()
        }
    }
}

our $clear_history = do {
    my $did = 0;
    sub {
        my ($term) = @_;

        # Term::ReadLine::Perl does not have clear_history, so, wrap
        # it. ->can doesn't work either (lazy loading?), so:
        eval {
            $term->clear_history;
            1
        } || do {
            warn $@ . "install Term::ReadLine::Gnu if you can" unless $did++;
        }
    }
};

our ($maybe_input, $maybe_output);    # dynamic parametrization of
                                      # filehandles

our $repl_level;    # maybe number of repl layers above
our $args;          # see '$FP::Repl::Repl::args' in help text
our $argsn;         # see '$FP::Repl::Repl::argsn' in help text

# TODO: split this monstrosity into pieces.
sub run {
    my ($self, $maybe_skip) = @_;

    my $skip  = $maybe_skip // 0;
    my $stack = FP::Repl::StackPlus->get($skip + 1);

    local $repl_level = ($repl_level // -1) + 1;

    my $frameno = 0;

    my $get_package = sub {

        # (What is $$self[Maybe_package] for? Can set the maybe_prompt
        # independently. Security feature or just overengineering?
        # Ok, remember the ":p" setting; but why not use a lexical
        # within `run`? Ok how long-lived are the repl objects, same
        # duration? Then hm is the only reason for the object to be
        # able to set up things explicitely first? Thus is it ok after
        # all?)
        my $r = $$self[Maybe_package] || $stack->package($frameno);
        $r
    };

    my $oldsigint = $SIG{INT};
    eval {
        local $SIG{__DIE__};

        # It seems this is the only way to make signal handlers work in
        # both perl 5.6 and 5.8:
        sigaction SIGINT,
            POSIX::SigAction->new(__PACKAGE__ . '::__signalhandler')
            or die "Error setting SIGINT handler: $!\n";
        1
    } || do {
        if ($^O eq 'MSWin32') {

            # XX will that work?
            $SIG{INT} = \&__signalhandler;
        } else {
            warn "could not set up signal handler: $@ ";
        }
    };

    {
        local $SIG{__DIE__};
        require Term::ReadLine;
    }

    # only start one readline instance, do not nest (doing otherwise
    # seems to lead to segfaults). okay?.
    local our $term = $term || Term::ReadLine->new('Repl');

    # This means that the history from nested repls will also show up
    # in the history of the parent repl. Not saved, but within the
    # readline instance. (Correct?)
    # XX: idea: add nesting level to history filename?

    my $attribs = $term->Attribs;

    my ($INPUT, $OUTPUT, $ERROR) = do {
        my $tty = lazy {maybe_tty};
        my $in  = $self->maybe_input // $maybe_input // force($tty) // $term->IN
            // *STDIN;
        my $out = $self->maybe_output // $maybe_output // force($tty)
            // $term->OUT // *STDOUT;
        $term->newTTY($in, $out);
        ($in, $out, $out)
    };

    # carry over input/output to subshells:
    local $maybe_input  = $INPUT;
    local $maybe_output = $OUTPUT;

    my $printerror_frameno = sub {
        my $max = $stack->max_frameno;
        print $ERROR "frame number must be between 0..$max",
            (@_ ? ", got @_" : ()), "\n";
    };

    my ($view_with_port, $view_string) = $self->viewers($OUTPUT, $ERROR);

    {
        my @history;
        local $current_history = \@history;

lib/FP/Repl/Repl.pm  view on Meta::CPAN

                                        (defined blessed $error)
                                            && $error->can("plain")
                                        ?

                                            # error in plaintext; XX:
                                            # change to better
                                            # thought-out protocol?
                                            $error->plain
                                        : show($error)
                                    );
                                    chomp $err;
                                    $err . "\n"
                                        ; # no prefix? no safe way to differentiate.
                                } else {
                                    if (my $varname
                                        = $$self[Maybe_keepResultIn])
                                    {
                                        $varname
                                            = &$get_package() . "::$varname"
                                            unless $varname =~ /::/;
                                        no strict 'refs';
                                        $$varname
                                            = $self->mode_context eq "1"
                                            ? $$results[0]
                                            : $results;
                                    }
                                    &$format_vals(@$results)
                                }
                            }
                        );
                        $maybe_kept_results = $results
                            if $$self[DoKeepResultsInVARX];
                    };

                    &$evaluator();

                } elsif ($$self[DoRepeatWhenEmpty]) {
                    &$evaluator();
                } else {
                    next;
                }

                if (length $input
                    and ((!defined $history[-1]) or $history[-1] ne $input))
                {
                    # XX this is, now that entries are written to disk
                    # immediately, only used for nested repls (see
                    # todo above)
                    push @history, $input;
                    chomp $input;
                    $term->addhistory($input);

                    #splice @history,0,@history-$$self[MaxHistLen] = ();
                    if ($$self[MaxHistLen] >= 0) {    # <-prevent endless loop
                        shift @history while @history > $$self[MaxHistLen];
                    }
                }
            }
        }
        print $OUTPUT "\n";
        $SIG{INT} = defined($oldsigint) ? $oldsigint : "DEFAULT";

        # (Is there no other return path from sub run? should I use
        # DESTROY objects for this? -> nope, no returns, but if
        # exceptions not trapped it would fail)
    }

    # restore previous history, if any
    if ($current_history) {
        $clear_history->($term);
        for (@$current_history) {
            chomp;
            $term->addhistory($_);
        }
    }
}

end Chj::Class::Array;

# for backwards compatibility:
*set_maxhistlen         = *set_maxHistLen{CODE};
*set_docatchint         = *set_doCatchINT{CODE};
*set_dorepeatwhenempty  = *set_doRepeatWhenEmpty{CODE};
*set_maybe_keepresultin = *set_maybe_keepResultIn{CODE};