Refactor

lib/App/Dia.pm

+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;

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';