Item12180: PERL checker & plumbing

git-svn-id: http://svn.foswiki.org/trunk@16176 0b4bb1d4-4e5a-0410-9cc4-b2b747904278

core/lib/Foswiki.spec

@@ -1965,7 +1965,7 @@ $Foswiki::cfg{NotifyTopicName} = 'WebNotify';
 # you are doing!)
 $Foswiki::cfg{UsersWebName} = 'Main';
 
-# **STRING 70x10**
+# **STRING 70x10 s**
 # A comma-separated list of generic file name templates that defines the order
 # in which templates are assigned to skin path components.
 # The file name templates can either be absolute file names ending in ".tmpl"

core/lib/Foswiki/Configure.pm

@@ -100,6 +100,10 @@ use constant RT80346 => 0;                    # Set with Storable until fixed...
 our $TRUE  = 1;
 our $FALSE = 0;
 
+# Used if code needs to know whether running
+# under configure or the webserver.  Set by Dispatch.
+our $configureRunning;
+
 # auth - authentication state
 our ( $newLogin, $session, );
 

core/lib/Foswiki/Configure/Checkers/PERL.pm

@@ -0,0 +1,160 @@
+# See bottom of file for license and copyright information
+package Foswiki::Configure::Checkers::PERL;
+
+use strict;
+use warnings;
+
+require Foswiki::Configure::Types::PERL;
+
+use Foswiki::Configure(qw/:cgi/);
+
+require Foswiki::Configure::Checker;
+our @ISA = ('Foswiki::Configure::Checker');
+
+# check & provideFeedback could be restructured to remove
+# redundant code, but since these are all error cases, it
+# doesn't seem worth the trouble.
+
+sub check {
+    my $this   = shift;
+    my $valobj = shift;
+
+    my $keys  = $valobj->getKeys();
+    my $value = $this->getItemCurrentValue();
+    return '' if ( defined $value );
+
+    # Not defined, there was a parsing or eval problem.
+    # Re-do it here where we can diagnose the error.
+    #
+    # The CGI value is a string '[ expressions ]' - we hope.
+    $value = $query->param($keys);
+    return $this->ERROR("No value for this item")
+      unless ( defined $value );
+
+    $value =~ s/^[[:space:]]+(.*?)$/$1/s;
+    $value =~ s/^(.*?)[[:space:]]+$/$1/s;
+
+    my $s;
+    if ( $s = Foswiki::Configure::Types::PERL::_rvalue($value) ) {
+        my $top = substr( $value, 0, length($value) - length($s) );
+        my $line = ( $top =~ tr/\n// );
+        my $lines = join(
+            "\n",
+            (
+                split(
+                    /\n/,
+                    $top
+                      . qq{<span style="background-color:yellow;">&lt;&lt;&lt;=== HERE</span>\n}
+                      . $s
+                )
+              )[
+              max( 0, $line - 5 ) .. $line + 1 + min( ( $s =~ tr /\n// ), 5 )
+              ]
+        );
+        $line++;
+        return $this->ERROR(
+            "Error detected in structure near line $line.<pre>$lines</pre>");
+    }
+    $value =~ /(.*)/s;
+    eval $1;
+    if ($@) {
+        $@ =~ s/\(eval\s+\d+\)\s+//;
+        return $this->ERROR( "Error in structure: <pre>"
+              . $this->stripTraceback($@)
+              . "</pre>" );
+    }
+
+    return '';
+}
+
+# Note that check() is always called, so it's not necessary
+# to do a second eval; if there was an error, it's obtained
+# from check.  The only reason to do something different here
+# is that we can insert a marker into the textarea where we
+# think an error is.
+
+sub provideFeedback {
+    my $this = shift;
+    my ( $valobj, $button, $label ) = @_;
+
+    $this->{FeedbackProvided} = 1;
+
+    # Normally, we call check first, but not if called by check.
+
+    my $e = $button ? $this->check($valobj) : '';
+
+    delete $this->{FeedbackProvided};
+
+    if ( $button && $e ) {
+        my $keys  = $valobj->getKeys();
+        my $value = $this->getItemCurrentValue();
+        unless ( defined $value ) {
+            $value = $query->param($keys);
+            if ( defined $value ) {
+                $value =~ s/^[[:space:]]+(.*?)$/$1/s;
+                $value =~ s/^(.*?)[[:space:]]+$/$1/s;
+
+                my $s;
+                if ( $s = Foswiki::Configure::Types::PERL::_rvalue($value) ) {
+                    my $top =
+                      substr( $value, 0, length($value) - length($s) )
+                      . qq{<<< ============ HERE\n};
+
+                    $e .=
+                        $this->FB_VALUE( "$keys", $top )
+                      . $this->FB_ACTION( $keys, 'b,m,A,M', $s );
+                }
+            }
+        }
+    }
+    return wantarray ? ( $e, 0 ) : $e;
+}
+
+sub max {
+    return unless (@_);
+    my $max = shift;
+
+    while (@_) {
+        my $next = shift;
+        $max = $next if ( $next > $max );
+    }
+    return $max;
+}
+
+sub min {
+    return unless (@_);
+    my $min = shift;
+
+    while (@_) {
+        my $next = shift;
+        $min = $next if ( $next < $min );
+    }
+    return $min;
+}
+
+1;
+__END__
+Foswiki - The Free and Open Source Wiki, http://foswiki.org/
+
+Copyright (C) 2008-2012 Foswiki Contributors. Foswiki Contributors
+are listed in the AUTHORS file in the root of this distribution.
+NOTE: Please extend that file, not this notice.
+
+Additional copyrights apply to some or all of the code in this
+file as follows:
+
+Copyright (C) 2000-2006 TWiki Contributors. All Rights Reserved.
+TWiki Contributors are listed in the AUTHORS file in the root
+of this distribution. NOTE: Please extend that file, not this notice.
+
+This program is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public License
+as published by the Free Software Foundation; either version 2
+of the License, or (at your option) any later version. For
+more details read LICENSE in the root of this distribution.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+As per the GPL, removal of this notice is prohibited.

core/lib/Foswiki/Configure/Dispatch.pm

@@ -21,13 +21,19 @@ package Foswiki;
 use version 0.77;
 
 # minimum version of client JavaScript that configure requires.
-my $minScriptVersion = version->parse("v3.108");
+#
+my $minScriptVersion = version->parse("v3.109");
 
 use Foswiki::Configure (qw/:DEFAULT :auth :cgi :config :session :trace/);
 
 $query                = CGI->new;
 $unsavedChangesNotice = '';
 
+# NOT exported, used if code needs to know whether running
+# under configure or the webserver.  Webserver will never load Dispatch.
+
+our $configureRunning = 1;
+
 my $action;
 my @feedbackHeaders;
 if ( $query->http('X-Foswiki-FeedbackRequest') ) {

core/lib/Foswiki/Configure/Feedback.pm

@@ -44,6 +44,8 @@ feedback request has been received.
 
     package Foswiki;
 
+    use Foswiki::Configure qw/:auth :cgi/;
+
     sub _authenticatefeedbackUI {
         my ( $action, $session, $cookie ) = @_;
 
@@ -168,7 +170,9 @@ sub deliver {
     require Foswiki::Configure::Checkers::Introduction;
     $root->addChild( Foswiki::Configure::Checkers::Introduction->new($root) );
 
-    if ( my $oscfg = $Config::Config{osname} ) {
+    use Config;
+
+    if ( my $oscfg = $Config{osname} ) {
 
         # See if this platform has special detection or checking requirements
         my $osospecial = "Foswiki::Configure::Checkers::$oscfg";
@@ -450,6 +454,7 @@ sub deliverResponse {
 #        namespace is reserved for such <divs>, and will not be written to LSC.
 #   \005 delivers data to the modal window.
 #        The target and action are specified by the key.
+#   \006 executes miscellaneous actions
 
     $fb->{'{ConfigureGUI}{Unsaved}'} = Foswiki::unsavedChangesNotice($updated)
       if ( $updated && ( loggedIn($session) || $badLSC || $query->auth_type ) );
@@ -504,6 +509,8 @@ sub startVisit {
 
         return 1 unless ( $keys eq $this->{request} );
 
+        $this->defaultOptions( $visitee, $keys );
+
         # Found supplier, instantiate checker
         # Retain for AUDIT reruns to save load and allow audit
         # to save state
@@ -580,6 +587,8 @@ sub startVisit {
         return 1
           if ( $keys =~ /^{ConfigureGUI}{Modals}/ );
 
+        $this->defaultOptions( $visitee, $keys );
+
         $visitee->{_fbchecker} = my $checker = $visitee->{_fbchecker}
           || Foswiki::Configure::UI::loadChecker( $keys, $visitee );
 
@@ -607,6 +616,35 @@ sub startVisit {
     return 1;
 }
 
+# ######################################################################
+# Obtain option defaults for item from Type
+# ######################################################################
+
+sub defaultOptions {
+    my $this = shift;
+    my ( $visitee, $keys ) = @_;
+
+    return if ( $visitee->{_fbDefaulted} );
+
+    $visitee->{_fbDefaulted} = 1;
+
+    # Get any default CHECK options from type
+
+    my $type = $visitee->getType;
+    if ( $type->can('defaultOptions') ) {
+        my $opts = my $prev = $visitee->{opts} || '';
+        my $updated = $type->defaultOptions(
+            $keys, $opts,
+            $visitee->feedback && 1,
+            $visitee->getCheckerOptions && 1
+        );
+        if ( $updated ne $prev ) {
+            $visitee->set( undef, opts => $updated );
+        }
+    }
+    return;
+}
+
 # ######################################################################
 # End of item callback
 # ######################################################################

core/lib/Foswiki/Configure/FoswikiCfg.pm

@@ -140,10 +140,17 @@ sub load {
                 # If no default, try to muddle along so these can be reported
 
                 unless ( defined $default ) {
-                    if ( $visitee->{typename} eq 'HASH' ) {
-                        $default = {};
-                    }
-                    elsif ( $visitee->{typename} eq 'ARRAY' ) {
+
+                    #if ( $visitee->{typename} eq 'HASH' ) {
+                    #    $default = {};
+                    #}
+                    #elsif ( $visitee->{typename} eq 'ARRAY' ) {
+                    #    $default = [];
+                    #}
+                    #els
+                    if ( $visitee->{typename} eq 'PERL' ) {
+
+                        # Could be 'string' or {hash} but no way to guess.
                         $default = [];
                     }
                     elsif ( $visitee->{typename} =~ /BOOLEAN|NUMBER|OCTAL/ ) {

core/lib/Foswiki/Configure/Types/PERL.pm

@@ -15,22 +15,38 @@ package Foswiki::Configure::Types::PERL;
 use strict;
 use warnings;
 
-use Foswiki::Configure::Type ();
+use Foswiki::Configure qw/:cgi/;
+
+require Foswiki::Configure::Type;
 our @ISA = ('Foswiki::Configure::Type');
 
-use Data::Dumper ();
+# Default options prior to prompt (and check)
+#
+sub defaultOptions {
+    my $this = shift;
+    my ( $id, $opts, $feedback, $check ) = @_;
+
+    # Force textarea.  Default no spellcheck, autocheck
+    my $size = $Foswiki::DEFAULT_FIELD_WIDTH_NO_CSS;
+
+    $opts .= " ${size}x10" unless ( $opts =~ /\b(\d+)x(\d+)\b/ );
+    $opts .= ' s'          unless ( $opts =~ /\b[sS]\b/ );
+    $opts .= ' FEEDBACK=AUTO' unless ($feedback);
+
+    return $opts;
+}
 
 sub prompt {
     my ( $this, $id, $opts, $value, $class ) = @_;
 
-    my $v = Data::Dumper->Dump( [$value], ['x'] );
+    require Data::Dumper;
+
+    my $d = Data::Dumper->new( [$value], ['x'] );
+    $d->Sortkeys(1);
+    my $v = $d->Dump;
     $v =~ s/^\$x = (.*);\s*$/$1/s;
     $v =~ s/^     //gm;
 
-    # Force textarea
-    my $size = $Foswiki::DEFAULT_FIELD_WIDTH_NO_CSS;
-    $opts .= " ${size}x10" unless ( $opts =~ /\b(\d+)x(\d+)\b/ );
-
     return $this->SUPER::prompt( $id, $opts, $v, $class );
 }
 
@@ -42,7 +58,7 @@ sub _rvalue {
             my $escaped = 0;
             while ( length($s) > 0 && $s =~ s/^(.)//s ) {
                 last if ( $1 eq "'" && !$escaped );
-                $escaped = $1 eq '\\';
+                $escaped = ( $escaped ? 0 : $1 eq '\\' );
             }
         }
         elsif ( $s =~ s/^\s*(\w+)//s ) {
@@ -71,12 +87,21 @@ sub string2value {
     my $s;
     if ( $s = _rvalue($val) ) {
 
-        # Parse failed, return as a string.
-        die
-"Could not parse text to a data structure (at: $s)\nPlease go back and check if the text has the correct syntax.";
+        # Unable to parse.  If configure is running
+        # allow checker to handle diagnostic.
+        return if ($Foswiki::configureRunning);
+
+        # Parse failed, LSC is corrupt. Only way to report is die.
+        $val = 'undef' unless ( defined $val );
+        die "Types::PERL: Could not parse text to a data structure."
+          . substr( $val, 0, length($val) - length($s) )
+          . "<<<==== HERE" . "\n$s";
     }
-    $val =~ /(.*)/s;                       # parsed, so safe to untaint
-    return eval $1;
+    $val =~ /(.*)/s;    # parsed, so safe to untaint
+    $val = eval $1;
+    return $val if ( defined $val );
+    return if ($Foswiki::configureRunning);
+    die "Types::PERL: Parsed but invalid data: $@";
 }
 
 sub deep_equals {