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