以下, auto_run.pmのソースコードとなります.
search関数およびdisplay関数は必要に応じて修正させていただきました.
ディレクトリは伏せてあります.
-----------------------------------------------------------------------
package auto_run;
/* 略(データの入力部分) */
sub plugin_config{
&run;
sub run{
my $file_target = $path_list[0];
my $file_save = $path_list[1];
my $icon = $::main_gui->win_obj->Photo('window_icon',
-file => Tk->findINC('acre.gif')
);
my $new = kh_project->new(
target => $file_target,
comment => 'auto',
) or die("could not create a project\n");
kh_projects->read->add_new($new) or die("could not save the project\n");
$new->open or die("could not open the project\n");
my $wait_window = gui_wait->start;
&gui_window::main::menu::mc_morpho_exec;
$wait_window->end(no_dialog => 1);
my $win = gui_window::word_ass->open;
my $e_val = $path_list_d[0];
print $e_val;
$win->{direct_w_e}->insert('end', $win->gui_jchar($e_val) ); #japanese
&search_c($win);
#$win->search;
sleep 5;
$::main_gui->close_all;
undef $::project_obj;
my $win_opn = gui_window::project_open->open;
my $n = @{$win_opn->projects->list} - 1;
$win_opn->{g_list}->selectionClear(0);
$win_opn->{g_list}->selectionSet($n);
$win_opn->delete;
$win_opn->close;
exit;
}
return {
name => '...',
};
}
sub exec{
print "...";
}
sub search_c{
my $self = shift;
$self->{status_label}->configure(
-foreground => 'blue',
-text => '1'
);
$self->activate;
$self->{status_label}->configure(
-foreground => 'blue',
-text => '2'
);
# 選択のチェック
my @selected = $self->{clist}->info('selection');
unless (@selected){
my $win = $self->win_obj;
gui_errormsg->open(
type => 'msg',
msg => kh_msg->get('gui_window::doc_search->error_no_code'), # 'コードが選択されていません',
window => \$win,
);
return 0;
}
# ラベルの変更
$self->{hits_label}->configure(-text => kh_msg->get('hits0')); # 文書数： 0
$self->{status_label}->configure(
-foreground => 'red',
-text => 'Searching...'
);
$self->{rlist}->delete('all');
$self->win_obj->update;
sleep (0.01);
# 直接入力部分の読み込み
$self->{code_obj}->add_direct(
mode => $self->gui_jg( $self->{opt_direct} ),
raw => $self->gui_jg( $self->{direct_w_e}->get ),
);
$self->{status_label}->configure(
-foreground => 'blue',
-text => '3'
);
# 検索ロジックの呼び出し（検索実行）
my $query_ok = $self->{code_obj}->asso(
selected => \@selected,
tani => $self->tani,
method => $self->{opt_method1},
);
$self->{status_label}->configure(
-foreground => 'blue',
-text => 'Ready.'
);
if ($query_ok){
$self->{code_obj} = $query_ok;
&display_c($self);
}
else{
open(FH,"> /Users/***/Desktop/khcoder/exectest/ass_result.txt");
print FH "No Query. Couldn't search. (KH Coder error) \n";
close(FH);
}
return $self;
}
sub display_c{
my $self = shift;
unless ( $self->{code_obj} ) {return undef;}
unless ( $self->{code_obj}->doc_num ) {return undef;}
my $order_name = {
'fr' => kh_msg->get('fr'), # 共起
'sa' => kh_msg->get('sa'), # 確率差
'hi' => kh_msg->get('hi'), # 確率比
'jac' => 'Jaccard',
'ochi'=> 'Ochiai',
'dice'=> 'Dice',
'll' => 'Log Likelihood',
};
$filter = undef;
$filter->{limit} = 75; # LIMIT数
$filter->{min_doc} = 1; # 最低文書数
my $h = mysql_exec->select(" # 品詞によるフィルタ
SELECT name, khhinshi_id
FROM hselection
WHERE ifuse = 1
",1)->hundle;
while (my $i = $h->fetch){
if (
$i->[0] =~ /B$/
|| $i->[0] eq '否定助動詞'
|| $i->[0] eq '形容詞（非自立）'
){
$filter->{hinshi}{$i->[1]} = 0;
} else {
$filter->{hinshi}{$i->[1]} = 1;
}
}
# HListの更新
$self->{rlist}->headerConfigure(5,-text,$order_name->{$self->{opt_order}});
$self->{result} = $self->{code_obj}->fetch_results(
order => $self->{opt_order},
filter => $filter,
);
my $numb_style = $self->{rlist}->ItemStyle(
'text',
-anchor => 'e',
-background => 'white',
-font => "TKFN"
);
open(FH,"> /Users/***/Desktop/khcoder/exectest/ass_result.txt");
$self->{rlist}->delete('all');
if ($self->{result}){
my $row = 0;
foreach my $i (@{$self->{result}}){
$self->{rlist}->add($row,-at => "$row");
$self->{rlist}->itemCreate( # 順位
$row,
0,
-text => $row + 1,
-style => $numb_style
);
print FH $row + 1;
print FH " ";
$self->{rlist}->itemCreate( # 単語
$row,
1,
-text => $self->gui_jchar($i->[0]),
);
print FH $self->gui_jchar($i->[0]);
print FH " ";
$self->{rlist}->itemCreate( # 品詞
$row,
2,
-text => $self->gui_jchar($i->[1]),
);
print FH $self->gui_jchar($i->[1]);
print FH " ";
$self->{rlist}->itemCreate( # 全体
$row,
3,
-text => "$i->[2]"." ("."$i->[3]".")",
-style => $numb_style
);
print FH "$i->[2]"." ("."$i->[3]".")";
print FH " ";
$self->{rlist}->itemCreate( # 共起
$row,
4,
-text => "$i->[4]"." ("."$i->[5]".")",
-style => $numb_style
);
print FH "$i->[4]"." ("."$i->[5]".")";
print FH " ";
$self->{rlist}->itemCreate( # Sort
$row,
5,
-text => " ".sprintf("%.4f",$i->[6]),
-style => $numb_style
);
print FH $i->[6];
print FH "\n";
++$row;
}
} else {
$self->{result} = [];
}
close(FH);
# ラベルの更新
my $num_total = $self->{code_obj}->doc_num;
gui_hlist->update4scroll($self->{rlist});
$self->{hits_label}->configure(
-text => $self->gui_jchar(
kh_msg->get('hits') # 文書数：
.$num_total
)
);
return $self;
}
1;