← Back to branch summary

~kosova/+junk/tuxfamily-twiki

« back to all changes in this revision

Viewing changes to foswiki/lib/Foswiki/Plugins/SpreadSheetPlugin/Calc.pm

  • Committer: James Michael DuPont
  • Date: 2009-07-18 19:58:49 UTC
  • Revision ID: jamesmikedupont@gmail.com-20090718195849-vgbmaht2ys791uo2
added foswiki

Show diffs side-by-side

added added

removed removed

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