Namazu-devel-ja(旧)

[Hajime BABA <baba@xxxxxxxxxxxxxxxx>]

 From: knok@xxxxxxxxxxxxx
 Subject: [namazu-devel-ja] Re: Win98,ME で pdf.pl(Namazu2.0.12) の不具合?
 Date: Wed, 4 Sep 2002 14:42:16 JST

 >   やはりやるなら Open3 ですかね...

しばらく考えていたのですが、pl/util.pl での systemcmd() を、以下の
ような感じにするのはどうでしょうか。open3() あるいは system(LIST) 
で起動したコマンドのstdout出力およびstderr出力へのファイルハンドル
を返し値に含めてしまうというものです。あんまり普通じゃないことは承
知していますが、フィルタは簡潔にできるという特長があります。

たとえば、出力の要らない
  system("$wordconvpath $options $tmpfile $ofile");
は、
  util::systemcmd($wordconvpath, @options, $tmpfile, $ofile);
にして単に返値を無視すればいい。

        my $fh_cmd = util::efopen("$wvversionpath $tmpfile |");
        while (<$fh_cmd>) {
は
	my @cmd = ($wvversionpath, $tmpfile);
        my ($status, $fh_out, $fh_err) = util::systemcmd(@cmd);
        while (<$fh_out>) {

でいいですし。

        system("$utfconvpath -Iu8 -Oej $tmpfile > $tmpfile2");
        my $fh = util::efopen("< $tmpfile");
        $$cont = util::readfile($fh);
は
	my @cmd = ($utfconvpath, "-Iu8", "-Oej", $tmpfile);
        my ($status, $fh_out, $fh_err) = util::systemcmd(@cmd);
        $$cont = util::readfile($fh_out);

という感じ。

テストプログラムで試した感じでは、Linux ではいずれでも動きますが、
Windows98 だと Open3 版は呼び出すプログラムによって動くものと動か
ないものとがあるようです。後者のものなら試した範囲ではだいたい動く
ようです。NT系でどうなっているかはわかりませんが。
--
馬場  肇 ( Hajime BABA )                  E-mail: baba@xxxxxxxxxxxxxxxx
宇宙科学研究所 宇宙科学企画情報解析センター
--


=======================================================================
IPC::Open3 版

sub systemcmd(@) {
    my $status = undef;
    my @args = ();
    if ($mknmz::SYSTEM eq "MSWin32" || $mknmz::SYSTEM eq "os2") {
        foreach my $tmp (@_) {
            # To avoid an error: 'Modification of a read-only value attempted'
            (my $tmp2 = $tmp) =~ s!/!\\!g;
            push @args, $tmp2;
        }
    } else {
        @args = @_;
    }
    util::dprint(join(' ', @args));

    my $fh_out = IO::File->new_tmpfile();
    my $fh_err = IO::File->new_tmpfile();
    {
	use IPC::Open3;
	use Symbol qw(gensym);
	my $pid = open3(gensym, $fh_out, $fh_err, @args);
	waitpid($pid, 0);
	$status = ($? >> 8);
    }

    return ($status, $fh_out, $fh_err);
}


=======================================================================
system() 版

sub systemcmd(@) {
    my $status = undef;
    my @args = ();
    if ($mknmz::SYSTEM eq "MSWin32" || $mknmz::SYSTEM eq "os2") {
        foreach my $tmp (@_) {
            # To avoid an error: 'Modification of a read-only value attempted'
            (my $tmp2 = $tmp) =~ s!/!\\!g;
            push @args, $tmp2;
        }
    } else {
        @args = @_;
    }
    util::dprint(join(' ', @args));

    my $saveout = new IO::File (">&" . STDOUT->fileno()) 
        or die "Can't dup SAVEOUT: $!";
    my $saveerr = new IO::File (">&" . STDERR->fileno()) 
        or die "Can't dup SAVEERR: $!";
    my $fh_out = IO::File->new_tmpfile();
    my $fh_err = IO::File->new_tmpfile();
    STDOUT->fdopen($fh_out->fileno(), 'w') or die "Can't open fh_out: $!";
    STDERR->fdopen($fh_err->fileno(), 'w') or die "Can't open fh_err: $!";

    # Use an indirect object: see Perl Cookbook Recipe 16.2 in detail.
    $status = system { $args[0] } @args;

    STDOUT->fdopen($saveout->fileno(), 'w') or die "Can't restore saveout: $!";
    STDERR->fdopen($saveerr->fileno(), 'w') or die "Can't restore saveerr: $!";

    # Note that the file position of filehandles must be rewinded.
    seek($fh_out, 0, SEEK_SET) or die "seek: $!";
    seek($fh_err, 0, SEEK_SET) or die "seek: $!";

    return ($status, $fh_out, $fh_err);
}

=======================================================================