view release on metacpan or  search on metacpan

lib/Caroline.pm  view on Meta::CPAN

        %args
    }, $class;
    return $self;
}

sub debug {
    my ($self, $stuff) = @_;
    return unless $self->{debug};

#   require JSON::PP;
    open my $fh, '>>:utf8', 'caroline.debug.log';
    print $fh $stuff;
#   print $fh JSON::PP->new->allow_nonref(1)->encode($stuff) . "\n";
    close $fh;
}

sub history { shift->{history} }

sub history_len {
    my $self = shift;
    0+@{$self->{history}};
}

sub DESTROY {
    my $self = shift;
    $self->disable_raw_mode();
}

sub readline {
    my ($self, $prompt) = @_;
    $prompt = '> ' unless defined $prompt;
    STDOUT->autoflush(1);

    local $Text::VisualWidth::PP::EastAsian = is_cjk_lang;

    if ($self->is_supported && -t STDIN) {
        return $self->read_raw($prompt);
    } else {
        print STDOUT $prompt;
        STDOUT->flush;
        # I need to use ReadLine() to support Win32.
        my $line = ReadLine(0);
        $line =~ s/\n$// if defined $line;
        return $line;
    }
}

sub get_columns {
    my $self = shift;
    my ($wchar, $hchar, $wpixels, $hpixels) = GetTerminalSize();
    return $wchar;
}

sub readkey {
    my $self = shift;
    my $c = ReadKey(0);
    return undef unless defined $c;
    return $c unless $IS_WIN32;

    # Win32 API always return the bytes encoded with ACP. So it must be
    # decoded from double byte sequence. To detect double byte sequence, it
    # use Win32 API IsDBCSLeadByte.
    require Win32::API;
    require Encode;
    require Term::Encoding;
    $self->{isleadbyte} ||= Win32::API->new(
      'kernel32', 'int IsDBCSLeadByte(char a)',
    );
    $self->{encoding} ||= Term::Encoding::get_encoding();
    if ($self->{isleadbyte}->Call($c)) {
        $c .= ReadKey(0);
        $c = Encode::decode($self->{encoding}, $c);
    }
    $c;
}

# linenoiseRaw
sub read_raw {
    my ($self, $prompt) = @_;

    local $self->{sigint};
    local $self->{sigtstp};
    my $ret;
    {
        $self->enable_raw_mode();
        $ret = $self->edit($prompt);
        $self->disable_raw_mode();
    }
    print STDOUT "\n";
    STDOUT->flush;
    if ($self->{sigint}) {
        kill 'INT', $$;
    } elsif ($self->{sigtstp}) {
        kill $IS_WIN32 ? 'INT' : 'TSTP', $$;
    }
    return $ret;
}

sub enable_raw_mode {
    my $self = shift;

    if ($IS_WIN32) {
        ReadMode(5);
        return undef;
    }
    my $termios = POSIX::Termios->new;
    $termios->getattr(0);
    $self->{rawmode} = [$termios->getiflag, $termios->getoflag, $termios->getcflag, $termios->getlflag, $termios->getcc(VMIN), $termios->getcc(VTIME)];
    $termios->setiflag($termios->getiflag & ~(BRKINT | ICRNL | INPCK | ISTRIP | IXON));
    $termios->setoflag($termios->getoflag & ~(OPOST));
    $termios->setcflag($termios->getcflag | ~(CS8));
    $termios->setlflag($termios->getlflag & ~(ECHO|ICANON|IEXTEN | ISIG));
    $termios->setcc(VMIN, 1);
    $termios->setcc(VTIME, 0);
    $termios->setattr(0, TCSAFLUSH);
    return undef;
}

sub disable_raw_mode {
    my $self = shift;