view release on metacpan or  search on metacpan

lib/Term/Scroller.pm  view on Meta::CPAN

displayed inside the window. If this is set, it will override any color
escape sequences in the input text. This can be a raw escape sequence (e.g
"\033[2m" for faded text) or a constant from the L<Term::ANSIColor> module.
(B<Default>: undef).

=item * B<window>

A string specifying the characters to use when drawing a border around the
window. See the B<WINDOW DRAWING> section for how to create a border
specification. The documentation for L<scroller> also has some examples you
can copy from. (B<Default>: undef, so no borders, if only we could live
in such a world)

=back

=head3 Control Options

=over 4

=item * B<out>

Filehandle to write/draw the window to. Naturally, this should be connected to
a terminal. (B<Default>: the currently selected filehandle, so C<STDOUT> unless
you selected something else first).

=item * B<hide>

If true, the window will be erased once its done (i.e. once you close the
input filehandle). Otherwise, the window remains with the last lines of text
still visible. (B<Default>: False).

=item * B<passthrough>

If this is an open filehandle, input text will also be passed through to this
filehandle completely unaltered. Useful if you want a record of all the text
that went through the window.

=back

=cut

sub new {
    my $class = shift;

    my %params = @_;
    my $outfh       = $params{out}          // qualify_to_ref(select);
    my $buf_height  = $params{height}       // 10;
    my $buf_width   = $params{width}        // (GetTerminalSize $outfh)[0] // 80;
    my $tab_width   = $params{tabwidth}     // 4;
    my $style       = $params{style};
    my $windowspec  = $params{window};
    my $hide        = $params{hide}         // 0;
    my $passthru    = $params{passthrough};

    my $pty     = IO::Pty->new;

    defined(my $pid = fork)     or croak "unable to fork: $!";

    # Parent: Return the new scroller
    if ($pid) {
        bless $pty => $class;
        ${*$pty}{'term_scroller_pid'} = $pid;
        return $pty;
    }

    ################################################
    # Forked child: reads pty and writes to output
    ################################################

    close $pty;
    select $outfh;

    my @buf;

    my $tab = " "x$tab_width;

    # Parse window
    my $line_end   = "";
    my $line_start = "";
    my $window_top;
    my $window_bot;
    my $window_extra_height = 0; # Height of window top + bottom

    if (defined $windowspec) {
        my %window  = _parse_window_spec($windowspec);
        $line_start = $window{left}  // "";
        $line_end   = $window{right} // "";

        if ($window{hastop}) {
            $window_extra_height++;
            $window_top = ( $window{topleft}  // " " ) .
                          ( $window{top}      // " " ) x ($buf_width-2) .
                          ( $window{topright} // " " );
        }
        if ($window{hasbot}) {
            $window_extra_height++;
            $window_bot = ( $window{botleft}  // " " ) .
                          ( $window{bot}      // " " ) x ($buf_width-2) .
                          ( $window{botright} // " " );
        }

        $buf_width -= ( length($line_start) + length($line_end) );
    }

    my $firstline = 1;

    while (my $line = linefeed($pty)) {

        print $passthru $line if openhandle($passthru);

        if ($firstline) {
            print "$window_top\n" if defined $window_top;
            print "$window_bot\n" if defined $window_bot;
            $firstline = 0;
        }

        chomp $line;
        $line =~ s/\t/$tab/g;
        my $to_print = "";

        if (defined $style) {