Perlで学ぶ「詳解 UNIXプログラミング」(その11) 第11章 端末入出力

perl unix APUE

はじめに

「詳解 UNIXプログラミング」の第十一章を示します.

本家

http://d.hatena.ne.jp/atsuoishimoto/20110329/1301324988

11.1 割り込み文字を無効にし、ファイルの終わりの文字を変更する

PerlではC言語っぽいインタフェースでなく、OOishなインタフェースと
なります。

#!/usr/bin/env perl
use strict;
use warnings;

# 割り込み文字を無効にし、ファイルの終わりの文字を変更する

use POSIX ();

unless (POSIX::isatty(0)) {
    die "standard input is not a terminal device\n";
}

my $vdisable = POSIX::fpathconf(POSIX::STDIN_FILENO, POSIX::_PC_VDISABLE);
unless (defined $vdisable) {
    die "_POSIX_VDISABLE not in effect\n";
}

my $termios = POSIX::Termios->new;
unless ($termios->getattr(POSIX::STDIN_FILENO)) {
    die "Error: POSIX::getattr :$!\n";
}

$termios->setcc(POSIX::VINTR, $vdisable);  # disable INTR character
$termios->setcc(POSIX::VEOF, 2); # EOF is Control-B

$termios->setattr(POSIX::STDIN_FILENO, POSIX::TCSAFLUSH);

11.2 tcgetattrの例

#!/usr/bin/env perl
use strict;
use warnings;

use POSIX ();

# tcgetattrの例

my $termios = POSIX::Termios->new;
unless ($termios->getattr(POSIX::STDIN_FILENO)) {
    die "Error: POSIX::getattr :$!\n";
}

my $size = $termios->getcflag & POSIX::CSIZE;

if ($size == POSIX::CS5) {
    print "5 bits/byte\n";
} elsif ($size == POSIX::CS6) {
    print "6 bits/byte\n";
} elsif ($size == POSIX::CS7) {
    print "7 bits/byte\n";
} elsif ($size == POSIX::CS8) {
    print "8 bits/byte\n";
} else {
    print "unknown bits/byte\n";
}

my $csize = $termios->getcflag;
$csize &= ~(POSIX::CSIZE);
$csize |= POSIX::CS8;

$termios->setcflag($csize);
$termios->setattr(POSIX::STDIN_FILENO, POSIX::TCSANOW);

11.3 POSIX.1のctermidの実装

#!/usr/bin/env perl
use strict;
use warnings;

# POSIX.1のctermidの実装

sub ctermid {
    return "/dev/tty";
}

11.4 POSIX.1のisattyの実装

#!/usr/bin/env perl
use strict;
use warnings;

use POSIX ();

# POSIX.1のisattyの実装

sub isatty {
    my $fd = shift;

    my $termios = POSIX::Termios->new;
    my $retval  = $termios->getattr($fd);

    return 0 unless defined $retval;

    return 1;
}

11.5 isatty関数のテスト

#!/usr/bin/env perl
use strict;
use warnings;

do '11_4.pl';

# isatty関数のテスト

for my $fd (0..2) {
    print "fd $fd: ";
    if (isatty($fd)) {
        print "tty\n";
    } else {
        print "not a tty\n";
    }
}

11.6 POSIX.1のttyname関数の実装

#!/usr/bin/env perl
use strict;
use warnings;

use POSIX ();
use File::Spec ();

# POSIX.1のttyname関数の実装

my $DEV = "/dev";

sub ttyname {
    my $fd = shift;

    unless (POSIX::isatty($fd)) {
        return;
    }

    my @fdstats = POSIX::fstat($fd);

    unless (POSIX::S_ISCHR($fdstats[2])) {
        return;
    }

    opendir my $dh, $DEV or die "Can't open directory $DEV: $!\n";
    for my $dir (grep !m{\.\.?}, readdir $dh) {
        my $pathname = File::Spec->catfile($DEV, $dir);
        my @devstats = stat $pathname;

        if ($fdstats[1] == $devstats[1] && $fdstats[0] == $devstats[0]) {
            closedir $dh;
            return $pathname;
        }
    }
    closedir $dh;

    return;
}

11.7 ttyname関数のテスト

#!/usr/bin/env perl
use strict;
use warnings;

do '11_4.pl'; # import isatty()
do '11_6.pl'; # import ttyname()

# ttyname関数のテスト

for my $fd (0..2) {
    print "fd $fd: ";

    if (isatty($fd)) {
        printf "%s\n", ttyname($fd);
    } else {
        print "not a tty\n";
    }
}

11.8 getpass関数の実装

#!/usr/bin/env perl
use strict;
use warnings;

use POSIX ();

# getpass関数の実装

sub getpass {
    my $prompt = shift;

    my $path = POSIX::ctermid();
    my $fd = POSIX::open($path, POSIX::O_WRONLY);
    unless (defined $fd) {
        die "Error: open $!\n";
    }

    my $sig = POSIX::SigSet->new;
    my $sigsave = POSIX::SigSet->new;

    # block SIGINT & SIGTSTP, save signal mask
    $sig->emptyset;
    $sig->addset(POSIX::SIGINT);
    $sig->addset(POSIX::SIGSTOP);

    unless (POSIX::sigprocmask(POSIX::SIG_BLOCK, $sig, $sigsave)) {
        die "Error: sigprocmask $!\n";
    }

    my $termios = POSIX::Termios->new;
    $termios->getattr($fd);

    my $saveflag;
    my $lflag = $saveflag = $termios->getlflag;
    $lflag &= ~(POSIX::ECHO | POSIX::ECHOE | POSIX::ECHOK | POSIX::ECHONL);
    $termios->setlflag($lflag);
    $termios->setattr($fd, POSIX::TCSAFLUSH);

    print "$prompt";

    chomp(my $passwd = <STDIN>);

    # restore tty state
    $termios->setlflag($saveflag);
    $termios->setattr($fd, POSIX::TCSAFLUSH);
    # restore signal mask
    unless (POSIX::sigprocmask(POSIX::SIG_BLOCK, $sigsave, undef)) {
        die "Error: sigprocmask $!\n";
    }
    # done with /dev/tty
    unless (POSIX::close($fd)) {
        die "Error: close $!\n";
    }

    return $passwd;
}

1;

Term::ReadKeyを使った方がベターでしょう。

#!/usr/bin/env perl
use strict;
use warnings;

use Term::ReadKey ();

print "Input password >> ";

Term::ReadKey::ReadMode('noecho');
my $password = Term::ReadKey::ReadLine(0);

print "\npassword is $password\n";

11.9 getpass関数を呼ぶ

#!/usr/bin/env perl
use strict;
use warnings;

do '11_8.pl';

# getpass関数を呼ぶ
my $passwd = getpass("Enter password:");

# now we use password
print "\npassword is $passwd\n";

$passwd = "\0";

11.10 端末モードをローまたはcbreakに設定

#!/usr/bin/env perl
use strict;
use warnings;

use Term::ReadKey ();

# 端末モードをローまたはcbreakに設定

sub tty_cbreak {
    my $fh = shift;
    Term::ReadKey::ReadMode('cbreak', $fh)
}

sub tty_raw {
    my $fh = shift;
    Term::ReadKey::ReadMode('raw', $fh)
}

sub tty_reset {
    my $fh = shift;
    Term::ReadKey::ReadMode('restore', $fh);
}

11.11 ローモードとcbreakモードのテスト

#!/usr/bin/env perl
use strict;
use warnings;

do '11_10.pl';

# ローモードとcbreakモードのテスト

sub sig_catch {
    print "signal caught\n";
    tty_reset(*STDIN);
    exit 0;
}

local $SIG{INT}  = \&sig_catch;
local $SIG{QUIT} = \&sig_catch;
local $SIG{TERM} = \&sig_catch;

tty_raw(*STDIN);
print "Enter raw mode characters, terminate with DELETE\n";

while (1) {
    my $c = getc();
    if (ord $c == 0177) {
        last;
    }

    print hex(ord($c));
}

tty_reset(*STDIN);

tty_cbreak(*STDIN);
print "Enter cbreak mode characters, terminate with SIGINT\n";

while (1) {
    my $c = getc();
    print hex(ord($c));
}

tty_reset(*STDIN);

11.12 ウィンドウサイズを表示する

#!/usr/bin/env perl
use strict;
use warnings;

use POSIX ();
use Term::ReadKey qw(GetTerminalSize);

# ウィンドウサイズを表示する

sub pr_winsize {
    my $fh = shift;
    my ($wchar, $hchar, $wpixels, $hpixels) = GetTerminalSize($fh);

    printf "%d rows, %d columns\n", $hchar, $wchar;
}

unless (POSIX::isatty(*STDIN)) {
    die "STDIN is not a tty\n";
}

pr_winsize(*STDIN);

local $SIG{WINCH} = sub {
    print "SIGWINCH received\n";
    pr_winsize(*STDIN);
};

print "My pid = $$\n";
while (1) {
    POSIX::pause();
}