X-Git-Url: https://git.jankratochvil.net/?p=nethome.git;a=blobdiff_plain;f=src%2Fjaxam;fp=src%2Fjaxam;h=cce6e8572a0e1a1b161713e65cd39ee64815e888;hp=597b8ad521173669e00b47318697124d53cd1614;hb=98d6f2ffc6d8336c47eed889a99a5036da583036;hpb=f45778db720e89cee74c6aaece62295b2e5c71cb diff --git a/src/jaxam b/src/jaxam index 597b8ad..cce6e85 100755 --- a/src/jaxam +++ b/src/jaxam @@ -1,6 +1,8 @@ #! /usr/bin/perl # # $Id$ +# for .vimrc: +# noremap V:!~/src/jaxam --wrong --tee --errors-wait-key use strict; @@ -16,17 +18,23 @@ binmode STDERR,":utf8"; # only STDIN and STDOUT covered by: use encoding "utf8"; our $opt_debug=1; -my $opt_edict="jaxam.edict"; +my $opt_edict="$0.edict"; my $opt_log; +my $opt_wrong; +my $opt_errors_wait_key; +my $opt_tee; my $opt_fast; $Getopt::Long::ignorecase=0; $Getopt::Long::bundling=1; die if !GetOptions( - "d|debug+" =>\$opt_debug, - "e|edict=s"=>\$opt_edict, - "l|log=s" =>\$opt_log, - "fast!" =>\$opt_fast, + "d|debug+" =>\$opt_debug, + "e|edict=s" =>\$opt_edict, + "l|log=s" =>\$opt_log, + "w|wrong" =>\$opt_wrong, # Filter the input lines. + "errors-wait-key"=>\$opt_errors_wait_key, # Only for -w|--wrong. + "tee!" =>\$opt_tee, # Output all the read lines. Only for -w|--wrong. + "fast!" =>\$opt_fast, ); $opt_log||=$opt_edict.".log"; @@ -37,6 +45,7 @@ my %exam=( my $T; my @R; +my %identify; sub schedule($$%) { @@ -125,24 +134,31 @@ sub result($$$) "exam_from"=>$exam_from, "ok"=>$ok, }; - schedule $r,$exam_from; + schedule $r,$exam_from if $T; } -local *EDICT; -open EDICT,"<:utf8",$opt_edict or die "open \"$opt_edict\": $!"; -my %check=( - #"kanji"=>{}, # exists... - #"kana"=>{}, # exists... - "identify"=>{}, - ); -LINE: -while () { +my $errors_wait_key_count; +END { + if ($errors_wait_key_count && $opt_errors_wait_key) { + print STDERR "Errors occured. Press any key to continue..."; + ; + } +} + +sub edict_line_parse(;$) +{ + my($s,$line)=@_; + + $s=$_ if !defined $s; + $line=$. if !defined $s; + local $_=$s; chomp; s/;.*//; - next if /^\s*$/; + return if /^\s*$/; #〒 [ゆうびん] /(n) mail/postal service/ #Ｔシャツ /T-shirt/ - m{^([^[/\s]+)(?:\s+[[]([^[/\s]+)[]])?\s+/(.*)$} or do { warn "Unparsable: $_\n"; next LINE; }; + m{^([^[/\s]+)(?:\s+[[]([^[/\s]+)[]])?\s+/(.*)$} + or do { warn "Unparsable: $_\n"; $errors_wait_key_count++; return; }; my $r; my $rest; ($r->{"kanji"},$r->{"kana"},$rest)=($1,$2,$3); @@ -151,32 +167,55 @@ while () { delete $r->{"kanji"}; } while ($rest) { - $rest=~s{^\s*([^/]+?)\s*/}{} or do { warn "Unparsable english: $_\n"; next LINE; }; + $rest=~s{^\s*([^/]+?)\s*/}{} + or do { warn "Unparsable english: $_\n"; $errors_wait_key_count++; return; }; my($english)=($1); push @{$r->{"english"}},$english; } $r->{"line"}=$.; - push @R,$r; - keys(%check); - while (my($field,$hashref)=each(%check)) { - my $val; - $val=identify $r if $field eq "identify"; - $val||=$r->{$field}; - next if $val eq "悪い にくい"; # fixup: <20050522015353.GA31030@kashome.dyn.jankratochvil.net> - my $origvalref=\$hashref->{$val}; - warn "field{$field} check duplicity: ".identify($r,"at"=>1)." vs. ".identify($$origvalref,"at"=>1) - if $$origvalref; - $$origvalref=$r; + return $r; +} + +sub edict_read($) +{ + my($pathname)=@_; + + local *EDICT; + open EDICT,"<:utf8",$pathname or die "open \"$pathname\": $!"; + my %check=( + #"kanji"=>{}, # exists... + #"kana"=>{}, # exists... + "identify"=>{}, + ); + LINE: + while () { + my $r=edict_line_parse() or next; + push @R,$r; + keys(%check); + while (my($field,$hashref)=each(%check)) { + my $val; + $val=identify $r if $field eq "identify"; + $val||=$r->{$field}; + next if $val eq "悪い にくい"; # fixup: <20050522015353.GA31030@kashome.dyn.jankratochvil.net> + my $origvalref=\$hashref->{$val}; + warn "field{$field} check duplicity: ".identify($r,"at"=>1)." vs. ".identify($$origvalref,"at"=>1) + if $$origvalref; + $$origvalref=$r; + } } + close EDICT or die "close \"$pathname\": $!"; + %identify=map((identify($_)=>$_),@R); } -close EDICT or die "close \"$opt_edict\": $!"; -my %identify=map((identify($_)=>$_),@R); +sub log_read($) +{ + my($pathname)=@_; -local *LOG_READ; -if (!open LOG_READ,"<:utf8",$opt_log) { - warn "open \"$opt_log\": $!"; -} else { + local *LOG_READ; + if (!open LOG_READ,"<:utf8",$pathname) { + warn "open \"$pathname\": $!"; + return; + } while () { chomp; # 2002-04-25T21:17:52+0900 ok=1: identify($r) @@ -196,10 +235,20 @@ if (!open LOG_READ,"<:utf8",$opt_log) { "ok"=>$ok, }; } - close LOG_READ or die "close \"$opt_log\": $!"; + close LOG_READ or die "close \"$pathname\": $!"; } -reschedule $opt_debug>=2; # init +sub wrong_read() +{ + while (<>) { + print if $opt_tee; + chomp; + my $w=edict_line_parse() or next; + my $r=$identify{identify $w}; + do { warn "'wrong word' not found for the line: $_\n"; $errors_wait_key_count++; next; } if !$r; + result $r,"kana",0; + } +} sub to_chk($$) { @@ -221,6 +270,57 @@ sub word_out($) return join("",map("$_/",@$s)); } +sub exam() +{ + my @exam=keys(%exam); + for (;;) { + reschedule() if !$opt_fast; + my $besthashref=best(); + my $r=$besthashref->{"r"}; + my $exam_from=$besthashref->{"exam_from"}; + my $exam_to=$exam{$exam_from}{"to"}; + print word_out($r->{$exam_from}).": "; + my $got=; + chomp $got; + my $want=$r->{$exam_to}; + print "-------> ".word_out($want)."\n"; + my $got_chk=to_chk($got,$exam_to); + my @want_chk=map(to_chk($_,$exam_to),map((!ref($_)?$_:@$_),$want)); + my $ok; + my $substr; + for my $want_chk (@want_chk) { + next if !$want_chk; # discard patterns like: /(P)/ + $ok=1 if $got_chk eq $want_chk; + $substr=1 if $want_chk=~/\Q$got_chk\E/; + } + if (!$ok) { + if ($exam_to eq "english" && $got=~/\S/ && $substr) { + my $key; + do { + print STDERR "Is your answer correct? [y/n] "; + sub restore + { + Term::ReadKey::ReadMode(0); + } + local $SIG{"__DIE__"}=\&restore; + Term::ReadKey::ReadMode(4); + $key=Term::ReadKey::ReadKey(0); + print STDERR "\n"; # no echo + restore(); + die if $key eq "\x03"; # ctrl-c + $ok=1 if $key eq "y"; + $ok=0 if $key eq "n"; + } while (!defined $ok); + } + } + $ok||=0; + print STDERR "result: ".($ok ? "ok" : "WRONG"); + result $r,$exam_from,$ok; + print "\n"; + print STDERR join(" * ",map("WRONG",1..8))."\n" if !$ok; + } +} + # FIXME: balanced $exam_from: # my $exam_prob_sum=0; # $exam_prob_sum+=$_->{"prob"} for values(%exam); @@ -236,50 +336,12 @@ sub word_out($) # } # die "INTERNAL" if !$exam_from; # } -my @exam=keys(%exam); -for (;;) { - reschedule() if !$opt_fast; - my $besthashref=best(); - my $r=$besthashref->{"r"}; - my $exam_from=$besthashref->{"exam_from"}; - my $exam_to=$exam{$exam_from}{"to"}; - print word_out($r->{$exam_from}).": "; - my $got=; - chomp $got; - my $want=$r->{$exam_to}; - print "-------> ".word_out($want)."\n"; - my $got_chk=to_chk($got,$exam_to); - my @want_chk=map(to_chk($_,$exam_to),map((!ref($_)?$_:@$_),$want)); - my $ok; - my $substr; - for my $want_chk (@want_chk) { - next if !$want_chk; # discard patterns like: /(P)/ - $ok=1 if $got_chk eq $want_chk; - $substr=1 if $want_chk=~/\Q$got_chk\E/; - } - if (!$ok) { - if ($exam_to eq "english" && $got=~/\S/ && $substr) { - my $key; - do { - print STDERR "Is your answer correct? [y/n] "; - sub restore - { - Term::ReadKey::ReadMode(0); - } - local $SIG{"__DIE__"}=\&restore; - Term::ReadKey::ReadMode(4); - $key=Term::ReadKey::ReadKey(0); - print STDERR "\n"; # no echo - restore(); - die if $key eq "\x03"; # ctrl-c - $ok=1 if $key eq "y"; - $ok=0 if $key eq "n"; - } while (!defined $ok); - } - } - $ok||=0; - print STDERR "result: ".($ok ? "ok" : "WRONG"); - result $r,$exam_from,$ok; - print "\n"; - print STDERR join(" * ",map("WRONG",1..8))."\n" if !$ok; -} + +edict_read $opt_edict; + +do { wrong_read(); exit; } if $opt_wrong; + +log_read $opt_log; +reschedule $opt_debug>=2; # init + +exam();