This file is indexed.

/usr/share/perl5/Juman/Process.pm is in libjuman-perl 7.0-3.1ubuntu1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
# $Id: Process.pm,v 1.5 2011/07/01 04:02:15 kawahara Exp $
package Juman::Process;
require 5.000;
use English qw/ $PERL_VERSION /;
use IO::Socket::INET;
use Juman::Fork;
use strict;

=head1 NAME

Juman::Process - プロセスオブジェクト

=head1 METHODS

=over 4

=item setup( OPTION, DEFAULT )

ユーザーの指定するオプションのハッシュに対するリファレンスと,デフォル
ト値のハッシュに対するリファレンスを引数として呼び出すと,インスタンス
変数を適切に設定する.

=item open

子プロセスを生成し,そのプロセスと通信するソケットを返す.

=item close

子プロセスとの通信ソケットを閉じる.

=item pattern

形態素解析結果/構文解析結果の終端を検出するための正規表現パターンを取
り出す.

=head1 STRUCTURE

以下の内部変数が、メンバとしてハッシュに格納されている。

    $this->{OPTION}     オプションへのハッシュ
    $this->{SOCKET}     JUMANと通信するソケットへのハッシュ
    $this->{PATTERN}    解析結果の終了を検出するための正規表現

=cut

# インスタンス変数を設定するメソッド
sub setup {
    my( $this, $option, $default ) = @_;

    # ユーザーによって指定されたオプションを対象として,以下の正規化を行う
    #   (1) 文字列先頭の - を取り除く
    #   (2) 全て小文字に統一する
    my %opt;
    while( my( $key, $value ) = each %$option ){
	$key =~ s/^-+//;
	$opt{lc($key)} = $value;
    }

    # ユーザーによって指定されたオプションと,デフォルト値を混合して,
    # 実際のオプションの連想配列を作成する.この時,デフォルト値の存在
    # しないオプション(= 不正なオプション)は,単に無視される.
    while( my( $key, $value ) = each %$default ){
	if( defined $opt{$key} ){
	    $this->{OPTION}->{$key} = $opt{$key};
	} elsif( $value ){
	    $this->{OPTION}->{$key} = $value;
	}
    }

    # -Command オプションが指定された場合は -Server オプションを無視する.
    if( $opt{command} ){
	delete $this->{OPTION}->{server};
    } elsif( $this->{OPTION}->{server} ){
	delete $this->{OPTION}->{command};
    }
    if( $opt{jumancommand} ){
	delete $this->{OPTION}->{jumanserver};
    } elsif( $this->{OPTION}->{jumanserver} ){
	delete $this->{OPTION}->{jumancommand};
    }

    if( my $argv = $this->{OPTION}->{option} ){
	# 設定ファイルをコマンドラインオプションとして指定した場合
	if( $argv =~ s/\-r\s+(\S+)\s*// ){
	    die "Conflicted option." if defined $this->{OPTION}->{rcfile};
	    $this->{OPTION}->{rcfile} = ( $opt{rcfile} = $1 );
	}
	# Juman が解析時に無視する行のパターンをコマンドラインオプショ
	# ンとして指定した場合
	if( $argv =~ s/\-i\s+(\S+)\s*// ){
	    die "Conflicted option." if defined $this->{OPTION}->{ignorepattern};
	    $this->{OPTION}->{ignorepattern} = ( $opt{ignorepattern} = $1 );
	}
	$this->{OPTION}->{option} = $argv;
    }

    my $rcfile = $this->{OPTION}->{rcfile};
    unless( $rcfile and -r $rcfile ){
	die "Can't read initialize file($rcfile): $!\n" if $opt{rcfile};
	delete $this->{OPTION}->{rcfile};
    }

    $rcfile = $this->{OPTION}->{jumanrcfile};
    unless( $rcfile and -r $rcfile ){
	die "Can't read initialize file($rcfile): $!\n" if $opt{jumanrcfile};
	delete $this->{OPTION}->{jumanrcfile};
    }

    if( defined $this->{OPTION}->{ignorepattern} ){
	$this->{PATTERN}
	    = sprintf( '(?:^EOS$|^%s)', quotemeta $this->{OPTION}->{ignorepattern} );
    } else {
	$this->{PATTERN} = '^EOS$';
    }
}

# 引数を生成する内部関数
sub generate_option {
    my( $this, $remote ) = @_;
    my $option = $this->{OPTION}->{option};
    # Juman が解析時に無視する行のパターンを引数に追加する
    if( defined $this->{OPTION}->{ignorepattern} ){
	$option .= sprintf( ' -i %s', $this->{OPTION}->{ignorepattern} );
    }
    # プロセスをローカルのマシンで実行する場合は、設定ファイルを引数で
    # 指定する必要がある
    unless( $remote ){
	if( my $rcfile = $this->{OPTION}->{rcfile} ){
	    $option .= sprintf( ' -r %s', $rcfile  );
	}
    }
    $option;
}

# ネットワーク上のサーバーとの通信を開始する内部関数
sub open_remote_socket {
    my( $this ) = @_;

    my $host = $this->{OPTION}->{server};
    return undef unless $host;

    my $port = $this->{OPTION}->{port};
    my $sock = new IO::Socket::INET( PeerAddr => $host,
				     PeerPort => $port,
				     Proto => 'tcp' )
	or die "Can't connect server: host=$host, port=$port\n";
    $sock->timeout( $this->{OPTION}->{timeout} );
#    &set_encoding( $sock );

    # サーバーの greeting message を確認する
    my $res;
    ( $res = $sock->getline ) =~ /^200/
	or die "Illegal response: host=$host, port=$port, response=$res\n";

    # 設定ファイルを送信する
    if( my $rcfile = $this->{OPTION}->{rcfile} ){
	open( RC, "< $rcfile" )
	    or die "Can't open initialize file($rcfile): $!\n";
	$sock->print( "RC\n", <RC>, "\n", pack("c",0x0b), "\n" );
	close RC;
	( $res = $sock->getline ) =~ /^200/
	    or die "Configuration error: rcfile=$rcfile, response=$res\n";
    }

    # サーバーにコマンドラインオプションを渡す
    my $option = $this->generate_option( 'remote' );
    $sock->print( "RUN $option\n" );
    ( $res = $sock->getline ) =~ /^200/
	or die "Configuration error: option=$option, response=$res\n";

    # 生成されたソケットを記録しておく
    $this->{SOCKET}->{REMOTE} = $sock;
}

# ローカルマシン上で子プロセスを実行する内部関数
sub open_local_socket {
    my( $this ) = @_;

    # juman/knp が server-client mode で動作しないようにしている.
    local %ENV;
    delete $ENV{JUMANSERVER};
    delete $ENV{KNPSERVER};

    my $command = $this->{OPTION}->{command};
    my $option = $this->generate_option();
    my $sock = new Juman::Fork( $command, $option )
	or die "Can't fork: command=$command, option=$option\n";
    $sock->timeout( $this->{OPTION}->{timeout} );
    $this->{SOCKET}->{LOCAL} = $sock;
}

# ソケットを生成するメソッド
sub open {
    my( $this ) = @_;
    $this->{SOCKET}->{REMOTE}
	or $this->{SOCKET}->{LOCAL}
	    or $this->open_remote_socket()
		or $this->open_local_socket();
}

# ソケットを閉じるメソッド
sub close {
    my( $this ) = @_;
    my $fh;
    if( $fh = $this->{SOCKET}->{REMOTE} ){
	$fh->print( pack("c",0x0b) . "\nQUIT\n" );
	$fh->close;
    } elsif( $fh = $this->{SOCKET}->{LOCAL} ){
	if( $fh->alive ){
	    $fh->close;
	    if ( $fh->alive ) {
		# Call waitpid() to avoid zombie.
		$fh->kill;
	    }
	}
    }
    delete $this->{SOCKET};
    1;
}

sub DESTROY {
    my( $this ) = @_;
    $this->close();
}

sub pattern {
    my( $this ) = @_;
    $this->{PATTERN} || undef;
}

sub which_command {
    my( $bin ) = @_;
    for my $p ( split( /:/, $ENV{PATH} ) ){
	return "$p/$bin" if -x "$p/$bin";
    }
}

=head1 MEMO

Perl-5.8 以降の場合,ネットワーク上のサーバーとの通信には, 
C<encoding> プラグマで指定された文字コードが使われます.

=cut
BEGIN {
    if( $PERL_VERSION > 5.008 ){
	require Juman::Encode;
	Juman::Encode->import( qw/ set_encoding / );
    } else {
	*{Juman::Process::set_encoding} = sub { undef; };
    }
}

1;
__END__
# Local Variables:
# mode: perl
# use-kuten-for-period: nil
# use-touten-for-comma: nil
# End: