From 4f765cd5e9bea2674870f63eccea57cff3f4eefc Mon Sep 17 00:00:00 2001
From: "hieda_kyuko@hpr" <ugo58956@protonmail.com>
Date: Fri, 25 Apr 2025 10:25:24 +0200
Subject: [PATCH] PoC: file input & CR/LF support
---
src/oud2_parser.pl | 234 ++++++++++++++++++++++++---------------------
1 file changed, 123 insertions(+), 111 deletions(-)
diff --git a/src/oud2_parser.pl b/src/oud2_parser.pl
index 231ccc8..a2ce0ab 100644
--- a/src/oud2_parser.pl
+++ b/src/oud2_parser.pl
@@ -11,8 +11,6 @@ BEGIN
unshift @INC, './lib';
}
-# load App::Ts;
-
use FindBin;
use File::Spec;
use lib File::Spec -> catdir ($FindBin::Bin, '..', 'lib');
@@ -24,8 +22,117 @@ use Nice::Try;
use Marpa::R2;
-open my $diaf, '<', "tests/dia/konpoku.oud2";
-read $diaf, my $diah, -s $diaf;
+package Dia;
+use Data::Dumper;
+
+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::list_of_ts
+{
+ shift;
+ print "Making list of ts...\n";
+ return \@_;
+}
+
+sub Dia::list_of_eki
+{
+ # TODO use Eki objects
+ 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_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]; }
+
+
+package main;
+
+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;
+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;
@@ -66,9 +173,12 @@ ROSEN_NAME ::= 'Rosenmei=' NAME
EKI_ALL ::= EKI_STRUCT+
action => Dia::list_of_eki
-EKI_STRUCT ::= EKI_BEGIN EKI_NAME GARBAGE_LINES
+EKI_STRUCT ::= EKI_BEGIN
+ EKI_NAME
+ GARBAGE_LINES
action => Dia::second
-EKI_BEGIN ::= 'Eki.'
+:lexeme ~ EKI_BEGIN priority => 7
+EKI_BEGIN ~ 'Eki.'
EKI_NAME ::= 'Ekimei=' NAME
action => Dia::second
@@ -97,7 +207,8 @@ BANGOU_LINE ::= 'Ressyabangou=' NAME
action => Dia::return_name
RESSYA_MEI ::= MEI_STRUCT*
action => ::first
-MEI_STRUCT ::= MEI_LINE GOU_LINE
+MEI_STRUCT ::= MEI_LINE
+ GOU_LINE
action => Dia::format_mei
MEI_LINE ::= 'Ressyamei=' NAME
action => Dia::return_name
@@ -107,22 +218,16 @@ GOUSUU ::= 'Gousuu=' NAME
action => Dia::return_name
RESSYA_JIKOKU ::= 'EkiJikoku=' JIKOKU
action => Dia::second
-JIKOKU ::= TS_TIMESTAMPS TS_TIMESTAMP_FINAL
+JIKOKU ::= TS_TIMESTAMPS
+ TS_TIMESTAMP_FINAL
action => Dia::ts_combine
-# TS_TIMESTAMPS ::= TS_TIMESTAMP TS_SEP TS_TIMESTAMPS || TS_TIMESTAMP
- # action => ::first
- # action => Dia::list_of_ts
- # separator => TS_SEP
- # proper => 1
-
# 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
# separator => COMMA
# proper => 1
-# TS_TIMESTAMP ::= TS_TIMESTAMP_STRUCT
-# action => ::first
TS_TIMESTAMP ::= TS_TIMESTAMP_STRUCT COMMA
action => ::first
TS_TIMESTAMP_FIRST ::= TS_TIMESTAMP_STRUCT
@@ -161,7 +266,7 @@ TS_SEP_CHAKU ~ [/]
TS_INT ~ [\d]+
VERSIONING ::= NAME
-NAME ~ [^\n]*
+NAME ~ [^\v]*
Rest ::= action => ::undef
Rest ::= GARBAGE action => ::undef
@@ -169,105 +274,12 @@ Rest ::= GARBAGE action => ::undef
GARBAGE ~ [\s\S]+
:lexeme ~ GARBAGE_LINE priority => -99999999
GARBAGE_LINES ::= GARBAGE_LINE*
-GARBAGE_LINE ~ [^\n]*
+GARBAGE_LINE ~ [^\v]*
:discard ~ [\s]
endrule
;
-
-package Dia;
-use Data::Dumper;
-
-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::list_of_ts
-{
- shift;
- print "Making list of ts...\n";
- return \@_;
-}
-
-sub Dia::list_of_eki
-{
- # TODO use Eki objects
- shift;
- print Dumper \@_;
- 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_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]; }
-
-
-package main;
-
my $diag = Marpa::R2::Scanless::G->new(
{
source => \$diar,
--
GitLab