Skip to content
Extraits de code Groupes Projets
Valider 4f765cd5 rédigé par hieda_kyuko@hpr's avatar hieda_kyuko@hpr
Parcourir les fichiers

PoC: file input & CR/LF support

parent eac4b93e
Aucune branche associée trouvée
Aucune étiquette associée trouvée
Aucune requête de fusion associée trouvée
......@@ -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,
......
0% Chargement en cours ou .
You are about to add 0 people to the discussion. Proceed with caution.
Veuillez vous inscrire ou vous pour commenter