2010年12月14日 23:30 [Edit]

perl - 車輪の再発明 - ddコマンドのラッパーddp

それってperlで。

Rails Hub情報局: ddコマンドのラッパー「ddr」をRubyで書いてみた
で、コピーしたバイト数を「23MB Combo!」と表示しようとして気付いたのですが、上のスクリプトは意図したことと違う動きをしています。IO#popenで標準出力がちゃんとキャプチャできてなくて、単に画面に出てきているだけです。open3とかSTYとか、それらしきライブラリがあったりしてかすかに試したり、IOバッファの flushの問題? など、いろいろ調べてみたのですが、そんなことしてる場合じゃないと気付いて、そろそろ仕事に戻ります……。

やっつけもいいところですが、一応 Mac OS X でも Ubuntu でも FreeBSD でも動作確認してあります。CPAN依存はありません。バーグラフは面倒なので%表示でお茶を濁しています。

#!/usr/bin/env perl                                                             
use strict;
use warnings;
use IPC::Open3;
use Symbol 'gensym';
use Time::HiRes 'sleep';
my $sig  = ( $^O eq 'linux' ) ? 10 : 29;    # SIGUSR1 for linux, else SIGINFO   
my $size = getsize(@ARGV);
my $intv = 0.1;

unshift @ARGV, 'dd';

my ( $cin, $cout, $cerr ) = ( undef, undef, gensym );
die $! unless my $pid = open3( $cin, $cout, $cerr, @ARGV );
close $cin;
close $cout;
local $| = 1;

loop: while (1) {
    sleep $intv;
    kill $sig, $pid;
    while (<$cerr>) {
	my ($curr) = /^(\d+) bytes/;
	next unless $curr;
	print_progress( $1, $size );
	last loop if $curr >= $size;
	last;
    }
}
waitpid $pid, 0;
print "\n";

sub getsize {
    my $cmd = join " ", @_;
    my ($if) = ( $cmd =~ /if=(\S+)/ );
    return -s $if if -f $if;
    my ($bs) = ( $cmd =~ /bs=(\d+)/ );
    $bs ||= 512;
    my ($count) = ( $cmd =~ /count=(\d+)/ );
    $count ||= 1;
    return $bs * $count;
}

sub print_progress {
    my ( $curr, $size ) = @_;
    printf "$curr/$size (%d%%)\r", $curr / $size * 100;
}

見ての通り、生のプロセス制御というのはなかなかまんどくさくどろくさくて、どうしてもという場合は Perl Cookbook を見てなんとかしてちょんまげという感じなのですが…

「ddを制御する」と考えるのではなく、「大きな空ファイルを進捗確認しながら作成する」のであれば、以下のようにずっとシンプルになります。

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

my ( $bs, $count, $filename ) = @ARGV;
die "$0 bs count file" unless $filename;
open my $wfh, '>', $filename or die "$filename:$!";
local $| = 1;    # AUTOFLUSH;
for my $i ( 1 .. $count ) {
    print $wfh "\0" x $bs;
    printf "%d/%d (%d%%)\r", $bs * $i, $bs * $count, $i / $count * 100;
}
close $wfh;
print "\n"

この手のシステム管理ものスクリプトの参考書としては、「ミニマルPerl」がいけてます。

Enjoy!

Dan the System Administrator that Scripts


この記事へのトラックバックURL

この記事へのトラックバック
車輪の再々発明 - dd wrapper in Gauche【】at 2010年12月15日 13:55