[LIB] Move last bits of Plumage-specific functionality from Util to Plumage::Util
[parrot-plumage:parrot-plumage.git] / src / lib / Plumage / Util.nqp
1 =begin
2
3 =head1 NAME
4
5 Pluamge::Util - Plumage-specific utility functions
6
7 =head1 SYNOPSIS
8
9     # Load this library
10     pir::load_bytecode('src/lib/Plumage/Util.pbc');
11
12     # Plumage-specific
13     $replaced := replace_config_strings($original);
14
15
16 =head1 DESCRIPTION
17
18 These utility functions are likely only directly useful to Plumage-related
19 programs, unlike the more general utility functions provided by
20 F<src/lib/Util.nqp>.
21
22 =over 4
23
24 =item $replaced := replace_config_strings($original)
25
26 Replace all config strings (marked as C<#config_var_name#>) within the
27 C<$original> string with replacements found in one of the global
28 configuration hashes. These are searched in the following order:
29
30     %*CONF        # Plumage configuration
31     %*VM<config>  # VM (Parrot) configuration
32     %*BIN         # Locations of system programs
33     %*ENV         # Program environment
34
35 If no replacement is found in any of the above, an empty string is used
36 instead.
37
38 C<replace_config_strings()> will do a full pass replacing all config strings
39 within the original, and then loop back to the beginning and try again with
40 the updated string.  This continues until the string stops changing.  This
41 allows configuration settings to be defined in terms of other configuration
42 settings.
43
44 B<NOTE> that this function is currently B<NOT> protected from an infinite loop
45 caused by bad config settings, nor is it protected from nefarious inputs
46 producing unintended expansions.
47
48 =end
49
50 sub replace_config_strings ($original) {
51     my $new := $original;
52
53     repeat {
54         $original := $new;
55         $new      := subst($original, /\#<ident>\#/, config_value);
56     }
57     while $new ne $original;
58
59     return $new;
60 }
61
62 sub config_value ($match) {
63     my $key    := $match<ident>;
64     my $config := %*CONF{$key}
65                || %*VM<config>{$key}
66                || %*BIN{$key}
67                || %*ENV{$key}
68                || '';
69
70     return $config;
71 }
72
73
74 =begin
75
76 =back
77
78 =end