diff --git a/lib/App/Dia.pm b/lib/App/Dia.pm index 3fd8e418f79ac4aa956fc397c42e30d4fa521bf2..6da98cb47324e22ae3b8fcdaf8c17bbd093e309a 100644 --- a/lib/App/Dia.pm +++ b/lib/App/Dia.pm @@ -50,20 +50,25 @@ sub take_all sub ts_combine { shift; - my @ts = @{$_[0]}; + my @tss = @{ $_[0] }; my @res = (); - for (my $i = 0; $i < scalar @ts; $i++) + for (my $i = 0; $i < scalar @tss; $i++) { - push @res, $ts[$i]; + push @res, $tss[$i]; } push @res, $_[1]; return \@res; } -sub print_sta { shift; print "Found station: "; print $_[1]; print "\n"; } -sub print_line { shift; print "Working on line: "; print $_[1]; print "\n"; } +sub get_timestamp +{ + shift; + defined $_[0] + ? return $_[0] + : return hash_of_ts_not; +} sub format_syubetsu { @@ -129,7 +134,7 @@ sub frame # print Dumper \@_; my @data = @_; - $frame{'rosen'} = $data[0]; + $frame{'rosenmei'} = $data[0]; $frame{'eki'} = $data[1]; my @ekis = @{ $frame{'eki'} }; diff --git a/lib/App/Frame.pm b/lib/App/Frame.pm index fa7e77033ca06525964302aed13e62fa203048f4..de9a8c0b410ec18366157749e5f5ed90c689beff 100644 --- a/lib/App/Frame.pm +++ b/lib/App/Frame.pm @@ -14,7 +14,7 @@ sub debug_frame sub frame_info { my %frame = %{ $_[0] }; - print "Frame for line $frame{'rosen'}:\n"; + print "Frame for line $frame{'rosenmei'}:\n"; print ". $frame{'eki_num'} stations\n"; print ". " . scalar @{ $frame{'syubetsu'} } . " service types\n"; print ". " . scalar @{ $frame{'dia'}{'kudari'} } . " down services\n"; diff --git a/lib/App/FrameUtils.pm b/lib/App/FrameUtils.pm index dfa7fa1ad04b114bc3af1f63bdab67c4d4b59197..ab99e8d04fa04d967295783b7eb6ab6fdfe3f497 100644 --- a/lib/App/FrameUtils.pm +++ b/lib/App/FrameUtils.pm @@ -71,11 +71,11 @@ sub hassya_hyou if (!defined $time) { next; } # Format: time (tab) destination (tab) type (with eventual name) my $syubetsu = get_syubetsu \%frame, $data{'syubetsu'}; - print ((Utils::format_time $time) + print Utils::format_time $time . "\tfor " . (get_destination \%frame, \@jikoku, $target_relative, $is_down) . "\t$syubetsu" - ); + ; if (defined $data{'meisyo'}) { print " $data{'meisyo'}"; diff --git a/src/oud2_parser.pl b/src/oud2_parser.pl index 0a49e1792d126d4f26ae8e6af9898098c0ac57b7..b3b6e6f96798188759dc79380609436b5f3bdf12 100644 --- a/src/oud2_parser.pl +++ b/src/oud2_parser.pl @@ -22,8 +22,10 @@ use lib File::Spec -> catdir ($FindBin::Bin, '..', 'lib'); use Perl::Critic; use Nice::Try; use Marpa::R2; -use Data::Dumper; +use Data::Printer; use File::BOM; +use File::Basename; +use Getopt::Long; use App::Ts; use App::Ressya; @@ -31,26 +33,8 @@ use App::Frame; use App::FrameUtils; use App::Dia; - -my $dia_path = $ARGV[0]; -my $default_path = 'tests/dia/kyogoku.oud2'; -my $dia_file; -if (defined $dia_path) -{ - open $dia_file, '<:encoding(UTF-8):via(File::BOM)', $dia_path; -} -else -{ - print "No file has been supplied.\n"; - print "Using default file $default_path.\n"; - open $dia_file, '<:encoding(UTF-8):via(File::BOM)', $default_path; -} - -read $dia_file, my $diah, -s $dia_file; -# TODO refactor -my $contents = $diah; - -my $diar = << 'endrule' +# .oud2 grammar +my $oud_rules = << 'endrule' lexeme default = latm => 1 :start ::= ALL @@ -166,7 +150,7 @@ JIKOKU ::= TS_TIMESTAMPS TS_TIMESTAMPS ::= TS_TIMESTAMP+ action => Dia::take_all TS_TIMESTAMP ::= TS_TIMESTAMP_STRUCT COMMA - action => ::first + action => Dia::get_timestamp TS_TIMESTAMP_STRUCT ::= TS_TIMESTAMP_WITHT action => ::first || TS_TIMESTAMP_NOT @@ -209,32 +193,60 @@ GARBAGE_LINE ~ [^\v]* endrule ; -my $diag = Marpa::R2::Scanless::G->new( +my $oud_grammar = Marpa::R2::Scanless::G->new( { - source => \$diar, + source => \$oud_rules, trace_terminals => 1, } ); -my $recce = Marpa::R2::Scanless::R->new( +my %master; + +my $dias_path = $ARGV[0]; +my $default_path = 'tests/dia/kyogoku.oud2'; +my $root_path = (defined $dias_path) ? $dias_path : '../oud2/'; +my $trains_path = $root_path . 'train/'; + +opendir my $dir, $trains_path or die "Error opening $trains_path"; +my @trains = readdir $dir; +closedir $dir; + +foreach my $file (@trains) +{ + next if ($file =~ /^\.+$/); + + my $dia_file; + # We need to rebuild the recognizer for each file. + # This is actually a Marpa limitation. + my $recce = Marpa::R2::Scanless::R->new( { - grammar => $diag, + grammar => $oud_grammar, trace_terminals => 0, } ); + + my $train_path = $trains_path . $file; + print 'Using file ' . $train_path . "\n"; + open $dia_file, '<:encoding(UTF-8):via(File::BOM)', $train_path; + my $file_name = basename $file; + my $basename = substr $file_name, 0, -5; + print "Route id will be $basename\n"; -#$diag->read(\$input); - -try { print $recce->read(\$contents) . ' bytes read.'; } -catch ($e) { print "Malformation in .oud file.\n$e\n" } -print "\n"; - -my %frame = %{ ${$recce->value()} }; -Frame::frame_info \%frame; -# my $r = $frame{'dia'}{'nobori'}[0]; -# print Ressya::kukan $r; - -FrameUtils::hassya_hyou \%frame, 11; + read $dia_file, my $contents, -s $dia_file; + + try { print $recce->read(\$contents) . ' bytes read.'; } + catch ($e) { print "Malformation in .oud file.\n$e\n" } + print "\n"; + + my %frame = %{ ${$recce->value()} }; + Frame::frame_info \%frame; + + # p %frame; + $master{$basename} = \%frame; + + # FrameUtils::hassya_hyou \%frame, 11; + + close $dia_file; +} -close $diah;