+######################################################################
+#
+# Helpers and utility functions
+#
+
+# Configuration file reading #########################################
+
+# Helper function to implement conditional inheritance depending on the
+# value of $no_asm. Used in inherit_from values as follows:
+#
+# inherit_from => [ "template", asm("asm_tmpl") ]
+#
+sub asm {
+ my @x = @_;
+ sub {
+ $no_asm ? () : @x;
+ }
+}
+
+# Helper function to implement adding values to already existing configuration
+# values. It handles elements that are ARRAYs, CODEs and scalars
+sub _add {
+ my $separator = shift;
+
+ # If there's any ARRAY in the collection of values, we will return
+ # an ARRAY of combined values, otherwise a string of joined values
+ # with $separator as the separator.
+ my $found_array = 0;
+
+ my @values =
+ map {
+ if (ref($_) eq "ARRAY") {
+ $found_array = 1;
+ @$_;
+ } else {
+ $_;
+ }
+ } (@_);
+
+ if ($found_array) {
+ [ @values ];
+ } else {
+ join($separator, @values);
+ }
+}
+sub add_before {
+ my $separator = shift;
+ my @x = @_;
+ sub { _add($separator, @x, @_) };
+}
+sub add {
+ my $separator = shift;
+ my @x = @_;
+ sub { _add($separator, @_, @x) };
+}
+
+# configuration reader, evaluates the input file as a perl script and expects
+# it to fill %targets with target configurations. Those are then added to
+# %table.
+sub read_config {
+ my $fname = shift;
+ open(CONFFILE, "< $fname")
+ or die "Can't open configuration file '$fname'!\n";
+ my $x = $/;
+ undef $/;
+ my $content = <CONFFILE>;
+ $/ = $x;
+ close(CONFFILE);
+ my %targets = ();
+ {
+ local %table = %::table; # Protect %table from tampering
+
+ eval $content;
+ warn $@ if $@;
+ }
+
+ # For each target, check that it's configured with a hash table.
+ foreach (keys %targets) {
+ if (ref($targets{$_}) ne "HASH") {
+ if (ref($targets{$_}) eq "") {
+ warn "Deprecated target configuration for $_, ignoring...\n";
+ } else {
+ warn "Misconfigured target configuration for $_ (should be a hash table), ignoring...\n";
+ }
+ delete $targets{$_};
+ }
+ }
+
+ %table = (%table, %targets);
+
+}
+
+# configuration resolver. Will only resolve all the lazy evalutation
+# codeblocks for the chozen target and all those it inherits from,
+# recursively
+sub resolve_config {
+ my $target = shift;
+ my @breadcrumbs = @_;
+
+ if (grep { $_ eq $target } @breadcrumbs) {
+ die "inherit_from loop! target backtrace:\n "
+ ,$target,"\n ",join("\n ", @breadcrumbs),"\n";
+ }
+
+ if (!defined($table{$target})) {
+ warn "Warning! target $target doesn't exist!\n";
+ return ();
+ }
+ # Recurse through all inheritances. They will be resolved on the
+ # fly, so when this operation is done, they will all just be a
+ # bunch of attributes with string values.
+ # What we get here, though, are keys with references to lists of
+ # the combined values of them all. We will deal with lists after
+ # this stage is done.
+ my %combined_inheritance = ();
+ if ($table{$target}->{inherit_from}) {
+ my @inherit_from =
+ map { ref($_) eq "CODE" ? $_->() : $_ } @{$table{$target}->{inherit_from}};
+ foreach (@inherit_from) {
+ my %inherited_config = resolve_config($_, $target, @breadcrumbs);
+
+ # 'template' is a marker that's considered private to
+ # the config that had it.
+ delete $inherited_config{template};
+
+ map {
+ if (!$combined_inheritance{$_}) {
+ $combined_inheritance{$_} = [];
+ }
+ push @{$combined_inheritance{$_}}, $inherited_config{$_};
+ } keys %inherited_config;
+ }
+ }
+
+ # We won't need inherit_from in this target any more, since we've
+ # resolved all the inheritances that lead to this
+ delete $table{$target}->{inherit_from};
+
+ # Now is the time to deal with those lists. Here's the place to
+ # decide what shall be done with those lists, all based on the
+ # values of the target we're currently dealing with.
+ # - If a value is a coderef, it will be executed with the list of
+ # inherited values as arguments.
+ # - If the corresponding key doesn't have a value at all or is the
+ # emoty string, the inherited value list will be run through the
+ # default combiner (below), and the result becomes this target's
+ # value.
+ # - Otherwise, this target's value is assumed to be a string that
+ # will simply override the inherited list of values.
+ my $default_combiner = add(" ");
+
+ my %all_keys =
+ map { $_ => 1 } (keys %combined_inheritance,
+ keys %{$table{$target}});
+ foreach (sort keys %all_keys) {
+
+ # Current target doesn't have a value for the current key?
+ # Assign it the default combiner, the rest of this loop body
+ # will handle it just like any other coderef.
+ if (!exists $table{$target}->{$_}) {
+ $table{$target}->{$_} = $default_combiner;
+ }
+
+ my $valuetype = ref($table{$target}->{$_});
+ if ($valuetype eq "CODE") {
+ # CODE reference, execute it with the inherited values as
+ # arguments.
+ $table{$target}->{$_} =
+ $table{$target}->{$_}->(@{$combined_inheritance{$_}});
+ } elsif ($valuetype eq "ARRAY" || $valuetype eq "") {
+ # ARRAY or Scalar, just leave it as is.
+ } else {
+ # Some other type of reference that we don't handle.
+ # Better to abort at this point.
+ die "cannot handle reference type $valuetype,"
+ ," found in target $target -> $_\n";
+ }
+ }
+
+ # Finally done, return the result.
+ return %{$table{$target}};
+}
+