view release on metacpan or  search on metacpan

sersh  view on Meta::CPAN

#!/usr/bin/env perl

use strict;
use warnings;
use 5.010;

use AnyEvent;
use AnyEvent::SerialPort;
use AnyEvent::ReadLine::Gnu;
use Path::Class qw(file dir);
use File::HomeDir;
use Getopt::Long;
use Pod::Usage;

our $VERSION = '0.01';

my $HISTSIZE_MAX = $ENV{HISTSIZE} // 1000;

exit main() unless caller();

sub main {
    my ($help);
    my $serial_fn = '/dev/ttyUSB0';
    my $baudrate  = 19200;
    my $parity    = 'none';
    my $databits  = 8;
    my $stopbits  = 1;
    my $handshake = 'none';
    GetOptions(
        'baudrate|b=s'  => \$baudrate,
        'parity|p=s'    => \$parity,
        'databits|d=s'  => \$databits,
        'stopbits|s=s'  => \$stopbits,
        'handshake|s=s' => \$handshake,
        'help|h'        => \$help,
    ) or pod2usage(1);
    pod2usage(0) if $help;

    if (@ARGV) {
        pod2usage('too many arguments') if @ARGV > 1;
        ($serial_fn) = @ARGV;
    }

    pod2usage('invalid baudrate')
        if ($baudrate !~ m{^\d+$});
    pod2usage('invalid parity')
        if ($parity !~ m{^(?:none|odd|even)$});
    pod2usage('invalid databits')
        if ($databits !~ m{^[5-8]$});
    pod2usage('invalid stopbits')
        if ($stopbits !~ m{^[1-2]$});
    pod2usage('invalid handshake')
        if ($handshake !~ m{^(?:none|rts|xoff)$});

    # read & truncate history lines
    my $cfg_dir = dir(File::HomeDir->my_home, '.config', 'sersh');
    if (!-d $cfg_dir) {
        $cfg_dir->mkpath or die 'failed to create "' . $cfg_dir . '": $!';
    }
    my $hist_file      = $cfg_dir->file('.sersh_history');
    my @histfile_lines = $hist_file->slurp();
    if (@histfile_lines > $HISTSIZE_MAX) {
        splice(@histfile_lines, 0, (@histfile_lines - $HISTSIZE_MAX));
        $hist_file->spew(\@histfile_lines);
    }
    @histfile_lines = map {chomp($_); $_;} @histfile_lines;

    my $run_cv        = AnyEvent->condvar;
    my $prompt_prefix = $serial_fn . "> ";

    my $serial_ae = AnyEvent::SerialPort->new(
        serial_port => [
            $serial_fn,
            [baudrate  => $baudrate],
            [parity    => $parity],
            [databits  => $databits],
            [stopbits  => $stopbits],
            [handshake => $handshake],
        ],