[Namazu-devel-ja 240] syscmd 試作
Tadamasa Teranishi
yw3t-trns ＠ asahi-net.or.jp
2004年 10月 10日 (日) 13:17:18 JST
寺西です。
pltests である程度のテストができましたので、syscmd を util.pl
に追加し、サンプルとして filter/{man.pl, pdf.pl, rpm.pl} を
util::syscmd を使うように書き換えてみました。
util::syscmd は、pltests::syscmd よりもシンプルになっており、
バッチコマンドの実行をサポートしていません。
バッチコマンドは何かとトラブルを起こしかねないので、Namazu 本体での
サポートからは外しました。
(現在のところ、フィルタでバッチを実行するものはありませんので
実害はないでしょう。)
また、改行コード変換ルーチン codeconv::normalize_nl を追加しました。
同時に、util::readfile($;$) に省略可能な第二引数を追加し、テキスト
モード("t")での読み込み機能を追加しました。(省略時はバイナリモード)
とりあえず、全フィルタを書き換え、フィルタから
・env コマンドの撤廃
・2> の撤廃
・util::systemcmd の撤廃
・system の撤廃
を行いたいと思っています。
そうすることで、Windows 対応(Windows 95 系対応を含む)となるものと
思います。
--
=====================================================================
寺西 忠勝(TADAMASA TERANISHI) yw3t-trns ＠ asahi-net.or.jp
http://www.asahi-net.or.jp/~yw3t-trns/index.htm
Key fingerprint = 474E 4D93 8E97 11F6 662D 8A42 17F5 52F4 10E7 D14E
-------------- next part --------------
Index: pl/codeconv.pl
===================================================================
RCS file: /storage/cvsroot/namazu/pl/codeconv.pl,v
retrieving revision 1.23
diff -u -p -r1.23 codeconv.pl
--- pl/codeconv.pl 1 Oct 2004 03:44:28 -0000 1.23
+++ pl/codeconv.pl 9 Oct 2004 22:08:53 -0000
@@ -198,4 +198,13 @@ sub normalize_eucjp ($) {
$contref;
}
+sub normalize_nl ($) {
+ my ($conts) = @_;
+
+ $$conts =~ s/\x0d\x0a/\x0a/g; # Windows
+ $$conts =~ s/\x0d/\x0a/g; # Mac
+ $$conts =~ s/\x0a/\n/g;
+ $$conts;
+}
+
1;
Index: pl/util.pl
===================================================================
RCS file: /storage/cvsroot/namazu/pl/util.pl,v
retrieving revision 1.29
diff -u -p -r1.29 util.pl
--- pl/util.pl 18 Mar 2004 15:52:11 -0000 1.29
+++ pl/util.pl 9 Oct 2004 22:08:53 -0000
@@ -124,8 +124,12 @@ sub rfc822time ($)
$hour, $min, $sec, time::gettimezone());
}
-sub readfile ($) {
- my ($arg) = @_;
+sub readfile ($;$) {
+ my ($arg, $mode) = @_;
+ my $text_mode = undef;
+ if (defined $mode && $mode =~ /^t/i) {
+ $text_mode = 1;
+ }
my $fh;
if (ref $arg) {
@@ -147,6 +151,8 @@ sub readfile ($) {
# }
read $fh, $cont, $size;
+ codeconv::normalize_nl(\$cont) if (defined $text_mode);
+
unless (ref $arg) {
fclose($fh);
}
@@ -334,6 +340,196 @@ sub systemcmd(@) {
$fh_err->seek(0, SEEK_SET) or cdie "seek: $!";
return ($status, $fh_out, $fh_err);
+}
+
+sub syscmd(%)
+{
+ my $status = undef;
+ my %arg = @_;
+ my @args = @{$arg{command}} if (defined $arg{command});
+ my %option = %{$arg{option}} if (defined $arg{option});
+ my %env = %{$arg{env}} if (defined $arg{env});
+
+ dprint(_("Invoked: ") . join(' ', @args));
+
+ # default option
+ $option{stdout} = '/dev/null' unless(defined $option{stdout});
+ $option{stderr} = '/dev/null' unless(defined $option{stderr});
+ $option{mode_stdout} = 'at' unless(defined $option{mode_stdout});
+ $option{mode_stderr} = 'at' unless(defined $option{mode_stderr});
+ $option{maxsize} = -1 unless(defined $option{maxsize});
+
+ my $handle_out = undef;
+ my $handle_err = undef;
+ if (ref $option{stdout}) {
+ if ($option{stdout} =~ /^(IO::File|FileHandle)/) {
+ $handle_out = $option{stdout};
+ }
+ }
+ if (ref $option{stderr}) {
+ if ($option{stderr} =~ /^(IO::File|FileHandle)/) {
+ $handle_err = $option{stderr};
+ }
+ }
+
+ my $same = 0;
+ if ($option{stdout} eq $option{stderr}) {
+ $same = 1;
+ }
+
+ my $mode_stdout;
+ my $mode_stderr;
+ if ($option{mode_stdout} =~ /^w/i) {
+ $mode_stdout = '>';
+ } elsif ($option{mode_stdout} =~ /^a/i) {
+ $mode_stdout = '>>';
+ } else {
+ warn "unknown mode. : " . quotemeta($option{mode_stdout});
+ $mode_stdout = '>>';
+ }
+ if ($option{mode_stderr} =~ /^w/i) {
+ $mode_stderr = '>';
+ } elsif ($option{mode_stderr} =~ /^a/i) {
+ $mode_stderr = '>>';
+ } else {
+ warn "unknown mode. : " . quotemeta($option{mode_stderr});
+ $mode_stderr = '>>';
+ }
+
+ my $text_stdout = undef;
+ my $text_stderr = undef;
+ if ($option{mode_stdout} =~ /^.t/i) {
+ $text_stdout = 1;
+ }
+ if ($option{mode_stderr} =~ /^.t/i) {
+ $text_stderr = 1;
+ }
+
+ if ($mknmz::SYSTEM eq "MSWin32" || $mknmz::SYSTEM eq "os2") {
+ foreach my $arg (@args) {
+# $arg =~ s!/!\\!g;
+ }
+ }
+
+ my $fh_out = undef;
+ my $fh_err = undef;
+
+ if (defined $handle_out) {
+ $fh_out = $handle_out;
+ } else {
+ $fh_out= IO::File->new_tmpfile();
+ }
+ if ($same) {
+ $fh_err = $fh_out;
+ } else {
+ if (defined $handle_err) {
+ $fh_err = $handle_err;
+ } else {
+ $fh_err = IO::File->new_tmpfile();
+ }
+ }
+
+ {
+ my $saveout = new IO::File (">&" . STDOUT->fileno()) or cdie "Can't dup STDOUT: $!";
+ my $saveerr = new IO::File (">&" . STDERR->fileno()) or cdie "Can't dup STDERR: $!";
+ STDOUT->fdopen($fh_out->fileno(), 'w') or cdie "Can't open fh_out: $!";
+ STDERR->fdopen($fh_err->fileno(), 'w') or cdie "Can't open fh_out: $!";
+
+ # backup $ENV{}
+ my %backup;
+ my ($key, $value);
+ while(($key, $value) = each %env) {
+ $backup{$key} = $ENV{$key};
+ if (defined $value) {
+ $ENV{$key} = $value;
+ } else {
+ delete $ENV{$key};
+ }
+ }
+
+ # Use an indirect object: see Perl Cookbook Recipe 16.2 in detail.
+ $status = system { $args[0] } @args;
+
+ # restore $ENV{}
+ while(($key, $value) = each %env) {
+ if (defined $backup{$key}) {
+ $ENV{$key} = $backup{$key};
+ } else {
+ delete $ENV{$key};
+ }
+ }
+
+ STDOUT->fdopen($saveout->fileno(), 'w') or cdie "Can't restore saveout: $!";
+ STDERR->fdopen($saveerr->fileno(), 'w') or cdie "Can't restore saveerr: $!";
+ }
+
+ # Note that the file position of filehandles must be rewinded.
+ $fh_out->seek(0, SEEK_SET) or cdie "seek: $!";
+ $fh_err->seek(0, SEEK_SET) or cdie "seek: $!";
+
+ if (!defined $handle_out) {
+ if (ref($option{stdout}) ne 'SCALAR') {
+ if ($option{stdout} eq '/dev/null') {
+ $fh_out->close();
+ } else {
+ my $conts_out = "";
+ my $size = -s $fh_out;
+ read $fh_out, $conts_out, $size;
+ $fh_out->close();
+ codeconv::normalize_nl(\$conts_out) if (defined $text_stdout);
+
+ my $file = $option{stdout};
+ if ($mknmz::SYSTEM eq "MSWin32" || $mknmz::SYSTEM eq "os2") {
+# $file =~ s!/!\\!g;
+ }
+ if (!open(OUT, "$mode_stdout$file")) {
+ warn "Can not open file. : $file";
+ return (1);
+ }
+ print OUT $conts_out;
+ close(OUT);
+ }
+ } else {
+ my $conts_out = $option{stdout};
+ my $size = -s $fh_out;
+ read $fh_out, $$conts_out, $size;
+ $fh_out->close();
+ codeconv::normalize_nl($conts_out) if (defined $text_stdout);
+ }
+ }
+
+ if (!(defined $handle_err || $same)) {
+ if (ref($option{stderr}) ne 'SCALAR') {
+ if ($option{stderr} eq '/dev/null') {
+ $fh_err->close();
+ } else {
+ my $conts_err = "";
+ my $size = -s $fh_err;
+ read $fh_err, $conts_err, $size;
+ $fh_err->close();
+ codeconv::normalize_nl(\$conts_err) if (defined $text_stderr);
+
+ my $file = $option{stderr};
+ if ($mknmz::SYSTEM eq "MSWin32" || $mknmz::SYSTEM eq "os2") {
+# $file =~ s!/!\\!g;
+ }
+ if (!open(OUT, "$mode_stderr$file")) {
+ warn "Can not open file. : $file";
+ return (1);
+ }
+ print OUT $conts_err;
+ close(OUT);
+ }
+ } else {
+ my $conts_err = $option{stderr};
+ my $size = -s $fh_err;
+ read $fh_err, $$conts_err, $size;
+ $fh_err->close();
+ codeconv::normalize_nl($conts_err) if (defined $text_stderr);
+ }
+ }
+
+ return ($status);
}
# Returns a string representation of the null device.
Index: filter/pdf.pl
===================================================================
RCS file: /storage/cvsroot/namazu/filter/pdf.pl,v
retrieving revision 1.35
diff -u -p -r1.35 pdf.pl
--- filter/pdf.pl 21 May 2004 11:58:37 -0000 1.35
+++ filter/pdf.pl 9 Oct 2004 22:08:53 -0000
@@ -44,12 +44,20 @@ sub status() {
$pdfconvpath = util::checkcmd('pdftotext');
$pdfinfopath = util::checkcmd('pdfinfo');
if (defined $pdfconvpath) {
- my ($status, $fh_out, $fh_err) = util::systemcmd($pdfconvpath);
- if (<$fh_err> =~ /^pdftotext\s+version\s+([0-9]+\.[0-9]+)/) {
+ my @cmd = ("$pdfconvpath");
+ my $result = "";
+ my $status = util::syscmd(
+ command => \@cmd,
+ option => {
+ "stdout" => "/dev/null",
+ "stderr" => \$result,
+ "mode_stdout" => 'wt',
+ "mode_stderr" => 'wt',
+ },
+ );
+ if ($result =~ /^pdftotext\s+version\s+([0-9]+\.[0-9]+)/) {
$pdfconvver = $1;
}
- util::fclose($fh_out);
- util::fclose($fh_err);
if (util::islang("ja")) {
if ($pdfconvver >= 1.00) {
@pdfconvopts = ('-q', '-raw', '-enc', 'EUC-JP');
@@ -60,12 +68,20 @@ sub status() {
@pdfconvopts = ('-q', '-raw');
}
if (defined $pdfinfopath) {
- my ($status, $fh_out, $fh_err) = util::systemcmd($pdfinfopath);
- if (<$fh_err> =~ /^pdfinfo\s+version\s+([0-9]+\.[0-9]+)/) {
+ my @cmd = ("$pdfinfopath");
+ my $result = "";
+ my $status = util::syscmd(
+ command => \@cmd,
+ option => {
+ "stdout" => "/dev/null",
+ "stderr" => \$result,
+ "mode_stdout" => 'wt',
+ "mode_stderr" => 'wt',
+ },
+ );
+ if ($result =~ /^pdfinfo\s+version\s+([0-9]+\.[0-9]+)/) {
$pdfinfover = $1;
}
- util::fclose($fh_out);
- util::fclose($fh_err);
if (util::islang("ja")) {
if ($pdfinfover >= 2.02) {
@pdfinfoopts = ('-enc', 'EUC-JP');
@@ -112,9 +128,13 @@ sub filter ($$$$$) {
util::fclose($fh);
}
my @cmd = ($pdfconvpath, @pdfconvopts, $tmpfile, $tmpfile2);
- my ($status, $fh_out, $fh_err) = util::systemcmd(@cmd);
- util::fclose($fh_out);
- util::fclose($fh_err);
+ my $status = util::syscmd(
+ command => \@cmd,
+ option => {
+ "stdout" => "/dev/null",
+ "stderr" => "/dev/null",
+ },
+ );
unless (-e $tmpfile2) {
unlink $tmpfile;
return 'Unable to convert pdf file (maybe copying protection)';
@@ -142,10 +162,16 @@ sub filter ($$$$$) {
if (defined $pdfinfopath) {
my @cmd = ($pdfinfopath, @pdfinfoopts, $tmpfile);
- my ($status, $fh_out, $fh_err) = util::systemcmd(@cmd);
- my $result = util::readfile($fh_out);
- util::fclose($fh_out);
- util::fclose($fh_err);
+ my $result = "";
+ my $status = util::syscmd(
+ command => \@cmd,
+ option => {
+ "stdout" => \$result,
+ "stderr" => "/dev/null",
+ "mode_stdout" => 'wt',
+ "mode_stderr" => 'wt',
+ },
+ );
if ($result =~ /Title:\s+(.*)/) { # or /Subject:\s+(.*)/
$fields->{'title'} = $1;
if ($fields->{'title'} =~ /<unicode>/) {
Index: filter/rpm.pl
===================================================================
RCS file: /storage/cvsroot/namazu/filter/rpm.pl,v
retrieving revision 1.12
diff -u -p -r1.12 rpm.pl
--- filter/rpm.pl 22 Mar 2004 12:31:58 -0000 1.12
+++ filter/rpm.pl 9 Oct 2004 22:08:53 -0000
@@ -29,7 +29,6 @@ require 'gfilter.pl';
my $rpmpath = undef;
my @rpmopts = undef;
-my $envpath = undef;
sub mediatype() {
return ('application/x-rpm');
@@ -38,8 +37,7 @@ sub mediatype() {
sub status() {
$rpmpath = util::checkcmd('rpm');
@rpmopts = ("-qpi");
- $envpath = util::checkcmd('env');
- return 'no' unless (defined $rpmpath && defined $envpath);
+ return 'no' unless (defined $rpmpath);
return 'yes';
}
@@ -78,25 +76,34 @@ sub filter ($$$$$) {
}
{
- my @env = ($envpath, "LC_MESSAGE=$util::LANG", "LC_TIME=C");
- my @cmd = (@env, $rpmpath, @rpmopts, $tmpfile);
- my ($status, $fh_out, $fh_err) = util::systemcmd(@cmd);
+ my %env = (
+ "LC_ALL" => undef,
+ "LC_MESSAGE" => $util::LANG,
+ "LC_TIME" => "C",
+ );
+ my @cmd = ($rpmpath, @rpmopts, $tmpfile);
+ my $fh_out = IO::File->new_tmpfile();
+ my $status = util::syscmd(
+ command => \@cmd,
+ option => {
+ "stdout" => $fh_out,
+ "stderr" => "/dev/null",
+ },
+ env => \%env,
+ );
my $size = util::filesize($fh_out);
if ($size == 0) {
util::fclose($fh_out);
- util::fclose($fh_err);
unlink $tmpfile;
return "Unable to convert file ($rpmpath error occurred).";
}
if ($size > $conf::TEXT_SIZE_MAX) {
util::fclose($fh_out);
- util::fclose($fh_err);
unlink $tmpfile;
return 'Too large rpm file.';
}
- $$cont = util::readfile($fh_out);
+ $$cont = util::readfile($fh_out, "t");
util::fclose($fh_out);
- util::fclose($fh_err);
}
unlink $tmpfile;
Index: filter/man.pl
===================================================================
RCS file: /storage/cvsroot/namazu/filter/man.pl,v
retrieving revision 1.31
diff -u -p -r1.31 man.pl
--- filter/man.pl 21 May 2004 11:58:37 -0000 1.31
+++ filter/man.pl 9 Oct 2004 22:08:53 -0000
@@ -31,8 +31,7 @@ require 'gfilter.pl';
my $roffpath = undef;
my @roffopts = undef;
-my $envpath = undef;
-my @env = undef;
+my %env = ();
sub mediatype() {
return ('text/x-roff');
@@ -42,23 +41,30 @@ sub status() {
$roffpath = util::checkcmd('jgroff');
$roffpath = util::checkcmd('groff') unless (defined $roffpath);
$roffpath = util::checkcmd('nroff') unless (defined $roffpath);
- $envpath = util::checkcmd('env');
- unless (defined $roffpath && defined $envpath) {
+ unless (defined $roffpath) {
return 'no';
}
- @env = ($envpath, "LC_ALL=$util::LANG", "LANGUAGE=$util::LANG");
+ %env = (
+ "LC_ALL" => $util::LANG,
+ "LANGUAGE" => $util::LANG,
+ );
if (util::islang("ja") && $roffpath =~ /\bj?groff$/) {
# Check wheter -Tnippon is valid.
- my @cmd = (@env, $roffpath, "-Tnippon", util::devnull());
- my ($status, $fh_out, $fh_err) = util::systemcmd(@cmd);
+ my @cmd = ($roffpath, "-Tnippon", util::devnull());
+ my $status = util::syscmd(
+ command => \@cmd,
+ option => {
+ "stdout" => "/dev/null",
+ "stderr" => "/dev/null",
+ },
+ env => \%env,
+ );
if ($status == 0) {
@roffopts = ('-man', '-Wall', '-Tnippon');
} else {
@roffopts = ('-man', '-Wall', '-Tascii');
}
- util::fclose($fh_out);
- util::fclose($fh_err);
} elsif ($roffpath =~ /\bj?groff$/) {
@roffopts = ('-man', '-Tascii');
} elsif ($roffpath =~ /nroff$/) {
@@ -104,24 +110,29 @@ sub filter ($$$$$) {
util::fclose($fh);
}
{
- my @cmd = (@env, $roffpath, @roffopts, $tmpfile);
- my ($status, $fh_out, $fh_err) = util::systemcmd(@cmd);
+ my @cmd = ($roffpath, @roffopts, $tmpfile);
+ my $fh_out = IO::File->new_tmpfile();
+ my $status = util::syscmd(
+ command => \@cmd,
+ option => {
+ "stdout" => $fh_out,
+ "stderr" => "/dev/null",
+ },
+ env => \%env,
+ );
my $size = util::filesize($fh_out);
if ($size == 0) {
util::fclose($fh_out);
- util::fclose($fh_err);
unlink $tmpfile;
return "Unable to convert file ($roffpath error occurred)";
}
if ($size > $conf::TEXT_SIZE_MAX) {
util::fclose($fh_out);
- util::fclose($fh_err);
unlink $tmpfile;
return 'Too large man file';
}
$$cont = util::readfile($fh_out);
util::fclose($fh_out);
- util::fclose($fh_err);
}
unlink $tmpfile;
Namazu-devel-ja メーリングリストの案内