PoC: frame building & information

0ca205ef · hieda_kyuko@hpr · 2200ed1c · 0ca205ef · 0ca205ef · 0ca205ef
--- a/lib/App/Frame.pm
+++ b/lib/App/Frame.pm
+package Frame;
+
+use strict;
+use warnings;
+
+use Data::Dumper;
+
+sub debug_frame
+{
+    my %frame = %{ $_[0] };
+    print Dumper \%frame;
+}
+
+sub frame_info
+{
+    my %frame = %{ $_[0] };
+    print "Frame for line $frame{'rosen'}:\n";
+    print ". $frame{'eki_num'} stations\n";
+    print ". " . scalar @{ $frame{'syubetsu'} } . " service types\n";
+    print ". " . scalar @{ $frame{'dia'}{'kudari'} } . " down services\n";
+    print ". " . scalar @{ $frame{'dia'}{'nobori'} } . " up services\n";
+}
+
+1;
--- a/lib/App/Ressya.pm
+++ b/lib/App/Ressya.pm
+package Ressya;
+
+use strict;
+use warnings;
+
+use Data::Dumper;
+
+sub kukan
+{
+    my @jikoku = @{ $_[0]{'jikoku'} };
+    my $start = 0;
+    my $end;
+    my %res;
+
+    while (!defined $jikoku[0])
+    {
+	shift @jikoku;
+	$start++;
+    }
+
+    $end = $start;
+    while (defined $jikoku[0])
+    {
+	shift @jikoku;
+	$end++;
+    }
+
+    $res{'start'} = $start;
+    $res{'end'} = $end;
+    
+    return \%res;
+}
+
+1;
--- a/src/oud2_parser.pl
+++ b/src/oud2_parser.pl
 #!/usr/bin/perl
 use Module::Load;

+use utf8;
 use autodie 'open';
 use strict;
 use warnings;
 use feature 'unicode_strings';

+binmode(STDOUT, ":encoding(UTF-8)");
+
 BEGIN
 {
    unshift @INC, './lib';
@@ -57,16 +60,8 @@ sub Dia::hash_of_ts_dep { shift; my $q = {"mode" => $_[0],
 sub Dia::hash_of_ts_ad { shift; my $q = {"mode" => $_[0],
 					"chaku" => $_[2],
 					"hatsu" => $_[4],}; return $q; }
-sub Dia::list_of_ts
-{
-    shift;
-    print "Making list of ts...\n";
-    return \@_;
-}
-
-sub Dia::list_of_eki
+sub Dia::take_all
 {
-    # TODO use Eki objects
    shift;
    return \@_;
 }
@@ -88,7 +83,31 @@ sub Dia::ts_combine

 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(\@_);
@@ -110,14 +129,47 @@ sub Dia::format_mei

 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::Ressya;
+use App::Frame;
+
 use Data::Dumper;
 use File::BOM;
 use open qw( :std :encoding(UTF-8) );

-print Dumper \@ARGV;
 my $dia_path = $ARGV[0];
 my $default_path = 'tests/dia/kyogoku.oud2';
 my $dia_file;
@@ -143,7 +195,9 @@ lexeme default = latm => 1
 ALL			::= HEADER_SECTION
 			    ROSEN_SECTION
 			    EKI_SECTION
+			    SYUBETSU_SECTION
 			    DIA_SECTION
+			    action => Dia::frame


 HEADER_SECTION 	 	::= HEADER_BEGIN
@@ -151,17 +205,24 @@ HEADER_SECTION 	 	::= HEADER_BEGIN
 ROSEN_SECTION	        ::= ROSEN_BEGIN
 			    ROSEN_NAME
 			    GARBAGE_LINES
+			    action => Dia::second
 EKI_SECTION	       	::= EKI_ALL
+			    action => ::first
+SYUBETSU_SECTION	::= SYUBETSU_ALL
+			    action => ::first
 DIA_SECTION	        ::= DIA_BEGIN
 			    GARBAGE_LINES
 			    DIA_DOWN_SECTION
 			    DIA_UP_SECTION
+			    action => Dia::concat_dia
 DIA_DOWN_SECTION	::= DIA_DOWN_BEGIN
 			    RESSYAS
 			    GARBAGE_LINES
+			    action => Dia::second
 DIA_UP_SECTION		::= DIA_UP_BEGIN
 			    RESSYAS
 			    GARBAGE_LINES
+			    action => Dia::second


 HEADER_BEGIN	      	::= 'FileType='
@@ -169,10 +230,10 @@ HEADER_BEGIN	      	::= 'FileType='

 ROSEN_BEGIN		::= 'Rosen.'
 ROSEN_NAME		::= 'Rosenmei=' NAME
-			    action => Dia::print_line
+			    action => Dia::second

 EKI_ALL			::= EKI_STRUCT+
-			    action => Dia::list_of_eki
+			    action => Dia::take_all
 EKI_STRUCT     		::= EKI_BEGIN
 			    EKI_NAME
 			    GARBAGE_LINES
@@ -182,6 +243,21 @@ EKI_BEGIN	       	~ 'Eki.'
 EKI_NAME		::= 'Ekimei=' NAME
 			    action => Dia::second

+SYUBETSU_ALL		::= SYUBETSU_STRUCT+
+			    action => Dia::take_all
+SYUBETSU_STRUCT		::= SYUBETSU_BEGIN
+			    SYUBETSU_SUB
+			    GARBAGE_LINES
+			    action => Dia::second
+SYUBETSU_SUB		::= SYUBETSU_NAME
+			    SYUBETSU_RYAKU
+			    action => Dia::format_syubetsu
+SYUBETSU_BEGIN 		~ 'Ressyasyubetsu.'
+SYUBETSU_NAME		::= 'Syubetsumei=' NAME
+			    action => Dia::second
+SYUBETSU_RYAKU		::= 'Ryakusyou=' NAME
+			    action => Dia::second
+
 DIA_BEGIN		::= 'Dia.'
 			    action => Dia::begin_dia_section
 DIA_DOWN_BEGIN		::= 'Kudari.'
@@ -190,6 +266,7 @@ DIA_UP_BEGIN		::= 'Nobori.'
 			    action => Dia::dia_up_subsection

 RESSYAS			::= RESSYA+
+			    action => Dia::take_all
 RESSYA			::= 'Ressya.'
 			    GARBAGE_LINE
 			    RESSYA_TYPE
@@ -200,22 +277,22 @@ RESSYA			::= 'Ressya.'
 			    action => Dia::format_ressya
 			   
 RESSYA_TYPE		::= 'Syubetsu=' NAME
-			    action => Dia::return_name
+			    action => Dia::second
 RESSYA_BANGOU		::= BANGOU_LINE*
 			    action => ::first
 BANGOU_LINE		::= 'Ressyabangou=' NAME
-			    action => Dia::return_name
+			    action => Dia::second
 RESSYA_MEI		::= MEI_STRUCT*
 			    action => ::first
 MEI_STRUCT		::= MEI_LINE
 			    GOU_LINE
 			    action => Dia::format_mei
 MEI_LINE		::= 'Ressyamei=' NAME
-			    action => Dia::return_name
+			    action => Dia::second
 GOU_LINE		::= GOUSUU*
 			    action => ::first
 GOUSUU			::= 'Gousuu=' NAME
-			    action => Dia::return_name
+			    action => Dia::second
 RESSYA_JIKOKU		::= 'EkiJikoku=' JIKOKU
 			    action => Dia::second
 JIKOKU			::= TS_TIMESTAMPS
@@ -225,7 +302,7 @@ JIKOKU			::= TS_TIMESTAMPS
 # We make the assumption that a service always ends by a simple arrival timestamp.
 # TODO There are actually more possible end timestamps
 TS_TIMESTAMPS		::= TS_TIMESTAMP+
-			    action => Dia::list_of_ts
+			    action => Dia::take_all
 			    # separator => COMMA
 			    # proper => 1
 TS_TIMESTAMP		::= TS_TIMESTAMP_STRUCT COMMA
@@ -297,16 +374,13 @@ my $recce = Marpa::R2::Scanless::R->new(

 #$diag->read(\$input);

-#print $diag->parse(\"......", 'main');
-#print $diag->parse(\$contents, 'main');
-#print $recce->read(\$contents);
 try { print $recce->read(\$contents); }
-catch ($e) { print "nej\n$e\n" }
-
+catch ($e) { print "Malformation in .oud file.\n$e\n" }
 print "\n";

-print $recce->show_progress();
-
-print $recce->value();
+my %frame = %{ ${$recce->value()} };
+Frame::frame_info \%frame;
+# my $r = $frame{'dia'}{'nobori'}[0];
+# print Ressya::kukan $r;

 close $diah;