1# See bottom of file for license and copyright information
2
3=pod
4
5---+ package Foswiki::Configure::Value
6
7A Value object is a Foswiki::Configure::Item that represents a single entry
8in a configuration spec i.e. it is the leaf type in a configuration
9model.
10
11Note that this object does *not* store the actual value of a configuration
12item. This object is the *model* only.
13
14---++ Value Attributes
15Values may have attributes associated with them in the .spec file. These
16attributes are identified by UPPERCASE names and may be either:
17
18   * boolean - a single name enables the option, for example EXPERT
19   * string - a name followed by an equals sign, followed by a quoted string
20     (single or double quotes both supported) for example LABEL="Wibble".
21    (see also &&& below)
22
23The special prefix 'NO' on any attribute name will clear the value of
24that attributes.
25
26&&& In support of older .spec files, the following are also supported (though
27their usage is deprecated):
28
29   * Single-character attribute H. This is synonymous with HIDDEN.
30   * Single-character attribute M is ignored.
31   * Unquoted attribute values - DISPLAY_IF and ENABLE_IF may be followed by a
32     a space, and terminated by /DISPLAY_IF (or /ENABLE_IF) or the end of
33     the string.
34
35Certain attributes define a 'delegate' that allows further parsing of the
36value of an attribute. A delegate is a ref to a function that performs
37this parsing. Delegates are responsible for directly modifying the item
38on which they are run.
39
40Execution of delegates may be supressed by setting
41$Foswiki::Configure::LoadSpec::RAW_VALS to 1.
42
43Delegates are used to parse 'FEEDBACK' and 'CHECK' values.
44
45=cut
46
47package Foswiki::Configure::Value;
48
49use strict;
50use warnings;
51
52use Data::Dumper ();
53
54use Assert;
55
56use Foswiki::Configure::Item ();
57our @ISA = ('Foswiki::Configure::Item');
58
59use Foswiki::Configure::FileUtil ();
60use Foswiki::Configure::Reporter ();
61
62# Options valid in a .spec for a leaf value
63use constant ATTRSPEC => {
64    CHECK           => { handler   => '_CHECK' },
65    CHECKER         => {},
66    CHECK_ON_CHANGE => {},
67    DISPLAY_IF      => { openclose => 1 },
68    ENABLE_IF       => { openclose => 1 },
69    EXPERT          => {},
70    FEEDBACK        => { handler   => '_FEEDBACK' },
71    HIDDEN          => {},
72    MULTIPLE        => {},         # Allow multiple select
73    SPELLCHECK      => {},
74    LABEL           => {},
75    ONSAVE          => {},         # Call Checker->onSave() when set.
76
77    # Rename single character options (legacy)
78    H => 'HIDDEN',
79    M => { handler => '_MANDATORY' }
80};
81
82# Legal options for a CHECK. The number indicates the number of expected
83# parameters; -1 means '0 or more'
84our %CHECK_options = (
85    also     => -1,    # List of other items to check when this is changed
86    authtype => 1,     # for URLs
87    filter   => 1,     # filter exclude files when checking file permissions
88    iff      => 1,     # perl condition controlling when to check
89    max      => 1,     # max value
90    min      => 1,     # min value
91    trail    => 0,     # ignore trailing / when checking URL
92    undefok  => 0,     # is undef OK?
93    emptyok  => 0,     # is '' OK?
94    parts    => -1,    # for URL
95    partsreq => -1,    # for URL
96    perms    => -1,    # file permissions
97    schemes  => -1,    # for URL
98    user     => -1,    # for URL
99    pass     => -1,    # for URL
100);
101
102our %rename_options = ( nullok => 'undefok' );
103
104=begin TML
105
106---++ ClassMethod new($typename, %options)
107   * =$typename= e.g 'STRING', name of one of the Foswiki::Configure::TypeUIs
108     Defaults to 'UNKNOWN' if not given ('', 0 or undef).
109
110Constructor.
111
112*IMPORTANT NOTE*
113
114When constructing value objects in Pluggables, bear in mind that the
115=default= value is stored as *an unparsed perl string*. This string
116is checked for valid perl during the .spec load, but otherwise
117stored verbatim. It must be evaled to get the 'actual' default
118value.
119
120The presence of the key (tested using 'exists') indicates whether a
121default is provided or not. undef is a valid default.
122
123=cut
124
125sub new {
126    my ( $class, $typename, @options ) = @_;
127
128    my $this = $class->SUPER::new(
129        typename => ( $typename || 'UNKNOWN' ),
130        keys => '',
131
132        # We do not give it a value here, because the presence of
133        # the key indicates that a default is provided.
134        #default    => undef,
135        @options
136    );
137    $this->{CHECK} ||= {};
138    $this->{CHECK}->{undefok} = 0
139      unless defined $this->{CHECK}->{undefok};
140    $this->{CHECK}->{emptyok} = 1
141      unless defined $this->{CHECK}->{emptyok};    # required for legacy
142
143    return $this;
144}
145
146# Return true if this value is one of the preformatted types. Values for
147# these types transfer verbatim from the UI to the LocalSite.cfg
148sub isFormattedType {
149    my $this = shift;
150    return $this->{typename} eq 'PERL';
151}
152
153sub parseTypeParams {
154    my ( $this, $str ) = @_;
155
156    if ( $this->{typename} =~ m/^(SELECT|BOOLGROUP)/ ) {
157
158        # SELECT types *always* start with a comma-separated list of
159        # things to select from. These things may be words or wildcard
160        # class specifiers, or quoted strings (no internal quotes)
161        my @picks = ();
162        do {
163            if ( $str =~ s/^(["'])(.*?)\1// ) {
164                push( @picks, $2 );
165            }
166            elsif ( $str =~ s/^([-A-Za-z0-9:.*]+)// || $str =~ m/(\s)*,/ ) {
167                my $v = $1;
168                $v = '' unless defined $v;
169                if ( $v =~ m/\*/ && $this->{typename} eq 'SELECTCLASS' ) {
170
171                    # Populate the class list
172                    push( @picks,
173                        Foswiki::Configure::FileUtil::findPackages($v) );
174                }
175                else {
176                    push( @picks, $v );
177                }
178            }
179            else {
180                die "Illegal .spec at '$str'";
181            }
182        } while ( $str =~ s/\s*,\s*// );
183        $this->{select_from} = [@picks];
184    }
185    elsif ( $str =~ s/^\s*(\d+(?:x\d+)?)// ) {
186
187        # Width specifier for e.g. STRING
188        $this->{SIZE} = $1;
189    }
190    return $str;
191}
192
193# A feedback is a set of key=value pairs
194sub _FEEDBACK {
195    my ( $this, $str ) = @_;
196
197    $str =~ s/^\s*(["'])(.*)\1\s*$/$2/;
198
199    my %fb;
200    while ( $str =~ s/^\s*([a-z]+)\s*=\s*// ) {
201
202        my $attr = $1;
203
204        if ( $str =~ s/^(\d+)// ) {
205
206            # name=number
207            $fb{$attr} = $1;
208        }
209        elsif ( $str =~ s/(["'])(.*?[^\\])\1// ) {
210
211            # name=string
212            $fb{$attr} = $2;
213        }
214        last unless $str =~ s/^\s*;//;
215    }
216
217    die "FEEDBACK parse failed at $str" unless $str =~ m/^\s*$/;
218
219    push @{ $this->{FEEDBACK} }, \%fb;
220}
221
222# Spec file options are:
223# CHECK="option option:value option:value,value option:'value'", where
224#    * each option has a value (the default when just the keyword is
225#      present is 1)
226#    * options are separated by whitespace
227#    * values are introduced by : and delimited by , (Unless quoted,
228#      in which case there is just one value.  N.B. If quoted, double \.)
229#    * Generated an arrayref containing all values for
230#      each option
231#
232# Multiple CHECK clauses allow default checkers to do several checks
233# for an item.
234# For example, DataDir wants one set of options for .txt files, and
235# another for ,v files.
236
237sub _CHECK {
238    my ( $this, $str ) = @_;
239
240    my $ostr = $str;
241    $str =~ s/^(["'])\s*(.*?)\s*\1$/$2/;
242
243    my %options;
244    while ( $str =~ s/^\s*([a-zA-Z][a-zA-Z0-9]*)// ) {
245        my $name = $1;
246        my $set  = 1;
247        if ( $name =~ s/^no//i ) {
248            $set = 0;    # negated option
249        }
250        $name = $rename_options{$name} if exists $rename_options{$name};
251        die "CHECK parse failed: unrecognised option '$name'"
252          unless ( defined $CHECK_options{$name} );
253
254        my @opts;
255        if ( $str =~ s/^\s*:\s*// ) {
256            do {
257                if ( $str =~ s/^(["'])(.*?[^\\])\1// ) {
258                    push( @opts, $2 );
259                }
260                elsif ( $str =~ s/^([-+]?\d+)// ) {
261                    push( @opts, $1 );
262                }
263                elsif ( $str =~ s/^([a-z_{}]+)//i ) {
264                    push( @opts, $1 );
265                }
266                else {
267                    die "CHECK parse failed: not a list at $str in $ostr";
268                }
269            } while ( $str =~ s/^\s*,\s*// );
270        }
271        if ( $CHECK_options{$name} >= 0
272            && scalar(@opts) != $CHECK_options{$name} )
273        {
274            die
275"CHECK parse failed: wrong number of params to '$name' (expected $CHECK_options{$name}, saw @opts)";
276        }
277        if ( !$set && scalar(@opts) != 0 ) {
278            die "CHECK parse failed: 'no$name' is not allowed";
279        }
280        if ( scalar(@opts) == 0 ) {
281            $this->{CHECK}->{$name} = $set;
282        }
283        else {
284            $this->{CHECK}->{$name} = \@opts;
285        }
286    }
287    die "CHECK parse failed, expected name at $str in $ostr"
288      if $str !~ /^\s*$/;
289}
290
291# M => CHECK="noemptyok noundefok"
292sub _MANDATORY {
293    my $this = shift;
294    $this->{CHECK}->{emptyok} = 0;
295    $this->{CHECK}->{undefok} = 0;
296}
297
298# A value is a leaf, so this is a NOP.
299sub getSectionObject {
300    return;
301}
302
303=begin TML
304
305---++ ObjectMethod getValueObject($keys)
306This is a leaf object, so there's no recursive search to be done; we just
307return $this if the keys match.
308
309=cut
310
311sub getValueObject {
312    my ( $this, $keys ) = @_;
313
314    return ( $this->{keys} && $keys eq $this->{keys} ) ? $this : undef;
315}
316
317sub getAllValueKeys {
318    my $this = shift;
319    return ( $this->{keys} );
320}
321
322=begin TML
323
324---++ ObjectMethod getRawValue() -> $rawval
325
326Get the current value of the key from $Foswiki::cfg.
327The value returned is not expanded (embedded $Foswiki::cfg references
328will be intact)
329
330=cut
331
332sub getRawValue {
333    my ($this) = @_;
334
335    if (DEBUG) {
336        my $path = \%Foswiki::cfg;
337        my $x    = $this->{keys};
338        ASSERT( defined $x );
339        my $p = '$Foswiki::cfg';
340        while ( $x =~ s/^{(.*?)}// ) {
341            $path = $path->{$1};
342            $p .= "{$1}";
343
344            #print STDERR "$this->{keys} is undefined at $p"
345            #  unless defined $path;
346        }
347    }
348    return eval("\$Foswiki::cfg$this->{keys}");
349}
350
351=begin TML
352
353---++ ObjectMethod getExpandedValue() -> $expandedval
354
355Get the current value of the key from $Foswiki::cfg.
356The value returned with embedded $Foswiki::cfg references
357recursively expanded. If the current value is undef, then undef
358is returned. Embedded references that evaluate to undef
359are expanded using the string 'undef'.
360
361=cut
362
363sub getExpandedValue {
364    my ( $this, $name ) = @_;
365
366    my $val = $this->getRawValue();
367    return undef unless defined $val;
368    Foswiki::Configure::Load::expandValue($val);
369    return $val;
370}
371
372=begin TML
373
374---++ ObjectMethod encodeValue($raw_value) -> $encoded_value
375
376Encode a "real" cfg value as a string (if necessary) for passing
377to other tools, such as UIs, in a type-sensitive way.
378
379=cut
380
381# THIS IS NOT THE SAME AS Foswiki::Configure::Reporter::uneval.
382# This function is returning a string that can be passed back to
383# a UI and then recycled back as a new value. As such the resultant
384# value requires type information to be correctly interpreted.
385#
386# uneval is producing a *perl expression* which, when evaled,
387# will yield the correct value, and doesn't need any type information.
388
389sub encodeValue {
390    my ( $this, $value ) = @_;
391
392    return undef unless defined $value;
393
394    if ( ref($value) eq 'Regexp' ) {
395
396        # Convert to string
397        $value = "$value";
398
399        # Strip off useless furniture (?^: ... )
400        $value =~ s/^\(\?\^:(.*)\)$/$1/;
401        return $value;
402    }
403    elsif ( ref($value) ) {
404        return Foswiki::Configure::Reporter::uneval( $value, 2 );
405    }
406    elsif ( $this->{typename} eq 'OCTAL' ) {
407        return sprintf( '0%o', $value );
408    }
409    elsif ( $this->{typename} eq 'BOOLEAN' ) {
410        return $value ? 1 : 0;
411    }
412
413    return $value;
414}
415
416=begin TML
417
418---++ ObjectMethod decodeValue($encoded_value) -> $raw_value
419
420Decode a string that represents the value (e.g a serialised perl structure)
421and return the 'true' value by applying type rules
422
423=cut
424
425sub decodeValue {
426    my ( $this, $value ) = @_;
427
428    # Empty string always interpreted as undef
429    return undef unless defined $value;
430
431    if ( $this->isFormattedType() ) {
432        $value = eval($value);
433        die $@ if $@;
434    }
435    elsif ( $this->{typename} eq 'OCTAL' ) {
436        $value = oct($value);
437    }
438    elsif ( $this->{typename} eq 'BOOLEAN' ) {
439        $value = $value ? 1 : 0;
440    }
441
442    # else String or number, just sling it back
443
444    return $value;
445}
446
447=begin TML
448
449---++ ObjectMethod CHECK_option($keyname) -> $value
450
451Return the first value of the first CHECK option that contains
452the key =$opt=
453
454e.g. if we have =CHECK="a b" CHECK="c d=99 e"= in the .spec
455then =CHECK_option('c')= will return true and
456=CHECK_option('d')= will return =99=
457
458=cut
459
460sub CHECK_option {
461    my ( $this, $opt ) = @_;
462    if ( ref( $this->{CHECK}->{$opt} ) eq 'ARRAY' ) {
463        return $this->{CHECK}->{$opt}->[0];
464    }
465    return $this->{CHECK}->{$opt};
466    return undef;
467}
468
469# Implements Foswiki::Configure::item
470sub search {
471    my ( $this, $re ) = @_;
472    if ( $this->{keys} =~ m/$re/i ) {
473        return ($this);
474    }
475    return ();
476}
477
478# Implements Foswiki::Configure::item
479sub getPath {
480    my $this = shift;
481    my @path;
482    @path = $this->{_parent}->getPath() if ( $this->{_parent} );
483    push( @path, $this->{keys} );
484    return @path;
485}
486
487# Implements Foswiki::Configure::Item
488sub find_also_dependencies {
489    my ( $this, $root ) = @_;
490    ASSERT($root) if DEBUG;
491
492    return unless $this->{CHECK_ON_CHANGE};
493    foreach my $slave ( split( /[\s,]+/, $this->{CHECK_ON_CHANGE} ) ) {
494        my $vob = $root->getValueObject($slave);
495        next unless ($vob);
496        my $check = $vob->{CHECK};
497        if ($check) {
498            $check->{also} ||= [];
499            push( @{ $check->{also} }, $slave );
500        }
501        else {
502            $vob->{CHECK} = { also => [$slave] };
503        }
504    }
505}
506
5071;
508__END__
509Foswiki - The Free and Open Source Wiki, http://foswiki.org/
510
511Copyright (C) 2013-2014 Foswiki Contributors. Foswiki Contributors
512are listed in the AUTHORS file in the root of this distribution.
513NOTE: Please extend that file, not this notice.
514
515This program is free software; you can redistribute it and/or
516modify it under the terms of the GNU General Public License
517as published by the Free Software Foundation; either version 2
518of the License, or (at your option) any later version. For
519more details read LICENSE in the root of this distribution.
520
521This program is distributed in the hope that it will be useful,
522but WITHOUT ANY WARRANTY; without even the implied warranty of
523MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
524
525As per the GPL, removal of this notice is prohibited.
526