1# See bottom of file for license and copyright information
2
3=begin TML
4
5---+ package Foswiki::Configure::Checker;
6
7Base class of all checkers. Checkers give checking and guessing support
8for configuration values. Checkers are designed to be totally independent
9of UI.
10
11All 'Value' type configuration items in the model can have a checker.
12Further, if a value doesn't have an individual checker, there may
13be an associated type checker. If an item has an individual checker,
14it's type checker is *not* invoked.
15
16A checker must provide =check_current_value=, as described below.
17
18Checkers *never* modify =$Foswiki::cfg=.
19
20Checker objects are not instantiated directly. Rather, they are generated
21using the =loadChecker= factory method described below.
22
23=cut
24
25package Foswiki::Configure::Checker;
26
27use strict;
28use warnings;
29
30use Data::Dumper ();
31use File::Spec   ();
32
33use Assert;
34
35use Foswiki::Configure::Load       ();
36use Foswiki::Configure::Dependency ();
37
38use constant GUESSED_MESSAGE => <<'HERE';
39I had to guess this setting in order to continue checking. You must
40confirm this setting (and any other guessed settings) and save
41correct values before changing any other settings.
42HERE
43
44my %checkers;
45
46# Construct a new Checker, attaching the given $item from the model.
47# This is not normally used by other classes, but is provided in case
48# a subclass needs to override it for any reason.
49sub new {
50    my ( $class, $item ) = @_;
51
52    my $this = bless( { item => $item }, $class );
53}
54
55=begin TML
56
57---++ StaticMethod loadChecker($item [, $explicit]) -> $checker
58
59Loads the Foswiki::Configure::Checker subclass for the
60given $item. For example, given the $item->{keys} '{Beans}{Mung}', it
61will try and load Foswiki::Configure::Checkers::Beans::Mung
62
63An item may specify a different checker to load if it has the
64CHECKER attribute. This will be interpreted as keys for the 'real' checker
65to lead for this item. This behaviour is suppressed if $explicit is
66true (i.e. CHECKER will be ignored, and the default behaviour will apply.
67This is useful in the case where an explicit CHECKER has to chain the
68other checkers for an item.)
69
70If the item doesn't have a subclass defined, the item's type class may
71define a generic checker for that type.  If so, it is instantiated
72for this item.
73
74Finally, we will see if $item's type, or one it inherits from
75has a generic checker.  If so, that's instantiated.
76
77Returns the checker that's created or undef if no such checker is found.
78
79Will die if the checker exists but fails to compile.
80
81$item is passed on to the checker's constructor.
82
83=cut
84
85sub loadChecker {
86    my ( $item, $explicit ) = @_;
87    my $id;
88
89    if ( !$explicit && $item->{CHECKER} ) {
90
91        # Checker override
92        $id = $item->{CHECKER};
93    }
94    else {
95        ASSERT( $item && $item->{keys} ) if DEBUG;
96
97        # Convert {key}{s} to key::s, removing illegal characters
98        # [-_\w] are legal. - => _.
99        $id = $item->{keys};
100
101        $id =~ s{\{([^\}]*)\}}{
102            my $lbl = $1;
103            $lbl =~ tr,-_a-zA-Z0-9\x00-\xff,__a-zA-Z0-9,d;
104            $lbl . '::'}ge
105          and substr( $id, -2 ) = '';
106    }
107
108    foreach my $chkmod ( $id, $item->{typename} ) {
109        if ( defined $checkers{$chkmod} ) {
110            if ( $checkers{$chkmod} ) {
111
112                #print STDERR "Returning cached $chkmod\n";
113                return $checkers{$chkmod}->new($item);
114            }
115        }
116        else {
117            my $checkClass = 'Foswiki::Configure::Checkers::' . $chkmod;
118            if (
119                Foswiki::Configure::FileUtil::findFileOnPath(
120                    $checkClass . '.pm'
121                )
122              )
123            {
124                eval("require $checkClass");
125                unless ($@) {
126                    $checkers{$chkmod} = $checkClass;
127
128                    #print STDERR "Returning NEW cached $chkmod\n";
129                    return $checkClass->new($item);
130                }
131                else {
132                    die "Checker $checkClass failed to load: $@\n";
133                }
134            }
135
136            #print STDERR "Caching empty $chkmod\n";
137            $checkers{$chkmod} = '';
138        }
139    }
140    return undef;
141}
142
143=begin TML
144
145---++ ObjectMethod check_current_value($reporter)
146    * =$reporter= - report logger; use ERROR, WARN etc on this
147      object to record information.
148
149The value to be checked is taken from $Foswiki::cfg. This is the
150baseline check for values already in $Foswiki::cfg, and needs to
151be as fast as possible (it should not do any heavy processing).
152
153Old checkers may not provide =check_current_value= but instead
154use the older signature =check=.
155
156=cut
157
158sub check_current_value {
159    my ( $this, $reporter ) = @_;
160
161    # If we get all the way back up the inheritance tree without
162    # finding a check_current_value implementation, then see if
163    # there is a check().
164    if ( $this->can('check') ) {
165        $this->{reporter} = $reporter;
166        $this->check( $this->{item} );
167        delete $this->{reporter};
168    }
169}
170
171###################################################################
172# Compatibility methods
173# Note that ASSERT($this->{reporter} if DEBUG is used to confirm that
174# the call has come from an implementation of check()
175
176# Get the value of the named configuration var.
177#    * =$keys= - optional keys to retrieve e.g
178#      =getCfg("{Validation}{ExpireKeyOnUse}")=. Defaults to the
179#     keys of the item associated with the checker.
180#
181# Any embedded references to other Foswiki::cfg vars will be expanded.
182# Note that any embedded references to undefined variables will be
183# expanded as the string 'undef'. Use =getCfgUndefOk= if you want a
184# real undef for undefined values rather than the string.
185#
186# Synonymous with:
187# <verbatim>
188# my $x = '$Foswiki::cfg{Keys}';
189# Foswiki::Configure::Load::expandValue($x, 0);
190# </verbatim>
191# Thus it returns the value as Foswiki will see it (i.e. with undef
192# expanded as the string 'undef')
193sub getCfg {
194    my ( $this, $name ) = @_;
195    $name ||= $this->{item}->{keys};
196
197    my $item = '$Foswiki::cfg' . $name;
198    Foswiki::Configure::Load::expandValue($item);
199    return $item;
200}
201
202# As =getCfg=, except that =undef= will not be expanded to the string 'undef'.
203# Note that recursive expansion of embedded =$Foswiki::cfg= will also return
204# undef, and will result in a program error.
205sub getCfgUndefOk {
206
207    my ( $this, $name, $undef ) = @_;
208    $name ||= $this->{item}->{keys};
209
210    my $item = '$Foswiki::cfg' . $name;
211    Foswiki::Configure::Load::expandValue( $item, defined $undef ? $undef : 1 );
212    return $item;
213}
214
215# Provided for compatibility; if a checker tries to call SUPER::check and
216# the superclass only has check_current_value, it will fold back to here.
217sub check {
218    my ($this) = @_;
219
220    # Subclasses often use SUPER::check, so make sure it's there.
221    # Passing the checker as the reporter is a bit of a hack, but
222    # OK by design.
223    ASSERT( $this->can('check_current_value') ) if DEBUG;
224    $this->check_current_value($this);
225}
226
227# Provided for use by check() implementations *only* new checkers
228# *must not* call this.
229sub NOTE {
230    my $this = shift;
231    ASSERT( $this->{reporter} ) if DEBUG;
232    $this->{reporter}->NOTE(@_);
233    return join( ' ', @_ );
234}
235
236# Provided for use by check() implementations *only* new checkers
237# *must not* call this.
238sub WARN {
239    my $this = shift;
240    ASSERT( $this->{reporter} ) if DEBUG;
241    $this->{reporter}->WARN(@_);
242    return join( ' ', @_ );
243}
244
245# Provided for use by check() implementations *only* new checkers
246# *must not* call this.
247sub ERROR {
248    my $this = shift;
249    ASSERT( $this->{reporter} ) if DEBUG;
250    $this->{reporter}->ERROR(@_);
251    return join( ' ', @_ );
252}
253
254# Set the value of the checked configuration var.
255# $keys are optional.
256# Provided for use by check() implementations *only* new checkers
257# *must not* call this.
258sub setItemValue {
259    my ( $this, $value, $keys ) = @_;
260    $keys ||= $this->{item}->{keys};
261    ASSERT( $this->{reporter} ) if DEBUG;
262
263    eval("\$Foswiki::cfg$keys = \$value;");
264    if ($@) {
265        die "Unable to set value $value for $keys\n";
266    }
267    return wantarray ? ( $keys, $value ) : $keys;
268}
269
270# Provided for use by check() implementations *only* new checkers
271# *must not* call this.
272sub getItemCurrentValue {
273    my $this = shift;
274    my $keys = shift || $this->{item}->{keys};
275    ASSERT( $this->{reporter} ) if DEBUG;
276    my $value = eval("\$Foswiki::cfg$keys");
277    if ($@) {
278        die "Unable to get value for $keys\n";
279    }
280    return $value;
281}
282
283# Get the default value of the checked configuration var.
284# $keys is optional
285# Provided for use by check() implementations *only* new checkers
286# *must not* call this.
287sub getItemDefaultValue {
288    my $this = shift;
289    my $keys = shift || $this->{item}->{keys};
290    ASSERT( $this->{reporter} ) if DEBUG;
291
292    no warnings 'once';
293    my $value = eval("\$$Foswiki::Configure::defaultCfg->$keys");
294    if ($@) {
295        die "Unable to get default $value for $keys\n";
296    }
297    return $value;
298}
299
300# Provided for use by check() implementations *only* new checkers
301# *must not* call this.
302sub checkGnuProgram {
303    my ( $this, $prog ) = @_;
304    ASSERT( $this->{reporter} ) if DEBUG;
305    Foswiki::Configure::FileUtil::checkGNUProgram( $prog, $this );
306    return '';
307}
308
309# Provided for use by check() implementations *only* new checkers
310# *must not* call this.
311sub checkPerlModule {
312    my ( $this, $module, $note, $version ) = @_;
313    ASSERT( $this->{reporter} ) if DEBUG;
314    my %mod = (
315        name           => $module,
316        usage          => $note,
317        disposition    => 'required',
318        mimimumVersion => $version
319    );
320    Foswiki::Configure::Dependency::checkPerlModules( \%mod );
321    if ( $mod{ok} ) {
322        $this->{reporter}->NOTE( $mod{check_result} );
323        return '';
324    }
325    else {
326        $this->{reporter}->ERROR( $mod{check_result} );
327        return 'ERROR';
328    }
329}
330
331###################################################################
332# Support methods, used by subclasses
333
334=begin TML
335
336---++ PROTECTED ObjectMethod warnAboutWindowsBackSlashes($path) -> $html
337
338Generate a warning if the supplied pathname includes windows-style
339path separators.
340
341PROVIDED FOR COMPATIBILITY ONLY - DO NOT USE! Use inheritance of
342Checkers::PATH behaviour instead.
343
344=cut
345
346sub warnAboutWindowsBackSlashes {
347    my ( $this, $path ) = @_;
348    if ( $path =~ m/\\/ ) {
349        return $this->WARN(
350                'You should use c:/path style slashes, not c:\path in "'
351              . $path
352              . '"' );
353    }
354}
355
356=begin TML
357
358---++ PROTECTED ObjectMethod checkExpandedValue($reporter) -> $value
359
360Report the expanded value of a parameter. Return the expanded value.
361
362=cut
363
364sub checkExpandedValue {
365    my ( $this, $reporter ) = @_;
366
367    my $raw   = $this->{item}->getRawValue();
368    my $value = $this->{item}->getExpandedValue();
369
370    my $field = $value;
371
372    if ( !defined $raw ) {
373        $raw = 'undef';
374    }
375
376    if ( !defined $field ) {
377        if ( !$this->{item}->CHECK_option('undefok') ) {
378            $reporter->ERROR("May not be undefined");
379        }
380        $field = 'undef';
381    }
382
383    if ( $field eq '' && !$this->{item}->CHECK_option('emptyok') ) {
384        $reporter->ERROR("May not be empty");
385    }
386
387    if ( ref($field) ) {
388        $field = $this->{item}->encodeValue($field);
389    }
390
391    #print STDERR "field=$field, raw=$raw\n";
392
393    if ( $field ne $raw ) {
394        if ( $field =~ m/\n/ ) {
395            $reporter->NOTE( 'Expands to: <verbatim>', $field, '</verbatim>' );
396        }
397        elsif ( $field eq '' ) {
398            $reporter->NOTE("Expands to: '' (empty)");
399        }
400        else {
401            $reporter->NOTE("Expands to: =$field=");
402        }
403    }
404
405    return $value;
406}
407
4081;
409__END__
410Foswiki - The Free and Open Source Wiki, http://foswiki.org/
411
412Copyright (C) 2008-2010 Foswiki Contributors. Foswiki Contributors
413are listed in the AUTHORS file in the root of this distribution.
414NOTE: Please extend that file, not this notice.
415
416Additional copyrights apply to some or all of the code in this
417file as follows:
418
419Copyright (C) 2000-2006 TWiki Contributors. All Rights Reserved.
420TWiki Contributors are listed in the AUTHORS file in the root
421of this distribution. NOTE: Please extend that file, not this notice.
422
423This program is free software; you can redistribute it and/or
424modify it under the terms of the GNU General Public License
425as published by the Free Software Foundation; either version 2
426of the License, or (at your option) any later version. For
427more details read LICENSE in the root of this distribution.
428
429This program is distributed in the hope that it will be useful,
430but WITHOUT ANY WARRANTY; without even the implied warranty of
431MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
432
433As per the GPL, removal of this notice is prohibited.
434