Last active
December 15, 2015 08:29
-
-
Save pstuifzand/5231288 to your computer and use it in GitHub Desktop.
Build a datastructure from a DSL, calculate and display totals for each subheader.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
"Totaal" | |
"Omzet totaal excl" | |
"Omzet hoog tarief" [field=subtotaal_hoog] | |
"Omzet laag tarief" [field=subtotaal_laag] | |
"Omzet nultarief (0%)" [field=subtotaal_geen] | |
"Btw totaal" | |
"Btw hoog tarief" [field=btw_hoog] | |
"Btw laag tarief" [field=btw_laag] | |
"Verzendkosten" [field=vrachtkosten] |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package MonthTotals; | |
use 5.010; | |
use strict; | |
use Marpa::R2; | |
use Data::Dumper; | |
sub new { | |
my ($class) = @_; | |
my $self = bless { | |
grammar => Marpa::R2::Scanless::G->new({ | |
action_object => 'MonthTotals::Actions', | |
default_action => '::array', | |
source => \<<'SOURCE', | |
:start ::= lines | |
lines ::= line+ separator => newline proper => 0 | |
line ::= indents label_spec | |
| label_spec action => do_root | |
label_spec ::= label ws '[field=' value ']' | |
| label | |
indents ~ [ \t]* | |
newline ~ [\n] | |
label ~ ["] label_in ["] | |
label_in ~ [^"]+ | |
value ~ [\w]+ | |
ws ~ [ ]+ | |
SOURCE | |
}), | |
}, $class; | |
return $self; | |
} | |
sub parse { | |
my ($self, $input) = @_; | |
my $re = Marpa::R2::Scanless::R->new({ grammar => $self->{grammar} }); | |
$re->read(\$input); | |
my $t = $re->value; | |
return $$t; | |
} | |
package MonthTotals::Actions; | |
sub new { my $class=shift; return bless {}, $class; } | |
sub do_root { | |
shift; | |
return [ "", $_[0] ]; | |
} | |
1; |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
use 5.010; | |
use strict; | |
use File::Slurp 'read_file'; | |
use MonthTotals; | |
# Calculate the sum of the input array | |
sub sum { | |
my $t=0; | |
for (@_) { | |
$t+=$_; | |
} | |
$t; | |
} | |
# propagate values up the tree | |
sub assign_values { | |
my $tree = shift; | |
if (@{$tree->[1]}) { | |
my @val; | |
for (@{$tree->[1]}) { | |
push @val, assign_values($_); | |
} | |
$tree->[0]{value} = \@val; | |
return @val; | |
} | |
return @{$tree->[0]{value}}; | |
} | |
# build a list from a tree | |
sub make_list { | |
my $tree = shift; | |
if (@{$tree->[1]}) { | |
my @val = ($tree->[0]); | |
for (@{$tree->[1]}) { | |
push @val, make_list($_); | |
} | |
return @val; | |
} | |
return $tree->[0]; | |
} | |
# build a tree from a list | |
sub list { | |
my ($value_cb, $list) = @_; | |
return if @$list == 0; | |
my $x = shift @$list; | |
my @in; | |
while (@$list) { | |
my $v = $list->[0]; | |
last if $value_cb->($v) <= $value_cb->($x); | |
shift @$list; | |
push @in, $v; | |
} | |
return [$x, [list($value_cb, \@in)]], list($value_cb, $list); | |
} | |
my $m = MonthTotals->new; | |
use Data::Dumper; | |
my $input = read_file('monthtotal.txt'); | |
my $v = $m->parse($input); | |
my @spec; | |
my %ws_lengths; | |
# Convert the input to a list of spec lines | |
for my $line (@$v) { | |
my $indent = length $line->[0]; | |
$ws_lengths{$indent} = 1; | |
my @line = @{$line->[1]}; | |
my $s = {}; | |
$s->{ws_length} = $indent; | |
$s->{label} = $line[0]; | |
$s->{label} =~ s/^"//; | |
$s->{label} =~ s/"$//; | |
$s->{value} = [$line[3]]; | |
push @spec, $s; | |
} | |
# Find a indent level for each whitespace size | |
my $indent_count = 0; | |
my %indent_for_ws; | |
for (sort { $a <=> $b } keys %ws_lengths) { | |
$indent_for_ws{$_} = $indent_count++; | |
} | |
# Find the maximum indent used | |
my $max_indent = $indent_count - 1; | |
# Set the indent level for each spec line | |
# Calculate the number of levels at the end of each line | |
for my $s (@spec) { | |
$s->{indents} = $indent_for_ws{$s->{ws_length}}; | |
$s->{indents_after} = $max_indent - $s->{indents}; | |
} | |
# Propagate the values of the child fields up the tree | |
my $tree = [list(sub { return $_[0]->{indents} }, \@spec)]; | |
assign_values($tree->[0]); | |
my @list = make_list($tree->[0]); | |
# Input data | |
my $input = { | |
btw_hoog => 21, | |
btw_laag => 6, | |
subtotaal_hoog => 100, | |
subtotaal_laag => 100, | |
subtotaal_geen => 0, | |
vrachtkosten => 100, | |
}; | |
# Output | |
for (@list) { | |
my $indent=("\t"x$_->{indents}); | |
my $indenta=("\t"x$_->{indents_after}); | |
say(sprintf('%s%-40s%s%8d', $indent, $_->{label}, $indent, sum(map{$input->{$_}}@{$_->{value}}))); | |
} | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment