diff --git a/lib/App/Dia.pm b/lib/App/Dia.pm new file mode 100644 index 0000000000000000000000000000000000000000..3fd8e418f79ac4aa956fc397c42e30d4fa521bf2 --- /dev/null +++ b/lib/App/Dia.pm @@ -0,0 +1,144 @@ +package Dia; +use strict; +use warnings; + +use Data::Dumper; + +sub dummy { return " yay!"; } +sub dump +{ + print "Contents dumped: "; + print Dumper \@_; +} + +sub second { shift; return $_[1]; } + +sub get_int +{ + shift; + return join('', @_); +} + +sub begin_header_section { print "Entering header section.\n"; } +sub begin_rosen_section { print "Entering line section.\n"; } +sub begin_dia_section { print "Entering diagram section.\n"; } +sub dia_down_subsection { print "Going down.\n"; } +sub dia_up_subsection { print "Going up.\n"; } + +# Convert a TS_TIMESTAMP into a Perl hash +sub hash_of_ts_not { shift; my $q = {"mode" => 0, + "chaku" => undef, + "hatsu" => undef,}; return $q; } +sub hash_of_ts_nil { shift; my $q = {"mode" => $_[0], + "chaku" => undef, + "hatsu" => undef,}; return $q; } +sub hash_of_ts_arr { shift; my $q = {"mode" => $_[0], + "chaku" => $_[2], + "hatsu" => undef,}; return $q; } +sub hash_of_ts_dep { shift; my $q = {"mode" => $_[0], + "chaku" => undef, + "hatsu" => $_[2],}; return $q; } +sub hash_of_ts_ad { shift; my $q = {"mode" => $_[0], + "chaku" => $_[2], + "hatsu" => $_[4],}; return $q; } +sub take_all +{ + shift; + return \@_; +} + +sub ts_combine +{ + shift; + my @ts = @{$_[0]}; + my @res = (); + + for (my $i = 0; $i < scalar @ts; $i++) + { + push @res, $ts[$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 format_syubetsu +{ + shift; + my %syubetsu; + + $syubetsu{'name'} = $_[0]; + $syubetsu{'ryaku'} = $_[1]; + return \%syubetsu; +} + +sub format_ressya +{ + shift; + my %ressya; + + $ressya{'syubetsu'} = $_[2]; + $ressya{'bangou'} = defined $_[3] ? $_[3] : "[no number]"; + $ressya{'meisyo'} = $_[4]; + $ressya{'jikoku'} = $_[5]; + + return \%ressya; +} + +sub debug_ressya +{ + shift; + print Dumper(\@_); + print "Found (" . $_[2] . ") train "; + defined $_[3] ? print $_[3] : print "[no number]"; + print ", " . $_[4] if defined $_[4]; + print "\n"; + Ts::debug_train_info $_[5]; + print "\n"; +} + +sub format_mei +{ + shift; + my $final = $_[0]; + $final = $final . " " . $_[1] if defined $_[1]; + return $final; +} + +sub return_name { shift; return $_[1]; } + +sub concat_dia +{ + shift; shift; shift; + # TODO add support for multiple diagrams + my %dias; + my @dia = @_; + + $dias{'kudari'} = $dia[0]; + $dias{'nobori'} = $dia[1]; + return \%dias; +} + +sub frame +{ + shift; shift; + my %frame; + # print Dumper \@_; + my @data = @_; + + $frame{'rosen'} = $data[0]; + $frame{'eki'} = $data[1]; + + my @ekis = @{ $frame{'eki'} }; + $frame{'eki_num'} = scalar @ekis; + + $frame{'syubetsu'} = $data[2]; + $frame{'dia'} = $data[3]; + + return \%frame; +} + +1; diff --git a/src/oud2_parser.pl b/src/oud2_parser.pl index 67248a9b7ccbac218ce71d3f9e5c7d03a2b48d68..c3e030ca2fcda48e55a2a6ccf9df5b2069b663c0 100644 --- a/src/oud2_parser.pl +++ b/src/oud2_parser.pl @@ -6,6 +6,7 @@ use autodie 'open'; use strict; use warnings; use feature 'unicode_strings'; +use open qw( :std :encoding(UTF-8) ); binmode(STDOUT, ":encoding(UTF-8)"); @@ -18,157 +19,17 @@ use FindBin; use File::Spec; use lib File::Spec -> catdir ($FindBin::Bin, '..', 'lib'); -use App::Ts; - use Perl::Critic; use Nice::Try; use Marpa::R2; - - -package Dia; use Data::Dumper; +use File::BOM; -sub Dia::dummy { return " yay!"; } -sub Dia::dump { print Dumper \@_; print "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\n"; } -sub Dia::second { shift; return $_[1]; } - -sub Dia::get_int -{ - shift; - return join('', @_); -} - -sub Dia::begin_header_section { print "Entering header section.\n"; } -sub Dia::begin_rosen_section { print "Entering line section.\n"; } -sub Dia::begin_dia_section { print "Entering diagram section.\n"; } -sub Dia::dia_down_subsection { print "Going down.\n"; } -sub Dia::dia_up_subsection { print "Going up.\n"; } - -# Convert a TS_TIMESTAMP into a Perl hash -sub Dia::hash_of_ts_not { shift; print "Pouet\n"; print Dumper \@_; my $q = {"mode" => 0, - "chaku" => undef, - "hatsu" => undef,}; return $q; } -sub Dia::hash_of_ts_nil { shift; my $q = {"mode" => $_[0], - "chaku" => undef, - "hatsu" => undef,}; return $q; } -sub Dia::hash_of_ts_arr { shift; my $q = {"mode" => $_[0], - "chaku" => $_[2], - "hatsu" => undef,}; return $q; } -sub Dia::hash_of_ts_dep { shift; my $q = {"mode" => $_[0], - "chaku" => undef, - "hatsu" => $_[2],}; return $q; } -sub Dia::hash_of_ts_ad { shift; my $q = {"mode" => $_[0], - "chaku" => $_[2], - "hatsu" => $_[4],}; return $q; } -sub Dia::take_all -{ - shift; - return \@_; -} - -sub Dia::ts_combine -{ - shift; - my @ts = @{$_[0]}; - my @res = (); - - for (my $i = 0; $i < scalar @ts; $i++) - { - push @res, $ts[$i]; - } - - push @res, $_[1]; - return \@res; -} - -sub Dia::print_sta { shift; print "Found station: "; print $_[1]; print "\n"; } -sub Dia::print_line { shift; print "Working on line: "; print $_[1]; print "\n"; } - -sub Dia::format_syubetsu -{ - shift; - my %syubetsu; - - $syubetsu{'name'} = $_[0]; - $syubetsu{'ryaku'} = $_[1]; - return \%syubetsu; -} - -sub Dia::format_ressya -{ - shift; - my %ressya; - - $ressya{'syubetsu'} = $_[2]; - $ressya{'bangou'} = defined $_[3] ? $_[3] : "[no number]"; - $ressya{'meisyo'} = $_[4]; - $ressya{'jikoku'} = $_[5]; - - return \%ressya; -} - -sub Dia::debug_ressya -{ - shift; - print Dumper(\@_); - print "Found (" . $_[2] . ") train "; - defined $_[3] ? print $_[3] : print "[no number]"; - print ", " . $_[4] if defined $_[4]; - print "\n"; - Ts::debug_train_info $_[5]; - print "\n"; -} - -sub Dia::format_mei -{ - shift; - my $final = $_[0]; - $final = $final . " " . $_[1] if defined $_[1]; - return $final; -} - -sub Dia::return_name { shift; return $_[1]; } - -sub Dia::concat_dia -{ - shift; shift; shift; - # TODO add support for multiple diagrams - my %dias; - my @dia = @_; - - $dias{'kudari'} = $dia[0]; - $dias{'nobori'} = $dia[1]; - return \%dias; -} - -sub Dia::frame -{ - shift; shift; - my %frame; - # print Dumper \@_; - my @data = @_; - - $frame{'rosen'} = $data[0]; - $frame{'eki'} = $data[1]; - - my @ekis = @{ $frame{'eki'} }; - $frame{'eki_num'} = scalar @ekis; - - $frame{'syubetsu'} = $data[2]; - $frame{'dia'} = $data[3]; - - return \%frame; -} - - -package main; - +use App::Ts; use App::Ressya; use App::Frame; +use App::Dia; -use Data::Dumper; -use File::BOM; -use open qw( :std :encoding(UTF-8) ); my $dia_path = $ARGV[0]; my $default_path = 'tests/dia/kyogoku.oud2';