# r1.2
#
# ConditionalPlugin for TWiki
# Copyright (C) 2002 Jeroen van Dongen, jeroen@vthings.net 
#
# TWiki WikiClone ($wikiversion has version info)
# Copyright (C) 2000-2001 Andrea Sterbini, a.sterbini@flashnet.it
# Copyright (C) 2001 Peter Thoeny, Peter@Thoeny.com
#
# 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.
#
# 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.  See the
# GNU General Public License for more details, published at 
# http://www.gnu.org/copyleft/gpl.html
#
#
# ConditionalPlugin
# =========================
#
# Used to handle if-then and if-then-else constructs
# The recognised syntax is
# %IFTRUE{ scalar operator scalar }% text %ELSE% text %ENDIF%
#
# The '%ELSE% text' clause is optional.
#
# Change history:
# r1.0 - initial revision
# r1.1 - improved regexp to deal with multi-line spanning if/else constructs
# r1.2 - minor improvements, added lazy-loading of Safe.pm 
#


# =========================
package TWiki::Plugins::ConditionalPlugin;

# =========================
use strict;
use vars qw( $VERSION $debug $pluginName $sandbox $pluginInitialized );

$pluginName = 'ConditionalPlugin';

#use Safe;

$VERSION = '1.000';

# Yuk.  Should probably use Parse::RecDescent or similar for this.
# Roll on Perl 6 and its grammar-defining abilities!
my $ops         = qr/(<|>|<=|>=|lt|gt|le|ge|==|\!=|<=>|eq|ne|cmp|=~|\!~)/;
my $word        = qr/(\w+|".*?"|'.*?')/s;
my $condPattern = qr/$word\s+$ops\s+$word/;

my $condPattern_ifonly = qr/%IFTRUE{\s*$condPattern\s*}%(.*?)%ENDIF%/s;
# $1: 1st word of conditional
# $2: op of conditional
# $3: 2nd word of conditional
# $4: true text

my $condPattern_ifelse = qr/%IFTRUE{\s*$condPattern\s*}%(.*?)%ELSE%(.*?)%ENDIF%/s;
# Same as $condPattern_ifonly, but also:
# $5: false text

# =========================
sub initPlugin
{
    my ( $topic, $web, $user, $installWeb ) = @_;

    # check for Plugins.pm versions
    if( $TWiki::Plugins::VERSION < 1 ) {
        &TWiki::Func::writeWarning( "Version mismatch between ConditionalPlugin and Plugins.pm" );
        return 0;
    }

    # Get plugin debug flag
    $debug = &TWiki::Func::getPreferencesFlag( "CONDITIONALPLUGIN_DEBUG" );

    # Don't initialize the sandbox yet. Loaded conditionally 
    # only when required.
    $pluginInitialized = 0;

    $installWeb = $web;

    # Plugin correctly initialized
    &TWiki::Func::writeDebug( "- TWiki::Plugins::ConditionalPlugin::initPlugin( $web.$topic ) is OK" ) if $debug;
    return 1;
}

sub _doNothing {
}

sub _initDefaults {
    require Safe;

    # create a sandbox to safely eval the condition expression
    $sandbox = new Safe;
    $sandbox->permit_only(qw(:base_core));

    $pluginInitialized = 1;
}

sub handleConditional {

    my ($lhs, $op, $rhs, $true_text, $false_text) = @_;

    $lhs = fix_quotes($lhs);
    $rhs = fix_quotes($rhs);
    my $cond = "'$lhs' $op '$rhs'";

    undef $@;
    my $result = $sandbox->reval($cond) || 0;
    my $error = $@;
    &TWiki::Func::writeDebug( "- Conditional: match [$cond] => result[$result], true[$true_text], false[$false_text]" )
      if $debug;
    &TWiki::Func::writeDebug( "- Conditional ERROR: match [$cond] => $error" )
      if $error;
    return $result ? $true_text : $false_text;
}

sub fix_quotes {
    my ($word) = @_;
  
    if ($word =~ /^(['"])(.*)\1$/ ) {
	$word = $2;
        $word =~ s/'/\\'/g; # word is destined to be wrapped in single quotes
    } else {
        # Must have been old-style bareword - tut!
    }
    return $word;
}

# =========================
sub commonTagsHandler
{
### my ( $text, $topic, $web ) = @_;   # do not uncomment, use $_[0], $_[1]... instead
    
    &TWiki::Func::writeDebug( "- ConditionalPlugin::commonTagsHandler( $_[2].$_[1] )" ) if $debug;
    
    # check if there's an IFTRUE statement in this topic, otherwise we don't
    # have to load the lot.
    if ( $_[0] !~ m/%IFTRUE{.*}%/) {
	# nothing to do
	&TWiki::Func::writeDebug( "- ConditionalPlugin: no %IFTRUE found - nothing to do" ) if $debug; 
	return;
    }

    _initDefaults() if( ! $pluginInitialized );
    
    # Nested if support - find the last occurence of %IFTRUE each time through and
    # process it first. Thus, the deepest nesting in each set of ifs is
    # processed first and parsed correctly. -- Walter Mundt
    
    my $text = \$_[0];
    my $ifIndex = rindex($$text, "%IFTRUE");
    while ($ifIndex != -1) {
	
	my $startText = substr($$text, 0, $ifIndex);
	my $endText = substr($$text, $ifIndex);
	
	# try to match if/else first (otherwise it gets masked by the if-only 
	# variant
	$endText =~ s/^$condPattern_ifelse/&handleConditional($1, $2, $3, $4, $5)/geos;
    
	# then try to match the if-only variant
	$endText =~ s/^$condPattern_ifonly/&handleConditional($1, $2, $3, $4, '')/geos;
	
	# mark any remaining %IFTRUEs as invalid syntax
	$endText =~ s/^%IFTRUE/!!IFTRUE/s;
	
	$$text = $startText . $endText;
	$ifIndex = rindex($$text, "%IFTRUE");
    }
}