95 lines
2.1 KiB
Perl
95 lines
2.1 KiB
Perl
# SPDX-FileCopyrightText: 2022 Stephan Barth <barths@gate2.tcs.ifi.lmu.de>
|
|
#
|
|
# SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
package WFparse;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
sub parsefile {
|
|
my $fn = shift;
|
|
my $fh = undef;
|
|
open($fh, '<', $fn) or die "Could not read '$fn', because: $!\n";
|
|
my @cont = <$fh>;
|
|
chomp for @cont;
|
|
return parselines(@cont);
|
|
}
|
|
|
|
sub parselines {
|
|
my @cont = @_;
|
|
my %node = ();
|
|
my $name = undef;
|
|
my $edgeto = undef;
|
|
my $state = "init";
|
|
my $source = undef;
|
|
my @linebuffer_master = ();
|
|
my @linebuffer_edges = ();
|
|
my %edges = ();
|
|
my $consumeedge = sub {
|
|
return if $state eq 'node-edges';
|
|
return unless $state =~ m/^node-edges/;
|
|
$edges{$edgeto} = {lines=>[@linebuffer_edges],source=>$source};
|
|
$source = undef;
|
|
@linebuffer_edges = ();
|
|
$edgeto = undef;
|
|
};
|
|
my $finalizenode = sub {
|
|
return if $state eq 'init';
|
|
$consumeedge->();
|
|
$node{$name}={
|
|
lines=>[@linebuffer_master],
|
|
edges=>{%edges},
|
|
};
|
|
@linebuffer_master = ();
|
|
%edges = ();
|
|
$name=undef;
|
|
};
|
|
for my $i(0..$#cont) {
|
|
my $l = $cont[$i];
|
|
do {push @linebuffer_master, $l;next} if $l=~m/^\s*(?:#.*)?$/;
|
|
$l=~m#^"(.*)":$# and do {
|
|
$finalizenode->();
|
|
$state = 'node-master';
|
|
$name = $1;
|
|
next;
|
|
};
|
|
$state eq 'node-master' && $l=~m#^ edges:$# and do {
|
|
$state = 'node-edges';
|
|
next;
|
|
};
|
|
$state=~m/^node-edges/ && $l=~m/^ "(.*)":/ and do {
|
|
my $ename = $1;
|
|
$consumeedge->();
|
|
$edgeto = $ename;
|
|
$state = "node-edges-inedge";
|
|
next;
|
|
};
|
|
$state=~m/node-edges/ && $l=~m/^ source: "(.*)"/ and do {
|
|
$source = $1;
|
|
next;
|
|
};
|
|
$state=~m/node-edges/ && $l=~m/^ (.*)/ and do {
|
|
push @linebuffer_edges, $1;
|
|
next;
|
|
};
|
|
$state=~m/node-edges/ && $l=~m/^ (.*)/ and do {
|
|
my $read = $1;
|
|
$consumeedge->();
|
|
$state = "node-master";
|
|
push @linebuffer_master, $read;
|
|
next;
|
|
};
|
|
$state=~m/node-master/ && $l=~m/^ (.*)/ and do {
|
|
push @linebuffer_master, $1;
|
|
next;
|
|
};
|
|
die "Unexpeced line in state $state: $l (line ".($i+1).")\n";
|
|
}
|
|
return (\%node);
|
|
}
|
|
|
|
|
|
|
|
1;
|