lib/TWiki/Plugins/SpreadSheetPlugin/Calc.pm
author Colas Nahaboo <colas@nahaboo.net>
Sat, 26 Jan 2008 15:50:53 +0100
changeset 0 414e01d06fd5
permissions -rw-r--r--
RELEASE 4.2.0 freetown
colas@0
     1
# Plugin for TWiki Enterprise Collaboration Platform, http://TWiki.org/
colas@0
     2
#
colas@0
     3
# Copyright (C) 2001-2007 Peter Thoeny, peter@thoeny.org
colas@0
     4
#
colas@0
     5
# This program is free software; you can redistribute it and/or
colas@0
     6
# modify it under the terms of the GNU General Public License
colas@0
     7
# as published by the Free Software Foundation; either version 2
colas@0
     8
# of the License, or (at your option) any later version. For
colas@0
     9
# more details read LICENSE in the root of this distribution.
colas@0
    10
#
colas@0
    11
# This program is distributed in the hope that it will be useful,
colas@0
    12
# but WITHOUT ANY WARRANTY; without even the implied warranty of
colas@0
    13
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
colas@0
    14
# GNU General Public License for more details, published at
colas@0
    15
# http://www.gnu.org/copyleft/gpl.html
colas@0
    16
#
colas@0
    17
# As per the GPL, removal of this notice is prohibited.
colas@0
    18
#
colas@0
    19
# =========================
colas@0
    20
#
colas@0
    21
# This is part of TWiki's Spreadsheet Plugin.
colas@0
    22
#
colas@0
    23
# The code below is kept out of the main plugin module for
colas@0
    24
# performance reasons, so it doesn't get compiled until it
colas@0
    25
# is actually used.
colas@0
    26
colas@0
    27
package TWiki::Plugins::SpreadSheetPlugin::Calc;
colas@0
    28
colas@0
    29
use strict;
colas@0
    30
use Time::Local;
colas@0
    31
colas@0
    32
colas@0
    33
# =========================
colas@0
    34
use vars qw(
colas@0
    35
        $web $topic $debug $dontSpaceRE
colas@0
    36
        $renderingWeb @tableMatrix $cPos $rPos $escToken
colas@0
    37
        %varStore @monArr @wdayArr %mon2num
colas@0
    38
    );
colas@0
    39
colas@0
    40
$escToken = "\0";
colas@0
    41
%varStore = ();
colas@0
    42
$dontSpaceRE = "";
colas@0
    43
@monArr = ( "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" );
colas@0
    44
@wdayArr = ( "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday" );
colas@0
    45
{ my $count = 0;
colas@0
    46
  %mon2num = map { $_ => $count++ } @monArr;
colas@0
    47
}
colas@0
    48
colas@0
    49
colas@0
    50
# =========================
colas@0
    51
sub init
colas@0
    52
{
colas@0
    53
    ( $web, $topic, $debug ) = @_;
colas@0
    54
colas@0
    55
    # initialize variables, once per page view
colas@0
    56
    %varStore = ();
colas@0
    57
    $dontSpaceRE = "";
colas@0
    58
colas@0
    59
    # Module initialized
colas@0
    60
    TWiki::Func::writeDebug( "- TWiki::Plugins::SpreadSheetPlugin::Calc::init( $web.$topic )" ) if $debug;
colas@0
    61
    return 1;
colas@0
    62
}
colas@0
    63
colas@0
    64
# =========================
colas@0
    65
sub CALC
colas@0
    66
{
colas@0
    67
### my ( $text, $topic, $web ) = @_;   # do not uncomment, use $_[0], $_[1]... instead
colas@0
    68
colas@0
    69
    TWiki::Func::writeDebug( "- SpreadSheetPlugin::Calc::CALC( $_[2].$_[1] )" ) if $debug;
colas@0
    70
colas@0
    71
    @tableMatrix = ();
colas@0
    72
    $cPos = -1;
colas@0
    73
    $rPos = -1;
colas@0
    74
    $web = $_[2];
colas@0
    75
colas@0
    76
    my @result = ();
colas@0
    77
    my $insidePRE = 0;
colas@0
    78
    my $insideTABLE = 0;
colas@0
    79
    my $line = "";
colas@0
    80
    my $before = "";
colas@0
    81
    my $cell = "";
colas@0
    82
    my @row = ();
colas@0
    83
colas@0
    84
    $_[0] =~ s/\r//go;
colas@0
    85
    $_[0] =~ s/\\\n//go;  # Join lines ending in "\"
colas@0
    86
    foreach( split( /\n/, $_[0] ) ) {
colas@0
    87
colas@0
    88
        # change state:
colas@0
    89
        m|<pre>|i       && ( $insidePRE = 1 );
colas@0
    90
        m|<verbatim>|i  && ( $insidePRE = 1 );
colas@0
    91
        m|</pre>|i      && ( $insidePRE = 0 );
colas@0
    92
        m|</verbatim>|i && ( $insidePRE = 0 );
colas@0
    93
colas@0
    94
        if( ! ( $insidePRE ) ) {
colas@0
    95
colas@0
    96
            if( /^\s*\|.*\|\s*$/ ) {
colas@0
    97
                # inside | table |
colas@0
    98
                if( ! $insideTABLE ) {
colas@0
    99
                    $insideTABLE = 1;
colas@0
   100
                    @tableMatrix = ();  # reset table matrix
colas@0
   101
                    $cPos = -1;
colas@0
   102
                    $rPos = -1;
colas@0
   103
                }
colas@0
   104
                $line = $_;
colas@0
   105
                $line =~ s/^(\s*\|)(.*)\|\s*$/$2/o;
colas@0
   106
                $before = $1;
colas@0
   107
                @row  = split( /\|/o, $line, -1 );
colas@0
   108
                push( @tableMatrix, [ @row ] );
colas@0
   109
                $rPos++;
colas@0
   110
                $line = "$before";
colas@0
   111
                for( $cPos = 0; $cPos < @row; $cPos++ ) {
colas@0
   112
                    $cell = $row[$cPos];
colas@0
   113
                    $cell =~ s/%CALC\{(.*?)\}%/&doCalc($1)/geo;
colas@0
   114
                    $line .= "$cell|";
colas@0
   115
                }
colas@0
   116
                s/.*/$line/o;
colas@0
   117
colas@0
   118
            } else {
colas@0
   119
                # outside | table |
colas@0
   120
                if( $insideTABLE ) {
colas@0
   121
                    $insideTABLE = 0;
colas@0
   122
                }
colas@0
   123
                s/%CALC\{(.*?)\}%/&doCalc($1)/geo;
colas@0
   124
            }
colas@0
   125
        }
colas@0
   126
        push( @result, $_ );
colas@0
   127
    }
colas@0
   128
    $_[0] = join( "\n", @result );
colas@0
   129
}
colas@0
   130
colas@0
   131
# =========================
colas@0
   132
sub doCalc
colas@0
   133
{
colas@0
   134
    my( $theAttributes ) = @_;
colas@0
   135
    my $text = &TWiki::Func::extractNameValuePair( $theAttributes );
colas@0
   136
colas@0
   137
    # Add nesting level to parenthesis,
colas@0
   138
    # e.g. "A(B())" gets "A-esc-1(B-esc-2(-esc-2)-esc-1)"
colas@0
   139
    my $level = 0;
colas@0
   140
    $text =~ s/([\(\)])/addNestingLevel($1, \$level)/geo;
colas@0
   141
    $text = doFunc( "MAIN", $text );
colas@0
   142
colas@0
   143
    if( ( $rPos >= 0 ) && ( $cPos >= 0 ) ) {
colas@0
   144
        # update cell in table matrix
colas@0
   145
        $tableMatrix[$rPos][$cPos] = $text;
colas@0
   146
    }
colas@0
   147
colas@0
   148
    return $text;
colas@0
   149
}
colas@0
   150
colas@0
   151
# =========================
colas@0
   152
sub addNestingLevel
colas@0
   153
{
colas@0
   154
  my( $theParen, $theLevelRef ) = @_;
colas@0
   155
colas@0
   156
  my $result = "";
colas@0
   157
  if( $theParen eq "(" ) {
colas@0
   158
    $$theLevelRef++;
colas@0
   159
    $result = "$escToken$$theLevelRef$theParen";
colas@0
   160
  } else {
colas@0
   161
    $result = "$escToken$$theLevelRef$theParen";
colas@0
   162
    $$theLevelRef--;
colas@0
   163
  }
colas@0
   164
  return $result;
colas@0
   165
}
colas@0
   166
colas@0
   167
# =========================
colas@0
   168
sub doFunc
colas@0
   169
{
colas@0
   170
    my( $theFunc, $theAttr ) = @_;
colas@0
   171
colas@0
   172
    $theAttr = "" unless( defined $theAttr );
colas@0
   173
    TWiki::Func::writeDebug( "- SpreadSheetPlugin::Calc::doFunc: $theFunc( $theAttr ) start" ) if $debug;
colas@0
   174
colas@0
   175
    unless( $theFunc =~ /^(IF|LISTIF|LISTMAP|NOEXEC)$/ ) {
colas@0
   176
        # Handle functions recursively
colas@0
   177
        $theAttr =~ s/\$([A-Z]+)$escToken([0-9]+)\((.*?)$escToken\2\)/&doFunc($1,$3)/geo;
colas@0
   178
        # Clean up unbalanced mess
colas@0
   179
        $theAttr =~ s/$escToken\-*[0-9]+([\(\)])/$1/go;
colas@0
   180
    }
colas@0
   181
    # else: delay the function handler to after parsing the parameters,
colas@0
   182
    # in which case handling functions and cleaning up needs to be done later
colas@0
   183
colas@0
   184
    my $result = "";
colas@0
   185
    my $i = 0;
colas@0
   186
    if( $theFunc eq "MAIN" ) {
colas@0
   187
        $result = $theAttr;
colas@0
   188
colas@0
   189
    } elsif( $theFunc eq "EXEC" ) {
colas@0
   190
        # add nesting level escapes
colas@0
   191
        my $level = 0;
colas@0
   192
        $result = $theAttr;
colas@0
   193
        $result =~ s/([\(\)])/addNestingLevel($1, \$level)/geo;
colas@0
   194
        # execute functions in attribute recursively and clean up unbalanced parenthesis
colas@0
   195
        $result =~ s/\$([A-Z]+)$escToken([0-9]+)\((.*?)$escToken\2\)/&doFunc($1,$3)/geo;
colas@0
   196
        $result =~ s/$escToken\-*[0-9]+([\(\)])/$1/go;
colas@0
   197
colas@0
   198
    } elsif( $theFunc eq "NOEXEC" ) {
colas@0
   199
        $result = $theAttr;
colas@0
   200
colas@0
   201
    } elsif( $theFunc eq "T" ) {
colas@0
   202
        $result = "";
colas@0
   203
        my @arr = getTableRange( "$theAttr..$theAttr" );
colas@0
   204
        if( @arr ) {
colas@0
   205
            $result = $arr[0];
colas@0
   206
        }
colas@0
   207
colas@0
   208
    } elsif( $theFunc eq "TRIM" ) {
colas@0
   209
        $result = $theAttr || "";
colas@0
   210
        $result =~ s/^\s*//o;
colas@0
   211
        $result =~ s/\s*$//o;
colas@0
   212
        $result =~ s/\s+/ /go;
colas@0
   213
colas@0
   214
    } elsif( $theFunc eq "FORMAT" ) {
colas@0
   215
        # Format FORMAT(TYPE, precision, value) returns formatted value -- JimStraus - 05 Jan 2003
colas@0
   216
        my( $format, $res, $value )  = split( /,\s*/, $theAttr );
colas@0
   217
        $format =~ s/^\s*(.*?)\s*$/$1/; #Strip leading and trailing spaces
colas@0
   218
        $res =~ s/^\s*(.*?)\s*$/$1/;
colas@0
   219
        $value =~ s/^\s*(.*?)\s*$/$1/;
colas@0
   220
        if( $format eq "DOLLAR" ) {
colas@0
   221
            my $neg = 1 if $value < 0;
colas@0
   222
            $value = abs($value);
colas@0
   223
            $result = sprintf("%0.${res}f", $value);
colas@0
   224
            my $temp = reverse $result;
colas@0
   225
            $temp =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
colas@0
   226
            $result = "\$" . (scalar reverse $temp);
colas@0
   227
            $result = "(".$result.")" if $neg;
colas@0
   228
        } elsif( $format eq "COMMA" ) {
colas@0
   229
            $result = sprintf("%0.${res}f", $value);
colas@0
   230
            my $temp = reverse $result;
colas@0
   231
            $temp =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
colas@0
   232
            $result = scalar reverse $temp;
colas@0
   233
        } elsif( $format eq "PERCENT" ) {
colas@0
   234
            $result = sprintf("%0.${res}f%%", $value * 100);
colas@0
   235
        } elsif( $format eq "NUMBER" ) {
colas@0
   236
            $result = sprintf("%0.${res}f", $value);
colas@0
   237
        } elsif( $format eq "K" ) {
colas@0
   238
            $result = sprintf("%0.${res}f K", $value / 1024);
colas@0
   239
        } elsif( $format eq "KB" ) {
colas@0
   240
            $result = sprintf("%0.${res}f KB", $value / 1024);
colas@0
   241
        } elsif ($format eq "MB") {
colas@0
   242
            $result = sprintf("%0.${res}f MB", $value / (1024 * 1024));
colas@0
   243
        } elsif( $format =~ /^KBMB/ ) {
colas@0
   244
            $value /= 1024;
colas@0
   245
            my @lbls = ( "MB", "GB", "TB", "PB", "EB", "ZB" );
colas@0
   246
            my $lbl = "KB";
colas@0
   247
            while( $value >= 1024 && @lbls ) {
colas@0
   248
                $value /= 1024;
colas@0
   249
                $lbl = shift @lbls;
colas@0
   250
            }
colas@0
   251
            $result = sprintf("%0.${res}f", $value) . " $lbl";
colas@0
   252
        } else {
colas@0
   253
            # FORMAT not recognized, just return value
colas@0
   254
            $result = $value;
colas@0
   255
        }
colas@0
   256
colas@0
   257
    } elsif( $theFunc eq "EXACT" ) {
colas@0
   258
        $result = 0;
colas@0
   259
        my( $str1, $str2 ) = split( /,\s*/, $theAttr, 2 );
colas@0
   260
        $str1 = "" unless( $str1 );
colas@0
   261
        $str2 = "" unless( $str2 );
colas@0
   262
        $str1 =~ s/^\s*(.*?)\s*$/$1/o; # cut leading and trailing spaces
colas@0
   263
        $str2 =~ s/^\s*(.*?)\s*$/$1/o;
colas@0
   264
        $result = 1 if( $str1 eq $str2 );
colas@0
   265
colas@0
   266
    } elsif( $theFunc eq "RAND" ) {
colas@0
   267
        my $max = _getNumber( $theAttr );
colas@0
   268
        $max = 1 if( $max <= 0 );
colas@0
   269
        $result = rand( $max );
colas@0
   270
colas@0
   271
    } elsif( $theFunc eq "VALUE" ) {
colas@0
   272
        $result = _getNumber( $theAttr );
colas@0
   273
colas@0
   274
    } elsif( $theFunc =~ /^(EVAL|INT)$/ ) {
colas@0
   275
        $result = safeEvalPerl( $theAttr );
colas@0
   276
        unless( $result =~ /^ERROR/ ) {
colas@0
   277
            $result = int( _getNumber( $result ) ) if( $theFunc eq "INT" );
colas@0
   278
        }
colas@0
   279
colas@0
   280
    } elsif( $theFunc eq "ROUND" ) {
colas@0
   281
        # ROUND(num, digits)
colas@0
   282
        my( $num, $digits ) = split( /,\s*/, $theAttr, 2 );
colas@0
   283
        $result = safeEvalPerl( $num );
colas@0
   284
        unless( $result =~ /^ERROR/ ) {
colas@0
   285
            $result = _getNumber( $result );
colas@0
   286
            if( ( $digits ) && ( $digits =~ s/^.*?(\-?[0-9]+).*$/$1/o ) && ( $digits ) ) {
colas@0
   287
                my $factor = 10**$digits;
colas@0
   288
                $result *= $factor;
colas@0
   289
                ( $result >= 0 ) ? ( $result += 0.5 ) : ( $result -= 0.5 );
colas@0
   290
                $result = int( $result );
colas@0
   291
                $result /= $factor;
colas@0
   292
            } else {
colas@0
   293
                ( $result >= 0 ) ? ( $result += 0.5 ) : ( $result -= 0.5 );
colas@0
   294
                $result = int( $result );
colas@0
   295
            }
colas@0
   296
        }
colas@0
   297
colas@0
   298
    } elsif( $theFunc eq "MOD" ) {
colas@0
   299
        $result = 0;
colas@0
   300
        my( $num1, $num2 ) = split( /,\s*/, $theAttr, 2 );
colas@0
   301
        $num1 = _getNumber( $num1 );
colas@0
   302
        $num2 = _getNumber( $num2 );
colas@0
   303
        if( $num1 && $num2 ) {
colas@0
   304
            $result = $num1 % $num2;
colas@0
   305
        }
colas@0
   306
colas@0
   307
    } elsif( $theFunc eq "ODD" ) {
colas@0
   308
        $result = _getNumber( $theAttr ) % 2;
colas@0
   309
colas@0
   310
    } elsif( $theFunc eq "EVEN" ) {
colas@0
   311
        $result = ( _getNumber( $theAttr ) + 1 ) % 2;
colas@0
   312
colas@0
   313
    } elsif( $theFunc eq "AND" ) {
colas@0
   314
        $result = 0;
colas@0
   315
        my @arr = getListAsInteger( $theAttr );
colas@0
   316
        foreach $i( @arr ) {
colas@0
   317
            unless( $i ) {
colas@0
   318
                $result = 0;
colas@0
   319
                last;
colas@0
   320
            }
colas@0
   321
            $result = 1;
colas@0
   322
        }
colas@0
   323
colas@0
   324
    } elsif( $theFunc eq "OR" ) {
colas@0
   325
        $result = 0;
colas@0
   326
        my @arr = getListAsInteger( $theAttr );
colas@0
   327
        foreach $i( @arr ) {
colas@0
   328
            if( $i ) {
colas@0
   329
                $result = 1;
colas@0
   330
                last;
colas@0
   331
            }
colas@0
   332
        }
colas@0
   333
colas@0
   334
    } elsif( $theFunc eq "NOT" ) {
colas@0
   335
        $result = 1;
colas@0
   336
        $result = 0 if( _getNumber( $theAttr ) );
colas@0
   337
colas@0
   338
    } elsif( $theFunc eq "ABS" ) {
colas@0
   339
        $result = abs( _getNumber( $theAttr ) );
colas@0
   340
colas@0
   341
    } elsif( $theFunc eq "SIGN" ) {
colas@0
   342
        $i = _getNumber( $theAttr );
colas@0
   343
        $result =  0;
colas@0
   344
        $result =  1 if( $i > 0 );
colas@0
   345
        $result = -1 if( $i < 0 );
colas@0
   346
colas@0
   347
    } elsif( $theFunc eq "LN" ) {
colas@0
   348
        $result = log(_getNumber( $theAttr ) );
colas@0
   349
colas@0
   350
    } elsif( $theFunc eq "LOG" ) {
colas@0
   351
        my( $num, $base ) = split( /,\s*/, $theAttr, 2 );
colas@0
   352
        $num = _getNumber( $num );
colas@0
   353
        $base = _getNumber( $base );
colas@0
   354
        $base = 10 if( $base <= 0 );
colas@0
   355
        $result = log( $num ) / log( $base );
colas@0
   356
colas@0
   357
    } elsif( $theFunc eq "EXP" ) {
colas@0
   358
        $result = exp( _getNumber( $theAttr ) );
colas@0
   359
colas@0
   360
    } elsif( $theFunc eq "PI" ) {
colas@0
   361
        $result = 3.1415926535897932384;
colas@0
   362
colas@0
   363
    } elsif( $theFunc eq "SQRT" ) {
colas@0
   364
        $result = sqrt( _getNumber( $theAttr ) );
colas@0
   365
colas@0
   366
    } elsif( $theFunc eq "IF" ) {
colas@0
   367
        # IF(condition, value if true, value if false)
colas@0
   368
        my( $condition, $str1, $str2 ) = _properSplit( $theAttr, 3 );
colas@0
   369
        # with delay, handle functions in condition recursively and clean up unbalanced parenthesis
colas@0
   370
        $condition =~ s/\$([A-Z]+)$escToken([0-9]+)\((.*?)$escToken\2\)/&doFunc($1,$3)/geo;
colas@0
   371
        $condition =~ s/$escToken\-*[0-9]+([\(\)])/$1/go;
colas@0
   372
        $condition =~ s/^\s*(.*?)\s*$/$1/o;
colas@0
   373
        $result = safeEvalPerl( $condition );
colas@0
   374
        unless( $result =~ /^ERROR/ ) {
colas@0
   375
            if( $result ) {
colas@0
   376
                $result = $str1;
colas@0
   377
            } else {
colas@0
   378
                $result = $str2;
colas@0
   379
            }
colas@0
   380
            $result = "" unless( defined( $result ) );
colas@0
   381
            # with delay, handle functions in result recursively and clean up unbalanced parenthesis
colas@0
   382
            $result =~ s/\$([A-Z]+)$escToken([0-9]+)\((.*?)$escToken\2\)/&doFunc($1,$3)/geo;
colas@0
   383
            $result =~ s/$escToken\-*[0-9]+([\(\)])/$1/go;
colas@0
   384
colas@0
   385
        } # else return error message
colas@0
   386
colas@0
   387
    } elsif( $theFunc eq "UPPER" ) {
colas@0
   388
        $result = uc( $theAttr );
colas@0
   389
colas@0
   390
    } elsif( $theFunc eq "LOWER" ) {
colas@0
   391
        $result = lc( $theAttr );
colas@0
   392
colas@0
   393
    } elsif( $theFunc eq "PROPER" ) {
colas@0
   394
        # FIXME: I18N
colas@0
   395
        $result = lc( $theAttr );
colas@0
   396
        $result =~ s/(^|[^a-z])([a-z])/$1 . uc($2)/geo;
colas@0
   397
colas@0
   398
    } elsif( $theFunc eq "PROPERSPACE" ) {
colas@0
   399
        $result = _properSpace( $theAttr );
colas@0
   400
colas@0
   401
    } elsif( $theFunc eq "CHAR" ) {
colas@0
   402
        if( $theAttr =~ /([0-9]+)/ ) {
colas@0
   403
            $i = $1;
colas@0
   404
        } else {
colas@0
   405
            $i = 0;
colas@0
   406
        }
colas@0
   407
        $i = 255 if $i > 255;
colas@0
   408
        $i = 0 if $i < 0;
colas@0
   409
        $result = chr( $i );
colas@0
   410
colas@0
   411
    } elsif( $theFunc eq "REPEAT" ) {
colas@0
   412
        my( $str, $num ) = split( /,\s*/, $theAttr, 2 );
colas@0
   413
        $str = "" unless( defined( $str ) );
colas@0
   414
        $num = _getNumber( $num );
colas@0
   415
        $result = "$str" x $num;
colas@0
   416
colas@0
   417
    } elsif( $theFunc eq "CODE" ) {
colas@0
   418
        $result = ord( $theAttr );
colas@0
   419
colas@0
   420
    } elsif( $theFunc eq "LENGTH" ) {
colas@0
   421
        $result = length( $theAttr );
colas@0
   422
colas@0
   423
    } elsif( $theFunc eq "ROW" ) {
colas@0
   424
        $i = $theAttr || 0;
colas@0
   425
        $result = $rPos + $i + 1;
colas@0
   426
colas@0
   427
    } elsif( $theFunc eq "COLUMN" ) {
colas@0
   428
        $i = $theAttr || 0;
colas@0
   429
        $result = $cPos + $i + 1;
colas@0
   430
colas@0
   431
    } elsif( $theFunc eq "LEFT" ) {
colas@0
   432
        $i = $rPos + 1;
colas@0
   433
        $result = "R$i:C0..R$i:C$cPos";
colas@0
   434
colas@0
   435
    } elsif( $theFunc eq "ABOVE" ) {
colas@0
   436
        $i = $cPos + 1;
colas@0
   437
        $result = "R0:C$i..R$rPos:C$i";
colas@0
   438
colas@0
   439
    } elsif( $theFunc eq "RIGHT" ) {
colas@0
   440
        $i = $rPos + 1;
colas@0
   441
        $result = "R$i:C$cPos..R$i:C32000";
colas@0
   442
colas@0
   443
    } elsif( $theFunc eq "DEF" ) {
colas@0
   444
        # Format DEF(list) returns first defined cell
colas@0
   445
        # Added by MF 26/3/2002, fixed by PeterThoeny
colas@0
   446
        my @arr = getList( $theAttr );
colas@0
   447
        foreach my $cell ( @arr ) {
colas@0
   448
            if( $cell ) {
colas@0
   449
                $cell =~ s/^\s*(.*?)\s*$/$1/o;
colas@0
   450
                if( $cell ) {
colas@0
   451
                    $result = $cell;
colas@0
   452
                    last;
colas@0
   453
                }
colas@0
   454
            }
colas@0
   455
        }
colas@0
   456
colas@0
   457
    } elsif( $theFunc eq "MAX" ) {
colas@0
   458
        my @arr = sort { $a <=> $b }
colas@0
   459
                  grep { /./ }
colas@0
   460
                  grep { defined $_ }
colas@0
   461
                  getListAsFloat( $theAttr );
colas@0
   462
        $result = $arr[$#arr];
colas@0
   463
colas@0
   464
    } elsif( $theFunc eq "MIN" ) {
colas@0
   465
        my @arr = sort { $a <=> $b }
colas@0
   466
                  grep { /./ }
colas@0
   467
                  grep { defined $_ }
colas@0
   468
                  getListAsFloat( $theAttr );
colas@0
   469
        $result = $arr[0];
colas@0
   470
colas@0
   471
    } elsif( $theFunc eq "SUM" ) {
colas@0
   472
        $result = 0;
colas@0
   473
        my @arr = getListAsFloat( $theAttr );
colas@0
   474
        foreach $i ( @arr ) {
colas@0
   475
            $result += $i  if defined $i;
colas@0
   476
        }
colas@0
   477
colas@0
   478
    } elsif( $theFunc eq "SUMPRODUCT" ) {
colas@0
   479
        $result = 0;
colas@0
   480
        my @arr;
colas@0
   481
        my @lol = split( /,\s*/, $theAttr );
colas@0
   482
        my $size = 32000;
colas@0
   483
        for $i (0 .. $#lol ) {
colas@0
   484
            @arr = getListAsFloat( $lol[$i] );
colas@0
   485
            $lol[$i] = [ @arr ];                # store reference to array
colas@0
   486
            $size = @arr if( @arr < $size );    # remember smallest array
colas@0
   487
        }
colas@0
   488
        if( ( $size > 0 ) && ( $size < 32000 ) ) {
colas@0
   489
            my $y; my $prod; my $val;
colas@0
   490
            $size--;
colas@0
   491
            for $y (0 .. $size ) {
colas@0
   492
                $prod = 1;
colas@0
   493
                for $i (0 .. $#lol ) {
colas@0
   494
                    $val = $lol[$i][$y];
colas@0
   495
                    if( defined $val ) {
colas@0
   496
                        $prod *= $val;
colas@0
   497
                    } else {
colas@0
   498
                        $prod = 0;   # don't count empty cells
colas@0
   499
                    }
colas@0
   500
                }
colas@0
   501
                $result += $prod;
colas@0
   502
            }
colas@0
   503
        }
colas@0
   504
colas@0
   505
    } elsif( $theFunc =~ /^(SUMDAYS|DURATION)$/ ) {
colas@0
   506
        # DURATION is undocumented, is for SvenDowideit
colas@0
   507
        # contributed by SvenDowideit - 07 Mar 2003; modified by PTh
colas@0
   508
        $result = 0;
colas@0
   509
        my @arr = getListAsDays( $theAttr );
colas@0
   510
        foreach $i ( @arr ) {
colas@0
   511
            $result += $i  if defined $i;
colas@0
   512
        }
colas@0
   513
colas@0
   514
    } elsif( $theFunc eq "WORKINGDAYS" ) {
colas@0
   515
        my( $num1, $num2 ) = split( /,\s*/, $theAttr, 2 );
colas@0
   516
        $result = _workingDays( _getNumber( $num1 ), _getNumber( $num2 ) );
colas@0
   517
colas@0
   518
    } elsif( $theFunc =~ /^(MULT|PRODUCT)$/ ) {   # MULT is deprecated, no not remove
colas@0
   519
        $result = 0;
colas@0
   520
        my @arr = getListAsFloat( $theAttr );
colas@0
   521
        $result = 1;
colas@0
   522
        foreach $i ( @arr ) {
colas@0
   523
            $result *= $i  if defined $i;
colas@0
   524
        }
colas@0
   525
colas@0
   526
    } elsif( $theFunc =~ /^(AVERAGE|MEAN)$/ ) {
colas@0
   527
        $result = 0;
colas@0
   528
        my $items = 0;
colas@0
   529
        my @arr = getListAsFloat( $theAttr );
colas@0
   530
        foreach $i ( @arr ) {
colas@0
   531
            if( defined $i ) {
colas@0
   532
                $result += $i;
colas@0
   533
                $items++;
colas@0
   534
            }
colas@0
   535
        }
colas@0
   536
        if( $items > 0 ) {
colas@0
   537
            $result = $result / $items;
colas@0
   538
        }
colas@0
   539
colas@0
   540
    } elsif( $theFunc eq "MEDIAN" ) {
colas@0
   541
        my @arr = sort { $a <=> $b } grep { defined $_ } getListAsFloat( $theAttr );
colas@0
   542
        $i = @arr;
colas@0
   543
        if( ( $i % 2 ) > 0 ) {
colas@0
   544
            $result = $arr[$i/2];
colas@0
   545
        } elsif( $i ) {
colas@0
   546
            $i /= 2;
colas@0
   547
            $result = ( $arr[$i] + $arr[$i-1] ) / 2;
colas@0
   548
        }
colas@0
   549
colas@0
   550
    } elsif( $theFunc eq "PERCENTILE" ) {
colas@0
   551
        my( $percentile, $set ) = split( /,\s*/, $theAttr, 2 );
colas@0
   552
        my @arr = sort { $a <=> $b } grep { defined $_ } getListAsFloat( $set );
colas@0
   553
        $result = 0;
colas@0
   554
colas@0
   555
        my $size = scalar( @arr );
colas@0
   556
        if( $size > 0 ) {
colas@0
   557
            $i = $percentile / 100 * ( $size + 1 );
colas@0
   558
            my $iInt = int( $i );
colas@0
   559
            if( $i <= 1 ) {
colas@0
   560
                $result = $arr[0];
colas@0
   561
            } elsif( $i >= $size ) {
colas@0
   562
                $result = $arr[$size-1];
colas@0
   563
            } elsif( $i == $iInt ) {
colas@0
   564
                $result = $arr[$i-1];
colas@0
   565
            } else {
colas@0
   566
                # interpolate beween neighbors # Example: $i = 7.25
colas@0
   567
                my $r1 = $iInt + 1 - $i;       # 0.75 = 7 + 1 - 7.25
colas@0
   568
                my $r2 = 1 - $r1;              # 0.25 = 1 - 0.75
colas@0
   569
                my $x1 = $arr[$iInt-1];
colas@0
   570
                my $x2 = $arr[$iInt];
colas@0
   571
                $result = ($r1 * $x1) + ($r2 * $x2);
colas@0
   572
            }
colas@0
   573
        }
colas@0
   574
colas@0
   575
    } elsif( $theFunc eq "COUNTSTR" ) {
colas@0
   576
        $result = 0;  # count any string
colas@0
   577
        $i = 0;       # count string equal second attr
colas@0
   578
        my $list = $theAttr;
colas@0
   579
        my $str = "";
colas@0
   580
        if( $theAttr =~ /^(.*),\s*(.*?)$/ ) {  # greedy match for last comma
colas@0
   581
            $list = $1;
colas@0
   582
            $str = $2;
colas@0
   583
        }
colas@0
   584
        $str =~ s/\s*$//o;
colas@0
   585
        my @arr = getList( $list );
colas@0
   586
        foreach my $cell ( @arr ) {
colas@0
   587
            if( defined $cell ) {
colas@0
   588
                $cell =~ s/^\s*(.*?)\s*$/$1/o;
colas@0
   589
                $result++ if( $cell );
colas@0
   590
                $i++ if( $cell eq $str );
colas@0
   591
            }
colas@0
   592
        }
colas@0
   593
        $result = $i if( $str );
colas@0
   594
colas@0
   595
    } elsif( $theFunc eq "COUNTITEMS" ) {
colas@0
   596
        $result = "";
colas@0
   597
        my @arr = getList( $theAttr );
colas@0
   598
        my %items = ();
colas@0
   599
        my $key = "";
colas@0
   600
        foreach $key ( @arr ) {
colas@0
   601
            $key =~ s/^\s*(.*?)\s*$/$1/o if( $key );
colas@0
   602
            if( $key ) {
colas@0
   603
                if( exists( $items{ $key } ) ) {
colas@0
   604
                    $items{ $key }++;
colas@0
   605
                } else {
colas@0
   606
                    $items{ $key } = 1;
colas@0
   607
                }
colas@0
   608
            }
colas@0
   609
        }
colas@0
   610
        foreach $key ( sort keys %items ) {
colas@0
   611
            $result .= "$key: $items{ $key }<br /> ";
colas@0
   612
        }
colas@0
   613
        $result =~ s|<br /> $||o;
colas@0
   614
colas@0
   615
    } elsif( $theFunc =~ /^(FIND|SEARCH)$/ ) {
colas@0
   616
        my( $searchString, $string, $pos ) = split( /,\s*/, $theAttr, 3 );
colas@0
   617
        $result = 0;
colas@0
   618
        $pos--;
colas@0
   619
        $pos = 0 if( $pos < 0 );
colas@0
   620
        pos( $string ) = $pos if( $pos );
colas@0
   621
        $searchString = quotemeta( $searchString ) if( $theFunc eq "FIND" );
colas@0
   622
        # using zero width lookahead '(?=...)' to keep pos at the beginning of match
colas@0
   623
        if( eval '$string =~ m/(?=$searchString)/g' && $string ) {
colas@0
   624
            $result = pos( $string ) + 1;
colas@0
   625
        }
colas@0
   626
colas@0
   627
    } elsif( $theFunc eq "REPLACE" ) {
colas@0
   628
        my( $string, $start, $num, $replace ) = split ( /,\s*/, $theAttr, 4 );
colas@0
   629
        $result = $string;
colas@0
   630
        $start-- unless ($start < 1);
colas@0
   631
        $num = 0 unless( $num );
colas@0
   632
        $replace = "" unless( defined $replace );
colas@0
   633
        if( eval 'substr( $string, $start, $num, $replace )' && $string ) {
colas@0
   634
            $result = $string;
colas@0
   635
        }
colas@0
   636
colas@0
   637
    } elsif( $theFunc eq "SUBSTITUTE" ) {
colas@0
   638
        my( $string, $from, $to, $inst, $options ) = split( /,\s*/, $theAttr );
colas@0
   639
        $result = $string;
colas@0
   640
        $to = "" unless( defined $to );
colas@0
   641
        $from = quotemeta( $from ) unless( $options && $options =~ /r/i);
colas@0
   642
        if( $inst ) {
colas@0
   643
            # replace Nth instance
colas@0
   644
            my $count = 0;
colas@0
   645
            if( eval '$string =~ s/($from)/if( ++$count == $inst ) { $to; } else { $1; }/gex;' && $string ) {
colas@0
   646
                $result = $string;
colas@0
   647
            }
colas@0
   648
        } else {
colas@0
   649
            # global replace
colas@0
   650
            if( eval '$string =~ s/$from/$to/g' && $string ) {
colas@0
   651
                $result = $string;
colas@0
   652
            }
colas@0
   653
        }
colas@0
   654
colas@0
   655
    } elsif( $theFunc eq "TRANSLATE" ) {
colas@0
   656
        $result = $theAttr;
colas@0
   657
        # greedy match for comma separated parameters (in case first parameter has embedded commas)
colas@0
   658
        if( $theAttr =~ /^(.*)\,\s*(.+)\,\s*(.+)$/ ) {
colas@0
   659
            my $string = $1;
colas@0
   660
            my $from = $2;
colas@0
   661
            my $to   = $3;
colas@0
   662
            $from =~ s/\$comma/,/g;  $from =~ s/\$sp/ /g;  $from = quotemeta( $from );
colas@0
   663
            $to   =~ s/\$comma/,/g;  $to   =~ s/\$sp/ /g;  $to   = quotemeta( $to );
colas@0
   664
            $from =~ s/([a-zA-Z0-9])\\\-([a-zA-Z0-9])/$1\-$2/g; # fix quotemeta (allow only ranges)
colas@0
   665
            $to   =~ s/([a-zA-Z0-9])\\\-([a-zA-Z0-9])/$1\-$2/g;
colas@0
   666
            $result = $string;
colas@0
   667
            if( $string && eval "\$string =~ tr/$from/$to/" ) {
colas@0
   668
                $result = $string;
colas@0
   669
            }
colas@0
   670
        }
colas@0
   671
colas@0
   672
    } elsif ( $theFunc eq "TIME" ) {
colas@0
   673
        $result = $theAttr;
colas@0
   674
        $result =~ s/^\s+//o;
colas@0
   675
        $result =~ s/\s+$//o;
colas@0
   676
        if( $result ) {
colas@0
   677
            $result = _date2serial( $result );
colas@0
   678
        } else {
colas@0
   679
            $result = time();
colas@0
   680
        }
colas@0
   681
colas@0
   682
    } elsif ( $theFunc eq "TODAY" ) {
colas@0
   683
        $result = _date2serial( _serial2date( time(), '$year/$month/$day GMT', 1 ) );
colas@0
   684
colas@0
   685
    } elsif( $theFunc =~ /^(FORMATTIME|FORMATGMTIME)$/ ) {
colas@0
   686
        my( $time, $str ) = split( /,\s*/, $theAttr, 2 );
colas@0
   687
        if( $time =~ /([0-9]+)/ ) {
colas@0
   688
            $time = $1;
colas@0
   689
        } else {
colas@0
   690
            $time = time();
colas@0
   691
        }
colas@0
   692
        my $isGmt = 0;
colas@0
   693
        $isGmt = 1 if( ( $str =~ m/ gmt/i ) || ( $theFunc eq "FORMATGMTIME" ) );
colas@0
   694
        $result = _serial2date( $time, $str, $isGmt );
colas@0
   695
colas@0
   696
    } elsif( $theFunc eq "FORMATTIMEDIFF" ) {
colas@0
   697
        my( $scale, $prec, $time ) = split( /,\s*/, $theAttr, 3 );
colas@0
   698
        $scale = "" unless( $scale );
colas@0
   699
        $prec = int( _getNumber( $prec ) - 1 );
colas@0
   700
        $prec = 0 if( $prec < 0 );
colas@0
   701
        $time = _getNumber( $time );
colas@0
   702
        $time = 0 if( $time < 0 );
colas@0
   703
        my @unit  = ( 0, 0, 0, 0, 0, 0 ); # sec, min, hours, days, month, years
colas@0
   704
        my @factor = ( 1, 60, 60, 24, 30.4166, 12 ); # sec, min, hours, days, month, years
colas@0
   705
        my @singular = ( 'second',  'minute',  'hour',  'day',  'month', 'year' );
colas@0
   706
        my @plural =   ( 'seconds', 'minutes', 'hours', 'days', 'month', 'years' );
colas@0
   707
        my $min = 0;
colas@0
   708
        my $max = $prec;
colas@0
   709
        if( $scale =~ /^min/i ) {
colas@0
   710
            $min = 1;
colas@0
   711
            $unit[1] = $time;
colas@0
   712
        } elsif( $scale =~ /^hou/i ) {
colas@0
   713
            $min = 2;
colas@0
   714
            $unit[2] = $time;
colas@0
   715
        } elsif( $scale =~ /^day/i ) {
colas@0
   716
            $min = 3;
colas@0
   717
            $unit[3] = $time;
colas@0
   718
        } elsif( $scale =~ /^mon/i ) {
colas@0
   719
            $min = 4;
colas@0
   720
            $unit[4] = $time;
colas@0
   721
        } elsif( $scale =~ /^yea/i ) {
colas@0
   722
            $min = 5;
colas@0
   723
            $unit[5] = $time;
colas@0
   724
        } else {
colas@0
   725
            $unit[0] = $time;
colas@0
   726
        }
colas@0
   727
        my @arr = ();
colas@0
   728
        my $i = 0;
colas@0
   729
        my $val1 = 0;
colas@0
   730
        my $val2 = 0;
colas@0
   731
        for( $i = $min; $i < 5; $i++ ) {
colas@0
   732
            $val1 = $unit[$i];
colas@0
   733
            $val2 = $unit[$i+1] = int($val1 / $factor[$i+1]);
colas@0
   734
            $val1 = $unit[$i] = $val1 - int($val2 * $factor[$i+1]);
colas@0
   735
            
colas@0
   736
            push( @arr, "$val1 $singular[$i]" ) if( $val1 == 1 );
colas@0
   737
            push( @arr, "$val1 $plural[$i]" )   if( $val1 > 1 );
colas@0
   738
        }
colas@0
   739
        push( @arr, "$val2 $singular[$i]" ) if( $val2 == 1 );
colas@0
   740
        push( @arr, "$val2 $plural[$i]" )   if( $val2 > 1 );
colas@0
   741
        push( @arr, "0 $plural[$min]" )   unless( @arr );
colas@0
   742
        my @reverse = reverse( @arr );
colas@0
   743
        $#reverse = $prec if( @reverse > $prec );
colas@0
   744
        $result = join( ', ', @reverse );
colas@0
   745
        $result =~ s/(.+)\, /$1 and /;
colas@0
   746
colas@0
   747
    } elsif( $theFunc eq "TIMEADD" ) {
colas@0
   748
       my( $time, $value, $scale ) = split( /,\s*/, $theAttr, 3 );
colas@0
   749
       $time = 0 unless( $time );
colas@0
   750
       $value = 0 unless( $value );
colas@0
   751
       $scale = "" unless( $scale );
colas@0
   752
       $time =~ s/.*?([0-9]+).*/$1/o || 0;
colas@0
   753
       $value =~ s/.*?(\-?[0-9\.]+).*/$1/o || 0;
colas@0
   754
       $value *= 60            if( $scale =~ /^min/i );
colas@0
   755
       $value *= 3600          if( $scale =~ /^hou/i );
colas@0
   756
       $value *= 3600*24       if( $scale =~ /^day/i );
colas@0
   757
       $value *= 3600*24*7     if( $scale =~ /^week/i );
colas@0
   758
       $value *= 3600*24*30.42 if( $scale =~ /^mon/i );  # FIXME: exact calc
colas@0
   759
       $value *= 3600*24*365   if( $scale =~ /^year/i ); # FIXME: exact calc
colas@0
   760
       $result = int( $time + $value );
colas@0
   761
colas@0
   762
    } elsif( $theFunc eq "TIMEDIFF" ) {
colas@0
   763
       my( $time1, $time2, $scale ) = split( /,\s*/, $theAttr, 3 );
colas@0
   764
       $scale ||= '';
colas@0
   765
       $time1 = 0 unless( $time1 );
colas@0
   766
       $time2 = 0 unless( $time2 );
colas@0
   767
       $time1 =~ s/.*?([0-9]+).*/$1/o || 0;
colas@0
   768
       $time2 =~ s/.*?([0-9]+).*/$1/o || 0;
colas@0
   769
       $result = $time2 - $time1;
colas@0
   770
       $result /= 60            if( $scale =~ /^min/i );
colas@0
   771
       $result /= 3600          if( $scale =~ /^hou/i );
colas@0
   772
       $result /= 3600*24       if( $scale =~ /^day/i );
colas@0
   773
       $result /= 3600*24*7     if( $scale =~ /^week/i );
colas@0
   774
       $result /= 3600*24*30.42 if( $scale =~ /^mon/i );  # FIXME: exact calc
colas@0
   775
       $result /= 3600*24*365   if( $scale =~ /^year/i ); # FIXME: exact calc
colas@0
   776
colas@0
   777
    } elsif( $theFunc eq "SET" ) {
colas@0
   778
       my( $name, $value ) = split( /,\s*/, $theAttr, 2 );
colas@0
   779
       $name =~ s/[^a-zA-Z0-9\_]//go;
colas@0
   780
       if( $name && defined( $value ) ) {
colas@0
   781
           $value =~ s/\s*$//o;
colas@0
   782
           $varStore{ $name } = $value;
colas@0
   783
       }
colas@0
   784
colas@0
   785
    } elsif( $theFunc eq "SETIFEMPTY" ) {
colas@0
   786
       my( $name, $value ) = split( /,\s*/, $theAttr, 2 );
colas@0
   787
       $name =~ s/[^a-zA-Z0-9\_]//go;
colas@0
   788
       if( $name && defined( $value ) && ! $varStore{ $name } ) {
colas@0
   789
           $value =~ s/\s*$//o;
colas@0
   790
           $varStore{ $name } = $value;
colas@0
   791
       }
colas@0
   792
colas@0
   793
    } elsif( $theFunc eq "SETM" ) {
colas@0
   794
       my( $name, $value ) = split( /,\s*/, $theAttr, 2 );
colas@0
   795
       $name =~ s/[^a-zA-Z0-9\_]//go;
colas@0
   796
       if( $name ) {
colas@0
   797
           my $old = $varStore{ $name };
colas@0
   798
           $old = "" unless( defined( $old ) );
colas@0
   799
           $value = safeEvalPerl( "$old $value" );
colas@0
   800
           $varStore{ $name } = $value;
colas@0
   801
       }
colas@0
   802
colas@0
   803
    } elsif( $theFunc eq "GET" ) {
colas@0
   804
       my $name = $theAttr;
colas@0
   805
       $name =~ s/[^a-zA-Z0-9\_]//go;
colas@0
   806
       $result = $varStore{ $name } if( $name );
colas@0
   807
       $result = "" unless( defined( $result ) );
colas@0
   808
colas@0
   809
    } elsif( $theFunc eq "LIST" ) {
colas@0
   810
        my @arr = getList( $theAttr );
colas@0
   811
        $result = _listToDelimitedString( @arr );
colas@0
   812
colas@0
   813
    } elsif( $theFunc eq "LISTITEM" ) {
colas@0
   814
        my( $index, $str ) = _properSplit( $theAttr, 2 );
colas@0
   815
        $index = _getNumber( $index );
colas@0
   816
        $str = "" unless( defined( $str ) );
colas@0
   817
        my @arr = getList( $str );
colas@0
   818
        my $size = scalar @arr;
colas@0
   819
        if( $index && $size ) {
colas@0
   820
            $index-- if( $index > 0 );                 # documented index starts at 1
colas@0
   821
            $index = $size + $index if( $index < 0 );  # start from back if negative
colas@0
   822
            $result = $arr[$index] if( ( $index >= 0 ) && ( $index < $size ) );
colas@0
   823
        }
colas@0
   824
colas@0
   825
    } elsif( $theFunc eq "LISTJOIN" ) {
colas@0
   826
        my( $sep, $str ) = _properSplit( $theAttr, 2 );
colas@0
   827
        $str = "" unless( defined( $str ) );
colas@0
   828
        $result = _listToDelimitedString( getList( $str ) );
colas@0
   829
        $sep = ", " unless( $sep );
colas@0
   830
        $sep =~ s/\$comma/,/go;
colas@0
   831
        $sep =~ s/\$sp/ /go;
colas@0
   832
        $sep =~ s/\$n/\n/go;
colas@0
   833
        $result =~ s/, /$sep/go;
colas@0
   834
colas@0
   835
    } elsif( $theFunc eq "LISTSIZE" ) {
colas@0
   836
        my @arr = getList( $theAttr );
colas@0
   837
        $result = scalar @arr;
colas@0
   838
colas@0
   839
    } elsif( $theFunc eq "LISTSORT" ) {
colas@0
   840
        my $isNumeric = 1;
colas@0
   841
        my @arr = map {
colas@0
   842
            s/^\s*//o;
colas@0
   843
            s/\s*$//o;
colas@0
   844
            $isNumeric = 0 unless( $_ =~ /^[\+\-]?[0-9\.]+$/ );
colas@0
   845
            $_
colas@0
   846
        } getList( $theAttr );
colas@0
   847
        if( $isNumeric ) {
colas@0
   848
            @arr = sort { $a <=> $b } @arr;
colas@0
   849
        } else {
colas@0
   850
            @arr = sort @arr;
colas@0
   851
        }
colas@0
   852
        $result = _listToDelimitedString( @arr );
colas@0
   853
colas@0
   854
    } elsif( $theFunc eq "LISTSHUFFLE" ) {
colas@0
   855
        my @arr = getList( $theAttr );
colas@0
   856
        my $size = scalar @arr;
colas@0
   857
        if( $size > 1 ) {
colas@0
   858
            for( $i = $size; $i--; ) {
colas@0
   859
                my $j = int( rand( $i + 1 ) );
colas@0
   860
                next if( $i == $j );
colas@0
   861
                @arr[$i, $j] = @arr[$j, $i];
colas@0
   862
            }
colas@0
   863
        }
colas@0
   864
        $result = _listToDelimitedString( @arr );
colas@0
   865
colas@0
   866
    } elsif( $theFunc eq "LISTRAND" ) {
colas@0
   867
        my @arr = getList( $theAttr );
colas@0
   868
        my $size = scalar @arr;
colas@0
   869
        if( $size > 1 ) {
colas@0
   870
            $i = int( rand( $size - 1 ) + 0.5 );
colas@0
   871
            $result = $arr[$i];
colas@0
   872
        } elsif( $size == 1 ) {
colas@0
   873
            $result = $arr[0];
colas@0
   874
        }
colas@0
   875
colas@0
   876
    } elsif( $theFunc eq "LISTREVERSE" ) {
colas@0
   877
        my @arr = reverse getList( $theAttr );
colas@0
   878
        $result = _listToDelimitedString( @arr );
colas@0
   879
colas@0
   880
    } elsif( $theFunc eq "LISTTRUNCATE" ) {
colas@0
   881
        my( $index, $str ) = _properSplit( $theAttr, 2 );
colas@0
   882
        $index = int( _getNumber( $index ) );
colas@0
   883
        $str = "" unless( defined( $str ) );
colas@0
   884
        my @arr = getList( $str );
colas@0
   885
        my $size = scalar @arr;
colas@0
   886
        if( $index > 0 ) {
colas@0
   887
            $index = $size if( $index > $size );
colas@0
   888
            $#arr = $index - 1;
colas@0
   889
            $result = _listToDelimitedString( @arr );
colas@0
   890
        } elsif( $index < 0 ) {
colas@0
   891
            $index = - $size if( $index < - $size );
colas@0
   892
            splice( @arr, 0, $size + $index );
colas@0
   893
            $result = _listToDelimitedString( @arr );
colas@0
   894
        } #else result = '';
colas@0
   895
colas@0
   896
    } elsif( $theFunc eq "LISTUNIQUE" ) {
colas@0
   897
        my %seen = ();
colas@0
   898
        my @arr = grep { ! $seen{$_} ++ } getList( $theAttr );
colas@0
   899
        $result = _listToDelimitedString( @arr );
colas@0
   900
colas@0
   901
    } elsif( $theFunc eq "LISTMAP" ) {
colas@0
   902
        # LISTMAP(action, item 1, item 2, ...)
colas@0
   903
        my( $action, $str ) = _properSplit( $theAttr, 2 );
colas@0
   904
        $action = "" unless( defined( $action ) );
colas@0
   905
        $str = "" unless( defined( $str ) );
colas@0
   906
        # with delay, handle functions in result recursively and clean up unbalanced parenthesis
colas@0
   907
        $str =~ s/\$([A-Z]+)$escToken([0-9]+)\((.*?)$escToken\2\)/&doFunc($1,$3)/geo;
colas@0
   908
        $str =~ s/$escToken\-*[0-9]+([\(\)])/$1/go;
colas@0
   909
        my $item = "";
colas@0
   910
        $i = 0;
colas@0
   911
        my @arr =
colas@0
   912
            map {
colas@0
   913
               $item = $_;
colas@0
   914
               $_ = $action;
colas@0
   915
               $i++;
colas@0
   916
               s/\$index/$i/go;
colas@0
   917
               $_ .= $item unless( s/\$item/$item/go );
colas@0
   918
               s/\$([A-Z]+)$escToken([0-9]+)\((.*?)$escToken\2\)/&doFunc($1,$3)/geo;
colas@0
   919
               s/$escToken\-*[0-9]+([\(\)])/$1/go;
colas@0
   920
               $_
colas@0
   921
            } getList( $str );
colas@0
   922
        $result = _listToDelimitedString( @arr );
colas@0
   923
colas@0
   924
    } elsif( $theFunc eq "LISTIF" ) {
colas@0
   925
        # LISTIF(cmd, item 1, item 2, ...)
colas@0
   926
        my( $cmd, $str ) = _properSplit( $theAttr, 2 );
colas@0
   927
        $cmd = "" unless( defined( $cmd ) );
colas@0
   928
        $cmd =~ s/^\s*(.*?)\s*$/$1/o;
colas@0
   929
        $str = "" unless( defined( $str ) );
colas@0
   930
        # with delay, handle functions in result recursively and clean up unbalanced parenthesis
colas@0
   931
        $str =~ s/\$([A-Z]+)$escToken([0-9]+)\((.*?)$escToken\2\)/&doFunc($1,$3)/geo;
colas@0
   932
        $str =~ s/$escToken\-*[0-9]+([\(\)])/$1/go;
colas@0
   933
        my $item = "";
colas@0
   934
        my $eval = "";
colas@0
   935
        $i = 0;
colas@0
   936
        my @arr =
colas@0
   937
            grep { ! /^TWIKI_GREP_REMOVE$/ }
colas@0
   938
            map {
colas@0
   939
                $item = $_;
colas@0
   940
                $_ = $cmd;
colas@0
   941
                $i++;
colas@0
   942
                s/\$index/$i/go;
colas@0
   943
                s/\$item/$item/go;
colas@0
   944
                s/\$([A-Z]+)$escToken([0-9]+)\((.*?)$escToken\2\)/&doFunc($1,$3)/geo;
colas@0
   945
                s/$escToken\-*[0-9]+([\(\)])/$1/go;
colas@0
   946
                $eval = safeEvalPerl( $_ );
colas@0
   947
                if( $eval =~ /^ERROR/ ) {
colas@0
   948
                    $_ = $eval;
colas@0
   949
                } elsif( $eval ) {
colas@0
   950
                    $_ = $item;
colas@0
   951
                } else {
colas@0
   952
                    $_ = "TWIKI_GREP_REMOVE";
colas@0
   953
                }
colas@0
   954
            } getList( $str );
colas@0
   955
        $result = _listToDelimitedString( @arr );
colas@0
   956
colas@0
   957
    } elsif ( $theFunc eq "NOP" ) {
colas@0
   958
        # pass everything through, this will allow plugins to defy plugin order
colas@0
   959
        # for example the %SEARCH{}% variable
colas@0
   960
        $theAttr =~ s/\$per/%/g;
colas@0
   961
        $result = $theAttr;
colas@0
   962
colas@0
   963
    } elsif ( $theFunc eq "EXISTS" ) {
colas@0
   964
        $result = TWiki::Func::topicExists( $web, $theAttr );
colas@0
   965
        $result = 0 unless( $result );
colas@0
   966
    }
colas@0
   967
colas@0
   968
    TWiki::Func::writeDebug( "- SpreadSheetPlugin::Calc::doFunc: $theFunc( $theAttr ) returns: $result" ) if $debug;
colas@0
   969
    return $result;
colas@0
   970
}
colas@0
   971
colas@0
   972
# =========================
colas@0
   973
sub _listToDelimitedString
colas@0
   974
{
colas@0
   975
    my @arr = map { s/^\s*//o; s/\s*$//o; $_ } @_;
colas@0
   976
    my $text = join( ", ", @arr );
colas@0
   977
    return $text;
colas@0
   978
}
colas@0
   979
colas@0
   980
# =========================
colas@0
   981
sub _properSplit
colas@0
   982
{
colas@0
   983
    my( $theAttr, $theLevel ) = @_;
colas@0
   984
colas@0
   985
    # escape commas inside functions
colas@0
   986
    $theAttr =~ s/(\$[A-Z]+$escToken([0-9]+)\(.*?$escToken\2\))/_escapeCommas($1)/geo;
colas@0
   987
    # split at commas and restore commas inside functions
colas@0
   988
    my @arr = map{ s/<$escToken>/\,/go; $_ } split( /,\s*/, $theAttr, $theLevel );
colas@0
   989
    return @arr;
colas@0
   990
}
colas@0
   991
colas@0
   992
# =========================
colas@0
   993
sub _escapeCommas
colas@0
   994
{
colas@0
   995
    my( $theText ) = @_;
colas@0
   996
    $theText =~ s/\,/<$escToken>/go;
colas@0
   997
    return $theText;
colas@0
   998
}
colas@0
   999
colas@0
  1000
# =========================
colas@0
  1001
sub _getNumber
colas@0
  1002
{
colas@0
  1003
    my( $theText ) = @_;
colas@0
  1004
    return 0 unless( $theText );
colas@0
  1005
    $theText =~ s/([0-9])\,(?=[0-9]{3})/$1/go;          # "1,234,567" ==> "1234567"
colas@0
  1006
    if( $theText =~ /[0-9]e/i ) {                       # "1.5e-3"    ==> "0.0015"
colas@0
  1007
        $theText = sprintf "%.20f", $theText;
colas@0
  1008
        $theText =~ s/0+$//;
colas@0
  1009
    }
colas@0
  1010
    unless( $theText =~ s/^.*?(\-?[0-9\.]+).*$/$1/o ) { # "xy-1.23zz" ==> "-1.23"
colas@0
  1011
        $theText = 0;
colas@0
  1012
    }
colas@0
  1013
    $theText =~ s/^(\-?)0+([0-9])/$1$2/o;               # "-0009.12"  ==> "-9.12"
colas@0
  1014
    $theText =~ s/^(\-?)\./${1}0\./o;                   # "-.25"      ==> "-0.25"
colas@0
  1015
    $theText =~ s/^\-0$/0/o;                            # "-0"        ==> "0"
colas@0
  1016
    $theText =~ s/\.$//o;                               # "123."      ==> "123"
colas@0
  1017
    return $theText;
colas@0
  1018
}
colas@0
  1019
colas@0
  1020
# =========================
colas@0
  1021
sub safeEvalPerl
colas@0
  1022
{
colas@0
  1023
    my( $theText ) = @_;
colas@0
  1024
    # Allow only simple math with operators - + * / % ( )
colas@0
  1025
    $theText =~ s/\%\s*[^\-\+\*\/0-9\.\(\)]+//go; # defuse %hash but keep modulus
colas@0
  1026
    # keep only numbers and operators (shh... don't tell anyone, we support comparison operators)
colas@0
  1027
    $theText =~ s/[^\!\<\=\>\-\+\*\/\%0-9e\.\(\)]*//go;
colas@0
  1028
    $theText =~ s/(^|[^0-9])e/$1/go;  # remove "e"-s unless in expression such as "123e-4"
colas@0
  1029
    $theText =~ /(.*)/;
colas@0
  1030
    $theText = $1;  # untainted variable
colas@0
  1031
    return "" unless( $theText );
colas@0
  1032
    local $SIG{__DIE__} = sub { TWiki::Func::writeDebug($_[0]); warn $_[0] };
colas@0
  1033
    my $result = eval $theText;
colas@0
  1034
    if( $@ ) {
colas@0
  1035
        $result = $@;
colas@0
  1036
        $result =~ s/[\n\r]//go;
colas@0
  1037
        $result =~ s/\[[^\]]+.*view.*?\:\s?//o;                   # Cut "[Mon Mar 15 23:31:39 2004] view: "
colas@0
  1038
        $result =~ s/\s?at \(eval.*?\)\sline\s?[0-9]*\.?\s?//go;  # Cut "at (eval 51) line 2."
colas@0
  1039
        $result = "ERROR: $result";
colas@0
  1040
colas@0
  1041
    } else {
colas@0
  1042
        $result = 0 unless( $result );  # logical false is "0"
colas@0
  1043
    }
colas@0
  1044
    return $result;
colas@0
  1045
}
colas@0
  1046
colas@0
  1047
# =========================
colas@0
  1048
sub getListAsInteger
colas@0
  1049
{
colas@0
  1050
    my( $theAttr ) = @_;
colas@0
  1051
colas@0
  1052
    my $val = 0;
colas@0
  1053
    my @list = getList( $theAttr );
colas@0
  1054
    (my $baz = "foo") =~ s/foo//;  # reset search vars. defensive coding
colas@0
  1055
    for my $i (0 .. $#list ) {
colas@0
  1056
        $val = $list[$i];
colas@0
  1057
        # search first integer pattern, skip over HTML tags
colas@0
  1058
        if( $val =~ /^\s*(?:<[^>]*>)*([\-\+]*[0-9]+).*/o ) {
colas@0
  1059
            $list[$i] = $1;  # untainted variable, possibly undef
colas@0
  1060
        } else {
colas@0
  1061
            $list[$i] = undef;
colas@0
  1062
        }
colas@0
  1063
    }
colas@0
  1064
    return @list;
colas@0
  1065
}
colas@0
  1066
colas@0
  1067
# =========================
colas@0
  1068
sub getListAsFloat
colas@0
  1069
{
colas@0
  1070
    my( $theAttr ) = @_;
colas@0
  1071
colas@0
  1072
    my $val = 0;
colas@0
  1073
    my @list = getList( $theAttr );
colas@0
  1074
    (my $baz = "foo") =~ s/foo//;  # reset search vars. defensive coding
colas@0
  1075
    for my $i (0 .. $#list ) {
colas@0
  1076
        $val = $list[$i] || "";
colas@0
  1077
        # search first float pattern, skip over HTML tags
colas@0
  1078
        if( $val =~ /^\s*(?:<[^>]*>)*\$?([\-\+]*[0-9\.]+).*/o ) {
colas@0
  1079
            $list[$i] = $1;  # untainted variable, possibly undef
colas@0
  1080
        } else {
colas@0
  1081
            $list[$i] = undef;
colas@0
  1082
        }
colas@0
  1083
    }
colas@0
  1084
    return @list;
colas@0
  1085
}
colas@0
  1086
colas@0
  1087
# =========================
colas@0
  1088
sub getListAsDays
colas@0
  1089
{
colas@0
  1090
    my( $theAttr ) = @_;
colas@0
  1091
colas@0
  1092
    # contributed by by SvenDowideit - 07 Mar 2003; modified by PTh
colas@0
  1093
    my $val = 0;
colas@0
  1094
    my @arr = getList( $theAttr );
colas@0
  1095
    (my $baz = "foo") =~ s/foo//;  # reset search vars. defensive coding
colas@0
  1096
    for my $i (0 .. $#arr ) {
colas@0
  1097
        $val = $arr[$i] || "";
colas@0
  1098
        # search first float pattern
colas@0
  1099
        if( $val =~ /^\s*([\-\+]*[0-9\.]+)\s*d/oi ) {
colas@0
  1100
            $arr[$i] = $1;      # untainted variable, possibly undef
colas@0
  1101
        } elsif( $val =~ /^\s*([\-\+]*[0-9\.]+)\s*w/oi ) {
colas@0
  1102
            $arr[$i] = 5 * $1;  # untainted variable, possibly undef
colas@0
  1103
        } elsif( $val =~ /^\s*([\-\+]*[0-9\.]+)\s*h/oi ) {
colas@0
  1104
            $arr[$i] = $1 / 8;  # untainted variable, possibly undef
colas@0
  1105
        } elsif( $val =~ /^\s*([\-\+]*[0-9\.]+)/o ) {
colas@0
  1106
            $arr[$i] = $1;      # untainted variable, possibly undef
colas@0
  1107
        } else {
colas@0
  1108
            $arr[$i] = undef;
colas@0
  1109
        }
colas@0
  1110
    }
colas@0
  1111
    return @arr;
colas@0
  1112
}
colas@0
  1113
colas@0
  1114
# =========================
colas@0
  1115
sub getList
colas@0
  1116
{
colas@0
  1117
    my( $theAttr ) = @_;
colas@0
  1118
colas@0
  1119
    my @list = ();
colas@0
  1120
    foreach( split( /,\s*/, $theAttr ) ) {
colas@0
  1121
        if( m/\s*R([0-9]+)\:C([0-9]+)\s*\.\.+\s*R([0-9]+)\:C([0-9]+)/ ) {
colas@0
  1122
            # table range
colas@0
  1123
            push( @list, getTableRange( $_ ) );
colas@0
  1124
        } else {
colas@0
  1125
            # list item
colas@0
  1126
            $list[$#list+1] = $_;
colas@0
  1127
        }
colas@0
  1128
    }
colas@0
  1129
    return @list;
colas@0
  1130
}
colas@0
  1131
colas@0
  1132
# =========================
colas@0
  1133
sub getTableRange
colas@0
  1134
{
colas@0
  1135
    my( $theAttr ) = @_;
colas@0
  1136
colas@0
  1137
    my @arr = ();
colas@0
  1138
    if( $rPos < 0 ) {
colas@0
  1139
        return @arr;
colas@0
  1140
    }
colas@0
  1141
colas@0
  1142
    TWiki::Func::writeDebug( "- SpreadSheetPlugin::Calc::getTableRange( $theAttr )" ) if $debug;
colas@0
  1143
    unless( $theAttr =~ /\s*R([0-9]+)\:C([0-9]+)\s*\.\.+\s*R([0-9]+)\:C([0-9]+)/ ) {
colas@0
  1144
        return @arr;
colas@0
  1145
    }
colas@0
  1146
    my $r1 = $1 - 1;
colas@0
  1147
    my $c1 = $2 - 1;
colas@0
  1148
    my $r2 = $3 - 1;
colas@0
  1149
    my $c2 = $4 - 1;
colas@0
  1150
    my $r = 0;
colas@0
  1151
    my $c = 0;
colas@0
  1152
    if( $c1 < 0     ) { $c1 = 0; }
colas@0
  1153
    if( $c2 < 0     ) { $c2 = 0; }
colas@0
  1154
    if( $c2 < $c1   ) { $c = $c1; $c1 = $c2; $c2 = $c; }
colas@0
  1155
    if( $r1 > $rPos ) { $r1 = $rPos; }
colas@0
  1156
    if( $r1 < 0     ) { $r1 = 0; }
colas@0
  1157
    if( $r2 > $rPos ) { $r2 = $rPos; }
colas@0
  1158
    if( $r2 < 0     ) { $r2 = 0; }
colas@0
  1159
    if( $r2 < $r1   ) { $r = $r1; $r1 = $r2; $r2 = $r; }
colas@0
  1160
colas@0
  1161
    my $pRow = ();
colas@0
  1162
    for $r ( $r1 .. $r2 ) {
colas@0
  1163
        $pRow = $tableMatrix[$r];
colas@0
  1164
        for $c ( $c1 .. $c2 ) {
colas@0
  1165
            if( $c < @$pRow ) {
colas@0
  1166
                push( @arr, $$pRow[$c] );
colas@0
  1167
            }
colas@0
  1168
        }
colas@0
  1169
    }
colas@0
  1170
    TWiki::Func::writeDebug( "- SpreadSheetPlugin::Calc::getTableRange() returns @arr" ) if $debug;
colas@0
  1171
    return @arr;
colas@0
  1172
}
colas@0
  1173
colas@0
  1174
# =========================
colas@0
  1175
sub _date2serial
colas@0
  1176
{
colas@0
  1177
    my ( $theText ) = @_;
colas@0
  1178
colas@0
  1179
    my $sec = 0; my $min = 0; my $hour = 0; my $day = 1; my $mon = 0; my $year = 0;
colas@0
  1180
colas@0
  1181
    if( $theText =~ m|([0-9]{1,2})[-\s/]+([A-Z][a-z][a-z])[-\s/]+([0-9]{4})[-\s/]+([0-9]{1,2}):([0-9]{1,2})| ) {
colas@0
  1182
        # "31 Dec 2003 - 23:59", "31-Dec-2003 - 23:59", "31 Dec 2003 - 23:59 - any suffix"
colas@0
  1183
        $day = $1; $mon = $mon2num{$2} || 0; $year = $3 - 1900; $hour = $4; $min = $5;
colas@0
  1184
    } elsif( $theText =~ m|([0-9]{1,2})[-\s/]+([A-Z][a-z][a-z])[-\s/]+([0-9]{2,4})| ) {
colas@0
  1185
        # "31 Dec 2003", "31 Dec 03", "31-Dec-2003", "31/Dec/2003"
colas@0
  1186
        $day = $1; $mon = $mon2num{$2} || 0; $year = $3;
colas@0
  1187
        $year += 100 if( $year < 80 );      # "05"   --> "105" (leave "99" as is)
colas@0
  1188
        $year -= 1900 if( $year >= 1900 );  # "2005" --> "105"
colas@0
  1189
    } elsif( $theText =~ m|([0-9]{4})[-/\.]([0-9]{1,2})[-/\.]([0-9]{1,2})[-/\.\,\s]+([0-9]{1,2})[-\:/\.]([0-9]{1,2})[-\:/\.]([0-9]{1,2})| ) {
colas@0
  1190
        # "2003/12/31 23:59:59", "2003-12-31-23-59-59", "2003.12.31.23.59.59"
colas@0
  1191
        $year = $1 - 1900; $mon = $2 - 1; $day = $3; $hour = $4; $min = $5; $sec = $6;
colas@0
  1192
    } elsif( $theText =~ m|([0-9]{4})[-/\.]([0-9]{1,2})[-/\.]([0-9]{1,2})[-/\.\,\s]+([0-9]{1,2})[-\:/\.]([0-9]{1,2})| ) {
colas@0
  1193
        # "2003/12/31 23:59", "2003-12-31-23-59", "2003.12.31.23.59"
colas@0
  1194
        $year = $1 - 1900; $mon = $2 - 1; $day = $3; $hour = $4; $min = $5;
colas@0
  1195
    } elsif( $theText =~ m|([0-9]{4})[-/]([0-9]{1,2})[-/]([0-9]{1,2})| ) {
colas@0
  1196
        # "2003/12/31", "2003-12-31"
colas@0
  1197
        $year = $1 - 1900; $mon = $2 - 1; $day = $3;
colas@0
  1198
    } elsif( $theText =~ m|([0-9]{1,2})[-/]([0-9]{1,2})[-/]([0-9]{2,4})| ) {
colas@0
  1199
        # "12/31/2003", "12/31/03", "12-31-2003"
colas@0
  1200
        # (shh, don't tell anyone that we support ambiguous American dates, my boss asked me to)
colas@0
  1201
        $year = $3; $mon = $1 - 1; $day = $2;
colas@0
  1202
        $year += 100 if( $year < 80 );      # "05"   --> "105" (leave "99" as is)
colas@0
  1203
        $year -= 1900 if( $year >= 1900 );  # "2005" --> "105"
colas@0
  1204
    } else {
colas@0
  1205
        # unsupported format
colas@0
  1206
        return 0;
colas@0
  1207
    }
colas@0
  1208
    if( ( $sec > 60 ) || ( $min > 59 ) || ( $hour > 23 ) || ( $day < 1 ) || ( $day > 31 ) || ( $mon > 11 ) ) {
colas@0
  1209
        # unsupported, out of range
colas@0
  1210
        return 0;
colas@0
  1211
    }
colas@0
  1212
    if( $theText =~ /gmt/i ) {
colas@0
  1213
        return timegm( $sec, $min, $hour, $day, $mon, $year );
colas@0
  1214
    } else {
colas@0
  1215
        return timelocal( $sec, $min, $hour, $day, $mon, $year );
colas@0
  1216
    }
colas@0
  1217
}
colas@0
  1218
colas@0
  1219
# =========================
colas@0
  1220
sub _serial2date
colas@0
  1221
{
colas@0
  1222
    my ( $theTime, $theStr, $isGmt ) = @_;
colas@0
  1223
colas@0
  1224
    my( $sec, $min, $hour, $day, $mon, $year, $wday, $yday ) = localtime( $theTime );
colas@0
  1225
    (   $sec, $min, $hour, $day, $mon, $year, $wday, $yday ) = gmtime( $theTime ) if( $isGmt );
colas@0
  1226
colas@0
  1227
    $theStr =~ s/\$sec[o]?[n]?[d]?[s]?/sprintf("%.2u",$sec)/geoi;
colas@0
  1228
    $theStr =~ s/\$min[u]?[t]?[e]?[s]?/sprintf("%.2u",$min)/geoi;
colas@0
  1229
    $theStr =~ s/\$hou[r]?[s]?/sprintf("%.2u",$hour)/geoi;
colas@0
  1230
    $theStr =~ s/\$day/sprintf("%.2u",$day)/geoi;
colas@0
  1231
    $theStr =~ s/\$mon(?!t)/$monArr[$mon]/goi;
colas@0
  1232
    $theStr =~ s/\$mo[n]?[t]?[h]?/sprintf("%.2u",$mon+1)/geoi;
colas@0
  1233
    $theStr =~ s/\$yearday/$yday+1/geoi;
colas@0
  1234
    $theStr =~ s/\$yea[r]?/sprintf("%.4u",$year+1900)/geoi;
colas@0
  1235
    $theStr =~ s/\$ye/sprintf("%.2u",$year%100)/geoi;
colas@0
  1236
    $theStr =~ s/\$wday/substr($wdayArr[$wday],0,3)/geoi;
colas@0
  1237
    $theStr =~ s/\$wd/$wday+1/geoi;
colas@0
  1238
    $theStr =~ s/\$weekday/$wdayArr[$wday]/goi;
colas@0
  1239
colas@0
  1240
    return $theStr;
colas@0
  1241
}
colas@0
  1242
colas@0
  1243
# =========================
colas@0
  1244
sub _properSpace
colas@0
  1245
{
colas@0
  1246
    my ( $theStr ) = @_;
colas@0
  1247
colas@0
  1248
    # FIXME: I18N
colas@0
  1249
colas@0
  1250
    unless( $dontSpaceRE ) {
colas@0
  1251
        $dontSpaceRE = &TWiki::Func::getPreferencesValue( "DONTSPACE" ) ||
colas@0
  1252
                       &TWiki::Func::getPreferencesValue( "SPREADSHEETPLUGIN_DONTSPACE" ) ||
colas@0
  1253
                       "UnlikelyGibberishWikiWord";
colas@0
  1254
        $dontSpaceRE =~ s/[^a-zA-Z0-9\,\s]//go;
colas@0
  1255
        $dontSpaceRE = "(" . join( "|", split( /[\,\s]+/, $dontSpaceRE ) ) . ")";
colas@0
  1256
        # Example: "(RedHat|McIntosh)"
colas@0
  1257
    }
colas@0
  1258
    $theStr =~ s/$dontSpaceRE/_spaceWikiWord( $1, "<DONT_SPACE>" )/geo;  # e.g. "Mc<DONT_SPACE>Intosh"
colas@0
  1259
    $theStr =~ s/(^|[\s\(]|\]\[)([a-zA-Z0-9]+)/$1 . _spaceWikiWord( $2, " " )/geo;
colas@0
  1260
    $theStr =~ s/<DONT_SPACE>//go;  # remove "<DONT_SPACE>" marker
colas@0
  1261
colas@0
  1262
    return $theStr;
colas@0
  1263
}
colas@0
  1264
colas@0
  1265
# =========================
colas@0
  1266
sub _spaceWikiWord
colas@0
  1267
{
colas@0
  1268
    my ( $theStr, $theSpacer ) = @_;
colas@0
  1269
colas@0
  1270
    $theStr =~ s/([a-z])([A-Z0-9])/$1$theSpacer$2/go;
colas@0
  1271
    $theStr =~ s/([0-9])([a-zA-Z])/$1$theSpacer$2/go;
colas@0
  1272
colas@0
  1273
    return $theStr;
colas@0
  1274
}
colas@0
  1275
colas@0
  1276
# =========================
colas@0
  1277
sub _workingDays
colas@0
  1278
{
colas@0
  1279
    my ( $start, $end ) = @_;
colas@0
  1280
colas@0
  1281
    # Contributed by CrawfordCurrie - 17 Jul 2004
colas@0
  1282
    # Calculate working days between two times. Times are standard system times (secs since 1970). 
colas@0
  1283
    # Working days are Monday through Friday (sorry, Israel!)
colas@0
  1284
colas@0
  1285
    use integer;
colas@0
  1286
    my $elapsed_days = ( $end - $start ) / ( 60 * 60 * 24 );
colas@0
  1287
    # total number of elapsed 7-day weeks
colas@0
  1288
    my $whole_weeks = $elapsed_days / 7;
colas@0
  1289
    my $extra_days = $elapsed_days - ( $whole_weeks * 7 );
colas@0
  1290
    if( $extra_days > 0 ) {
colas@0
  1291
      my @lt = gmtime( $start );
colas@0
  1292
      my $wday = $lt[6]; # weekday, 0 is sunday
colas@0
  1293
colas@0
  1294
      if( $wday == 0 ) {
colas@0
  1295
        $extra_days-- if( $extra_days > 0 );
colas@0
  1296
      } else {
colas@0
  1297
        $extra_days-- if( $extra_days > ( 6 - $wday ) );
colas@0
  1298
        $extra_days-- if( $extra_days > ( 6 - $wday ) );
colas@0
  1299
      }
colas@0
  1300
    }
colas@0
  1301
    return $whole_weeks * 5 + $extra_days;
colas@0
  1302
}
colas@0
  1303
colas@0
  1304
# =========================
colas@0
  1305
colas@0
  1306
1;
colas@0
  1307
colas@0
  1308
# EOF