1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
#!/usr/bin/env perl
use strict;
use warnings;
use 5.020;
use utf8;
use File::Slurp qw(read_file);
use JSON;
use List::Util qw(uniq);
sub show_usage {
my ($exit_code) = @_;
say STDERR
"Usage: umlauf-to-dot <wagenreihung.json> [line number] [limit] | dot -Tpng > umlauf.png";
exit $exit_code;
}
sub contained_in {
my ( $value, @list ) = @_;
for my $elem (@list) {
if ( $elem eq $value ) {
return 1;
}
}
return;
}
sub format_train {
my ( $train_no, $train ) = @_;
return sprintf( '"%s %d\n%s\n%s"',
$train->{type} // $train->{raw} // 'Zug',
$train_no,
$train->{route}{start} // $train->{route}{preStart} // '?',
$train->{route}{end} // $train->{route}{postEnd} // '?' );
}
binmode( STDOUT, ':encoding(utf-8)' );
if ( @ARGV < 1 ) {
show_usage(1);
}
my ( $file, $line, $limit ) = @ARGV;
my $file_content = read_file($file);
my $json = JSON->new->utf8->decode($file_content);
my $map = $json->{train};
my @train_numbers;
if ($line) {
my @queue = ( [ $line, 0 ] );
while (@queue) {
my ( $train_number, $distance ) = @{ pop @queue };
push( @train_numbers, $train_number );
if ( $limit and $distance > $limit ) {
next;
}
my @candidates;
push( @candidates, @{ $map->{$train_number}{cycle}{from} // [] } );
push( @candidates, @{ $map->{$train_number}{cycle}{to} // [] } );
@candidates = uniq @candidates;
@candidates
= grep { not contained_in( $_, @train_numbers, @queue ) } @candidates;
if (@candidates) {
printf( "# handle %s -> push %s\n",
$train_number, join( " ", @candidates ) );
}
push( @queue, map { [ $_, $distance + 1 ] } @candidates );
}
}
else {
@train_numbers = keys %{$map};
}
my @output;
for my $train_number (@train_numbers) {
for my $from ( @{ $map->{$train_number}{cycle}{from} } ) {
push(
@output,
sprintf( "%s -> %s;",
format_train( $from, $map->{$from} ),
format_train( $train_number, $map->{$train_number} ) )
);
}
for my $to ( @{ $map->{$train_number}{cycle}{to} } ) {
push(
@output,
sprintf( "%s -> %s;",
format_train( $train_number, $map->{$train_number} ),
format_train( $to, $map->{$to} ) )
);
}
}
say "digraph Umlauf {";
say join( "\n", uniq @output );
say "}"
|
