1#
2# WKCSheet.pl -- Spreadsheet basic stuff
3#
4# (c) Copyright 2007 Software Garden, Inc.
5# All Rights Reserved.
6# Subject to Software License included with WKC.pm
7#
8
9   package WKCSheet;
10
11   use strict;
12   use CGI qw(:standard);
13   use utf8;
14
15#   use WKC;
16   use WKCStrings;
17   use LWP::UserAgent;
18   use Time::Local;
19
20#
21# Export symbols
22#
23
24   require Exporter;
25   our @ISA = qw(Exporter);
26   our @EXPORT = qw(parse_sheet_save create_sheet_save render_sheet render_values_only execute_sheet_command
27                    parse_header_save create_header_save add_to_editlog
28                    recalc_sheet format_number_for_display determine_value_type
29                    cr_to_coord coord_to_cr special_chars special_chars_nl
30                    encode_for_save decode_from_save
31                    url_encode_plain
32                    copy_function_args
33                    function_args_error function_specific_error
34                    top_of_stack_value_and_type lookup_result_type
35                    operand_value_and_type operand_as_number operand_as_text decode_range_parts
36                    convert_date_gregorian_to_julian convert_date_julian_to_gregorian
37                    test_criteria load_special_strings
38                    %sheetfields $definitionsfile %formathints $julian_offset $seconds_in_a_day $seconds_in_an_hour);
39   our $VERSION = '1.0.0';
40
41#
42# Locals and Globals
43#
44
45   our %sheetfields = (lastcol => "c", lastrow => "r", defaultcolwidth => "w", defaultrowheight => "h",
46                   defaulttextformat => "tf", defaultnontextformat => "ntf", defaulttextvalueformat => "tvf", defaultnontextvalueformat => "ntvf",
47                   defaultlayout => "layout", defaultfont => "font", defaultcolor => "color", defaultbgcolor => "bgcolor",
48                   circularreferencecell => "circularreferencecell", recalc => "recalc", needsrecalc => "needsrecalc");
49
50   my @headerfieldnames = qw(version fullname templatetext templatefile lastmodified lastauthor basefiledt backupfiledt reverted
51                             editcomments publishhtml publishsource publishjs viewwithoutlogin);
52
53   #
54   # Date/time constants
55   #
56
57   our $julian_offset = 2415019;
58   our $seconds_in_a_day = 24 * 60 * 60;
59   our $seconds_in_an_hour = 60 * 60;
60
61   #
62   # Input values that have special values, e.g., "TRUE", "FALSE", etc.
63   # Form is: uppercasevalue => "value,type"
64   #
65
66   my %input_constants = (
67      'TRUE' => '1,nl', 'FALSE' => '0,nl', '#N/A' => '0,e#N/A', '#NULL!' => '0,e#NULL!', '#NUM!' => '0,e#NUM!',
68      '#DIV/0!' => '0,e#DIV/0!', '#VALUE!' => '0,e#VALUE!', '#REF!' => '0,e#REF!', '#NAME?' => '0,e#NAME?',
69      );
70
71   # Formula constants for parsing:
72
73   my $token_num = 1;
74   my $token_coord = 2;
75   my $token_op = 3;
76   my $token_name = 4;
77   my $token_error = 5;
78   my $token_string = 6;
79   my $token_space = 7;
80
81   my $char_class_num = 1;
82   my $char_class_numstart = 2;
83   my $char_class_op = 3;
84   my $char_class_eof = 4;
85   my $char_class_alpha = 5;
86   my $char_class_incoord = 6;
87   my $char_class_error = 7;
88   my $char_class_quote = 8;
89   my $char_class_space = 9;
90
91   my @char_class = (
92# 0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F
93# sp !  "  #  $  %  &  '  (  )  *  +  ,  -  .  /
94  9, 3, 8, 4, 6, 3, 3, 0, 3, 3, 3, 3, 3, 3, 2, 3,
95# 0  1  2  3  4  5  6  7  8  9  :  ;  <  =  >  ?
96  1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 0, 3, 3, 3, 0,
97# @  A  B  C  D  E  F  G  H  I  J  K  L  M  N  O
98  0, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
99# P  Q  R  S  T  U  V  W  X  Y  Z  [  \  ]  ^  _
100  5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 0, 0, 0, 3, 0,
101# `  a  b  c  d  e  f  g  h  i  j  k  l  m  n  o
102  0, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
103# p  q  r  s  t  u  v  w  x  y  z  {  |  }  ~  DEL
104  5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 0, 0, 0, 0, 0);
105
106   # Convert one char token text to input text
107
108   my %token_op_expansion = ('G' => '>=', 'L' => '<=', 'M' => '-', 'N' => '<>', 'P' => '+');
109
110# Operator Precedence:
111# 1 !
112# 2 : ,
113# 3 M P
114# 4 %
115# 5 ^
116# 6 * /
117# 7 + -
118# 8 &
119# 9 < > = G(>=) L(<=) N(<>)
120# Negative value means Right Associative
121
122   my @token_precedence = (
123# 0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F
124# sp !  "  #  $  %  &  '  (  )  *  +  ,  -  .  /
125  0, 1, 0, 0, 0, 4, 8, 0, 0, 0, 6, 7, 2, 7, 0, 6,
126# 0  1  2  3  4  5  6  7  8  9  :  ;  <  =  >  ?
127  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 9, 9, 9, 0,
128# @  A  B  C  D  E  F  G  H  I  J  K  L   M  N  O
129  0, 0, 0, 0, 0, 0, 0, 9, 0, 0, 0, 0, 9, -3, 9, 0,
130#  P  Q  R  S  T  U  V  W  X  Y  Z  [  \  ]  ^   _
131  -3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5, 0);
132
133   #
134   # Information about the resulting value types when doing operations on values
135   #
136   # Each hash entry is a hash with specific types with result type info as follows:
137   #
138   #    'type1a' => '|type2a:resulta|type2b:resultb|...
139   #    Type of t* or n* matches any of those types not listed
140   #    Results may be a type or the numbers 1 or 2 specifying to return type1 or type2
141   #
142
143   my %typelookup = (
144       unaryminus => { 'n*' => '|n*:1|', 'e*' => '|e*:1|', 't*' => '|t*:e#VALUE!|', 'b' => '|b:n|'},
145       unaryplus => { 'n*' => '|n*:1|', 'e*' => '|e*:1|', 't*' => '|t*:e#VALUE!|', 'b' => '|b:n|'},
146       unarypercent => { 'n*' => '|n:n%|n*:n|', 'e*' => '|e*:1|', 't*' => '|t*:e#VALUE!|', 'b' => '|b:n|'},
147       plus => {
148                'n%' => '|n%:n%|nd:n|nt:n|ndt:n|n$:n|n:n|n*:n|b:n|e*:2|t*:e#VALUE!|',
149                'nd' => '|n%:n|nd:nd|nt:ndt|ndt:ndt|n$:n|n:nd|n*:n|b:n|e*:2|t*:e#VALUE!|',
150                'nt' => '|n%:n|nd:ndt|nt:nt|ndt:ndt|n$:n|n:nt|n*:n|b:n|e*:2|t*:e#VALUE!|',
151                'ndt' => '|n%:n|nd:ndt|nt:ndt|ndt:ndt|n$:n|n:ndt|n*:n|b:n|e*:2|t*:e#VALUE!|',
152                'n$' => '|n%:n|nd:n|nt:n|ndt:n|n$:n$|n:n$|n*:n|b:n|e*:2|t*:e#VALUE!|',
153                'n' => '|n%:n|nd:nd|nt:nt|ndt:ndt|n$:n$|n:n|n*:n|b:n|e*:2|t*:e#VALUE!|',
154                'b' => '|n%:n%|nd:nd|nt:nt|ndt:ndt|n$:n$|n:n|n*:n|b:n|e*:2|t*:e#VALUE!|',
155                't*' => '|n*:e#VALUE!|t*:e#VALUE!|b:e#VALUE!|e*:2|',
156                'e*' => '|e*:1|n*:1|t*:1|b:1|',
157               },
158       concat => {
159                't' => '|t:t|th:th|tw:tw|t*:2|e*:2|',
160                'th' => '|t:th|th:th|tw:t|t*:t|e*:2|',
161                'tw' => '|t:tw|th:t|tw:tw|t*:t|e*:2|',
162                'e*' => '|e*:1|n*:1|t*:1|',
163               },
164       oneargnumeric => { 'n*' => '|n*:n|', 'e*' => '|e*:1|', 't*' => '|t*:e#VALUE!|', 'b' => '|b:n|'},
165       twoargnumeric => { 'n*' => '|n*:n|t*:e#VALUE!|e*:2|', 'e*' => '|e*:1|n*:1|t*:1|', 't*' => '|t*:e#VALUE!|n*:e#VALUE!|e*:2|'},
166       propagateerror => { 'n*' => '|n*:2|e*:2|', 'e*' => '|e*:2|', 't*' => '|t*:2|e*:2|', 'b' => '|b:2|e*:2|'},
167      );
168
169   my %old_formats_map = ('default' => "default", # obsolete: converts from early beta versions, used only one place
170                            'none' => 'General',
171                            '%1.0f' => "0",
172                            ',' => '[,]General',
173                            ',%1.0f' => '#,##0',
174                            ',%1.1f' => '#,##0.0',
175                            ',%1.2f' => '#,##0.00',
176                            ',%1.3f' => '#,##0.000',
177                            ',%1.4f' => '#,##0.0000',
178                            '$,%1.0f' => '$#,##0',
179                            '$,%1.1f' => '$#,##0.0',
180                            '$,%1.2f' => '$#,##0.00',
181                            '(,%1.0f' => '#,##0_);(#,##0)',
182                            '(,%1.1f' => '#,##0.0_);(#,##0.0)',
183                            '(,%1.2f' => '#,##0.00_);(#,##0.00)',
184                            '($,%1.0f' => '$#,##0_);($#,##0)',
185                            '($,%1.1f' => '$#,##0.0_);($#,##0.0)',
186                            '($,%1.2f' => '$#,##0.00_);($#,##0.00)',
187                            ',%1.0f%%' => '0%',
188                            ',%1.1f%%' => '0.0%',
189                            '(,%1.0f%%' => '0%_);(0%)',
190                            '(,%1.1f%%' => '0.0%_);(0.0%)',
191                            '%02.0f' => '00',
192                            '%03.0f' => '000',
193                            '%04.0f' => '0000',
194                            );
195
196   our $definitionsfile = "WKCdefinitions.txt";
197
1981;
199
200# # # # # # # # #
201#
202# $ok = parse_sheet_save(\@lines, \%sheetdata)
203#
204# Sheet input routine. Fills %sheetdata given lines of text @lines.
205#
206# Currently always returns nothing.
207#
208# Sheet save format:
209#
210# linetype:param1:param2:...
211#
212# Linetypes are:
213#
214#    version:versionname - version of this format. Currently 1.2.
215#
216#    cell:coord:type:value...:type:value... - Types are as follows:
217#
218#       v:value - straight numeric value
219#       t:value - straight text/wiki-text in cell, encoded to handle \, :, newlines
220#       vt:fulltype:value - value with value type/subtype
221#       vtf:fulltype:value:formulatext - formula resulting in value with value type/subtype, value and text encoded
222#       vtc:fulltype:value:valuetext - formatted text constant resulting in value with value type/subtype, value and text encoded
223#       vf:fvalue:formulatext - formula resulting in value, value and text encoded (obsolete: only pre format version 1.1)
224#          fvalue - first char is "N" for numeric value, "T" for text value, "H" for HTML value, rest is the value
225#       e:errortext - Error text. Non-blank means formula parsing/calculation results in error.
226#       b:topborder#:rightborder#:bottomborder#:leftborder# - border# in sheet border list or blank if none
227#       l:layout# - number in cell layout list
228#       f:font# - number in sheet fonts list
229#       c:color# - sheet color list index for text
230#       bg:color# - sheet color list index for background color
231#       cf:format# - sheet cell format number for explicit format (align:left, etc.)
232#       cvf:valueformat# - sheet cell value format number (obsolete: only pre format v1.2)
233#       tvf:valueformat# - sheet cell text value format number
234#       ntvf:valueformat# - sheet cell non-text value format number
235#       colspan:numcols - number of columns spanned in merged cell
236#       rowspan:numrows - number of rows spanned in merged cell
237#       cssc:classname - name of CSS class to be used for cell when published instead of one calculated here
238#       csss:styletext - explicit CSS style information, encoded to handle :, etc.
239#       mod:allow - if "y" allow modification of cell for live "view" recalc
240#
241#    col:
242#       w:widthval - number, "auto" (no width in <col> tag), number%, or blank (use default)
243#       hide: - yes/no, no is assumed if missing
244#    row:
245#       hide - yes/no, no is assumed if missing
246#
247#    sheet:
248#       c:lastcol - number
249#       r:lastrow - number
250#       w:defaultcolwidth - number, "auto", number%, or blank (default->80)
251#       h:defaultrowheight - not used
252#       tf:format# - cell format number for sheet default for text values
253#       ntf:format# - cell format number for sheet default for non-text values (i.e., numbers)
254#       layout:layout# - default cell layout number in cell layout list
255#       font:font# - default font number in sheet font list
256#       vf:valueformat# - default number value format number in sheet valueformat list (obsolete: only pre format version 1.2)
257#       ntvf:valueformat# - default non-text (number) value format number in sheet valueformat list
258#       tvf:valueformat# - default text value format number in sheet valueformat list
259#       color:color# - default number for text color in sheet color list
260#       bgcolor:color# - default number for background color in sheet color list
261#       circularreferencecell:coord - cell coord with a circular reference
262#       recalc:value - on/off (on is default). If "on", appropriate changes to the sheet cause a recalc
263#       needsrecalc:value - yes/no (no is default). If "yes", formula values are not up to date
264#
265#    font:fontnum:value - text of font definition (style weight size family) for font fontnum
266#                         "*" for "style weight", size, or family, means use default (first look to sheet, then builtin)
267#    color:colornum:rgbvalue - text of color definition (e.g., rgb(255,255,255)) for color colornum
268#    border:bordernum:value - text of border definition (thickness style color) for border bordernum
269#    layout:layoutnum:value - text of vertical alignment and padding style for cell layout layoutnum:
270#                             vertical-alignment:vavalue;padding topval rightval bottomval leftval;
271#    cellformat:cformatnum:value - text of cell alignment (left/center/right) for cellformat cformatnum
272#    valueformat:vformatnum:value - text of number format (see format_value_for_display) for valueformat vformatnum (changed in v1.2)
273#    clipboardrange:upperleftcoord:bottomrightcoord - origin of clipboard data. Not present if clipboard empty.
274#       There must be a clipboardrange before any clipboard lines
275#    clipboard:coord:type:value:... - clipboard data, in same format as cell data
276#
277# The resulting $sheetdata data structure is as follows:
278#
279#   $sheetdata{version} - version of save file read in
280#   $sheetdata{datatypes}->{$coord} - Origin of {datavalues} value:
281#                                        v - typed in numeric value of some sort, constant, no formula
282#                                        t - typed in text, constant, no formula
283#                                        f - result of formula calculation ({formulas} has formula to calculate)
284#                                        c - constant of some sort with typed in text in {formulas} and value in {datavalues}
285#   $sheetdata{formulas}->{$coord} - Text of formula if {datatypes} is "f", no leading "=", or text of constant if "c"
286#   $sheetdata{datavalues}->{$coord} - a text or numeric value ready to be formatted for display or used in calculation
287#   $sheetdata{valuetypes}->{$coord} - the value type of the datavalue as 1 or more characters
288#                                      First char is "n" for numeric or "t" for text
289#                                      Second chars, if present, are sub-type, like "l" for logical (0=false, 1=true)
290#   $sheetdata{cellerrors}->{$coord} - If non-blank, error text for error in formula calculation
291#   $sheetdata{cellattribs}->{$coord}->
292#      {coord} - coord of cell - existence means non-blank cell
293#      {bt}, {br}, {bb}, {bl} - border number or null if no border
294#      {layout} - cell layout number or blank for default
295#      {font} - font number or blank for default
296#      {color} - color number for text or blank for default
297#      {bgcolor} - color number for the cell background or blank for default
298#      {cellformat} - cell format number if not default - controls horizontal alignment
299#      {textvalueformat} - value format number if not default - controls how the cell's text values are formatted into text for display
300#      {nontextvalueformat} - value format number if not default - controls how the cell's non-text values are turned into text for display
301#      {colspan}, {rowspan} - column span and row span for merged cells or blank for 1
302#      {cssc}, {csss} - explicit CSS class and CSS style for cell
303#      {mod} - if "y" allow modification in live view
304#   $sheetdata{colattribs}->{$colcoord}->
305#      {width} - column width if not default
306#      {hide} - hide column if yes
307#   $sheetdata{rowattribs}->{$rowcoord}->
308#      {height} - ignored
309#      {hide} - hide row if yes
310#   $sheetdata{sheetattribs}->{$attrib}->
311#      {lastcol} - number of columns in sheet
312#      {lastrow} - number of rows in sheet (more may be displayed when editing)
313#      {defaultcolwidth} - number, "auto", number%, or blank (default->80)
314#      {defaultrowheight} - not used
315#      {defaulttextformat} - cell format number for sheet default for text values
316#      {defaultnontextformat} - cell format number for sheet default for non-text values (i.e., numbers)
317#      {defaultlayout} - default cell layout number in sheet cell layout list
318#      {defaultfont} - default font number in sheet font list
319#      {defaulttextvalueformat} - default text value format number in sheet valueformat list
320#      {defaultnontextvalueformat} - default number value format number in sheet valueformat list
321#      {defaultcolor} - default number for text color in sheet color list
322#      {defaultbgcolor} - default number for background color in sheet color list
323#      {circularreferencecell} - cell coord with a circular reference
324#      {recalc} - on/off (on is default). If "on", appropriate changes to the sheet cause a recalc
325#      {needsrecalc} - yes/no (no is default). If "yes", formula values are not up to date
326#   $sheetdata{fonts}->[$index] - font specifications addressable by array position
327#   $sheetdata{fonthash}->{$value} - hash with font specification as keys and {fonts}->[] index position as values
328#   $sheetdata{colors}->[$index] - color specifications addressable by array position
329#   $sheetdata{colorhash}->{$value} - hash with color specification as keys and {colors}->[] index position as values
330#   $sheetdata{borderstyles}->[$index] - border style specifications addressable by array position
331#   $sheetdata{borderstylehash}->{$value} - hash with border style specification as keys and {borderstyles}->[] index position as values
332#   $sheetdata{layoutstyles}->[$index] - cell layout specifications addressable by array position
333#   $sheetdata{layoutstylehash}->{$value} - hash with cell layout specification as keys and {layoutstyle}->[] index position as values
334#   $sheetdata{cellformats}->[$index] - cell format specifications addressable by array position
335#   $sheetdata{cellformathash}->{$value} - hash with cell format specification as keys and {cellformats}->[] index position as values
336#   $sheetdata{valueformats}->[$index] - value format specifications addressable by array position
337#   $sheetdata{valueformathash}->{$value} - hash with value format specification as keys and {valueformats}->[] index position as values
338#   $sheetdata{clipboard}-> - the sheet's clipboard
339#      {range} - coord:coord range of where the clipboard contents came from or null if empty
340#      {datavalues} - like $sheetdata{datavalues} but for clipboard copy of cells
341#      {datatypes} - like $sheetdata{datatypes} but for clipboard copy of cells
342#      {valuetypes} - like $sheetdata{valuetypes} but for clipboard copy of cells
343#      {formulas} - like $sheetdata{formulas} but for clipboard copy of cells
344#      {cellerrors} - like $sheetdata{cellerrors} but for clipboard copy of cells
345#      {cellattribs} - like $sheetdata{cellattribs} but for clipboard copy of cells
346#   $sheetdata{loaderror} - if non-blank, there was an error loading this sheet and this is the text of that error
347#
348# # # # # # # # #
349
350sub parse_sheet_save {
351
352   my ($rest, $linetype, $coord, $type, $value, $valuetype, $formula, $style, $fontnum, $layoutnum, $colornum, $check, $maxrow, $maxcol, $row, $col);
353
354   my ($lines, $sheetdata) = @_;
355
356   my $errortext;
357
358   # Initialize sheetdata structure
359
360   $sheetdata->{datavalues} = {};
361   $sheetdata->{datatypes} = {};
362   $sheetdata->{valuetypes} = {};
363   $sheetdata->{formulas} = {};
364   $sheetdata->{cellerrors} = {};
365   $sheetdata->{cellattribs} = {};
366   $sheetdata->{colattribs} = {};
367   $sheetdata->{rowattribs} = {};
368   $sheetdata->{sheetattribs} = {};
369   $sheetdata->{layoutstyles} = [];
370   $sheetdata->{layoutstylehash} = {};
371   $sheetdata->{fonts} = [];
372   $sheetdata->{fonthash} = {};
373   $sheetdata->{colors} = [];
374   $sheetdata->{colorhash} = {};
375   $sheetdata->{borderstyles} = [];
376   $sheetdata->{borderstylehash} = {};
377   $sheetdata->{cellformats} = [];
378   $sheetdata->{cellformathash} = {};
379   $sheetdata->{valueformats} = [];
380   $sheetdata->{valueformathash} = {};
381
382   # Get references to the parts
383
384   my $datavalues = $sheetdata->{datavalues};
385   my $datatypes = $sheetdata->{datatypes};
386   my $valuetypes = $sheetdata->{valuetypes};
387   my $dataformulas = $sheetdata->{formulas};
388   my $cellerrors = $sheetdata->{cellerrors};
389   my $cellattribs = $sheetdata->{cellattribs};
390   my $colattribs = $sheetdata->{colattribs};
391   my $rowattribs = $sheetdata->{rowattribs};
392   my $sheetattribs = $sheetdata->{sheetattribs};
393   my $layoutstyles = $sheetdata->{layoutstyles};
394   my $layoutstylehash = $sheetdata->{layoutstylehash};
395   my $fonts = $sheetdata->{fonts};
396   my $fonthash = $sheetdata->{fonthash};
397   my $colors = $sheetdata->{colors};
398   my $colorhash = $sheetdata->{colorhash};
399   my $borderstyles = $sheetdata->{borderstyles};
400   my $borderstylehash = $sheetdata->{borderstylehash};
401   my $cellformats = $sheetdata->{cellformats};
402   my $cellformathash = $sheetdata->{cellformathash};
403   my $valueformats = $sheetdata->{valueformats};
404   my $valueformathash = $sheetdata->{valueformathash};
405
406   my $clipdatavalues;
407   my $clipdatatypes;
408   my $clipvaluetypes;
409   my $clipdataformulas;
410   my $clipcellerrors;
411   my $clipcellattribs;
412
413   foreach my $line (@$lines) {
414      chomp $line;
415      $line =~ s/\r//g;
416# assumed already done in read. #      $line =~ s/^\x{EF}\x{BB}\x{BF}//; # remove UTF-8 Byte Order Mark if present
417      ($linetype, $rest) = split(/:/, $line, 2);
418      if ($linetype eq "cell") {
419         ($coord, $type, $rest) = split(/:/, $rest, 3);
420         $coord = uc($coord);
421         $cellattribs->{$coord} = {'coord' => $coord} if $type; # Must have this if cell has anything
422         ($col, $row) = coord_to_cr($coord);
423         $maxcol = $col if $col > $maxcol;
424         $maxrow = $row if $row > $maxrow;
425         while ($type) {
426            if ($type eq "v") {
427               ($value, $type, $rest) = split(/:/, $rest, 3);
428               $datavalues->{$coord} = decode_from_save($value);
429               $datatypes->{$coord} = "v";
430               $valuetypes->{$coord} = "n";
431               }
432            elsif ($type eq "t") {
433               ($value, $type, $rest) = split(/:/, $rest, 3);
434               $datavalues->{$coord} = decode_from_save($value);
435               $datatypes->{$coord} = "t";
436               $valuetypes->{$coord} = "tw"; # Typed in text is treated as wiki text by default
437               }
438            elsif ($type eq "vt") {
439               ($valuetype, $value, $type, $rest) = split(/:/, $rest, 4);
440               $datavalues->{$coord} = decode_from_save($value);
441               if (substr($valuetype,0,1) eq "n") {
442                  $datatypes->{$coord} = "v";
443                  }
444               else {
445                  $datatypes->{$coord} = "t";
446                  }
447               $valuetypes->{$coord} = $valuetype;
448               }
449            elsif ($type eq "vtf") {
450               ($valuetype, $value, $formula, $type, $rest) = split(/:/, $rest, 5);
451               $datavalues->{$coord} = decode_from_save($value);
452               $dataformulas->{$coord} = decode_from_save($formula);
453               $datatypes->{$coord} = "f";
454               $valuetypes->{$coord} = $valuetype;
455               }
456            elsif ($type eq "vtc") {
457               ($valuetype, $value, $formula, $type, $rest) = split(/:/, $rest, 5);
458               $datavalues->{$coord} = decode_from_save($value);
459               $dataformulas->{$coord} = decode_from_save($formula);
460               $datatypes->{$coord} = "c";
461               $valuetypes->{$coord} = $valuetype;
462               }
463            elsif ($type eq "vf") { # old format
464               ($value, $formula, $type, $rest) = split(/:/, $rest, 4);
465               $datavalues->{$coord} = decode_from_save($value);
466               $dataformulas->{$coord} = decode_from_save($formula);
467               $datatypes->{$coord} = "f";
468               if (substr($value,0,1) eq "N") {
469                  $valuetypes->{$coord} = "n";
470                  $datavalues->{$coord} = substr($datavalues->{$coord},1); # remove initial type code
471                  }
472               elsif (substr($value,0,1) eq "T") {
473                  $valuetypes->{$coord} = "t";
474                  $datavalues->{$coord} = substr($datavalues->{$coord},1); # remove initial type code
475                  }
476               elsif (substr($value,0,1) eq "H") {
477                  $valuetypes->{$coord} = "th";
478                  $datavalues->{$coord} = substr($datavalues->{$coord},1); # remove initial type code
479                  }
480               else {
481                  $valuetypes->{$coord} = $valuetypes->{$coord} =~ m/[^0-9+\-\.]/ ? "t" : "n";
482                  }
483               }
484            elsif ($type eq "e") {
485               ($value, $type, $rest) = split(/:/, $rest, 3);
486               $cellerrors->{$coord} = decode_from_save($value);
487               }
488            elsif ($type eq "b") {
489               my ($t, $r, $b, $l);
490               ($t, $r, $b, $l, $type, $rest) = split(/:/, $rest, 6);
491               $cellattribs->{$coord}->{bt} = $t;
492               $cellattribs->{$coord}->{br} = $r;
493               $cellattribs->{$coord}->{bb} = $b;
494               $cellattribs->{$coord}->{bl} = $l;
495               }
496            elsif ($type eq "l") {
497               ($value, $type, $rest) = split(/:/, $rest, 3);
498               $cellattribs->{$coord}->{layout} = $value;
499               }
500            elsif ($type eq "f") {
501               ($value, $type, $rest) = split(/:/, $rest, 3);
502               $cellattribs->{$coord}->{font} = $value;
503               }
504            elsif ($type eq "c") {
505               ($value, $type, $rest) = split(/:/, $rest, 3);
506               $cellattribs->{$coord}->{color} = $value;
507               }
508            elsif ($type eq "bg") {
509               ($value, $type, $rest) = split(/:/, $rest, 3);
510               $cellattribs->{$coord}->{bgcolor} = $value;
511               }
512            elsif ($type eq "cf") {
513               ($value, $type, $rest) = split(/:/, $rest, 3);
514               $cellattribs->{$coord}->{cellformat} = $value;
515               }
516            elsif ($type eq "cvf") { # obsolete - only pre 1.2 format
517               ($value, $type, $rest) = split(/:/, $rest, 3);
518               $cellattribs->{$coord}->{nontextvalueformat} = $value;
519               }
520            elsif ($type eq "ntvf") {
521               ($value, $type, $rest) = split(/:/, $rest, 3);
522               $cellattribs->{$coord}->{nontextvalueformat} = $value;
523               }
524            elsif ($type eq "tvf") {
525               ($value, $type, $rest) = split(/:/, $rest, 3);
526               $cellattribs->{$coord}->{textvalueformat} = $value;
527               }
528            elsif ($type eq "colspan") {
529               ($value, $type, $rest) = split(/:/, $rest, 3);
530               $cellattribs->{$coord}->{colspan} = $value;
531               }
532            elsif ($type eq "rowspan") {
533               ($value, $type, $rest) = split(/:/, $rest, 3);
534               $cellattribs->{$coord}->{rowspan} = $value;
535               }
536            elsif ($type eq "cssc") {
537               ($value, $type, $rest) = split(/:/, $rest, 3);
538               $cellattribs->{$coord}->{cssc} = $value;
539               }
540            elsif ($type eq "csss") {
541               ($value, $type, $rest) = split(/:/, $rest, 3);
542               $cellattribs->{$coord}->{csss} = decode_from_save($value);
543               }
544            elsif ($type eq "mod") {
545               ($value, $type, $rest) = split(/:/, $rest, 3);
546               $cellattribs->{$coord}->{mod} = $value;
547               }
548            else {
549               $errortext = "Unknown type '$type' in line:\n$_\n";
550               last;
551               }
552            }
553         }
554      elsif ($linetype eq "col") {
555         ($coord, $type, $rest) = split(/:/, $rest, 3);
556         $coord = uc($coord); # normalize to upper case
557         $colattribs->{$coord} = {'coord' => $coord};
558         while ($type) {
559            if ($type eq "w") {
560               ($value, $type, $rest) = split(/:/, $rest, 3);
561               $colattribs->{$coord}->{width} = $value;
562               }
563            if ($type eq "hide") {
564               ($value, $type, $rest) = split(/:/, $rest, 3);
565               $colattribs->{$coord}->{hide} = $value;
566               }
567            else {
568               $errortext = "Unknown type '$type' in line:\n$_\n";
569               last;
570               }
571            }
572         }
573      elsif ($linetype eq "row") {
574         ($coord, $type, $rest) = split(/:/, $rest, 3);
575         $rowattribs->{$coord} = {'coord' => $coord};
576         while ($type) {
577            if ($type eq "h") {
578               ($value, $type, $rest) = split(/:/, $rest, 3);
579               $rowattribs->{$coord}->{height} = $value;
580               }
581            if ($type eq "hide") {
582               ($value, $type, $rest) = split(/:/, $rest, 3);
583               $rowattribs->{$coord}->{hide} = $value;
584               }
585            else {
586               $errortext = "Unknown type '$type' in line:\n$_\n";
587               last;
588               }
589            }
590         }
591      elsif ($linetype eq "sheet") {
592         ($type, $rest) = split(/:/, $rest, 2);
593         while ($type) {
594            if ($type eq "c") { # number of columns
595               ($value, $type, $rest) = split(/:/, $rest, 3);
596               $sheetattribs->{lastcol} = $value;
597               }
598            elsif ($type eq "r") { # number of rows
599               ($value, $type, $rest) = split(/:/, $rest, 3);
600               $sheetattribs->{lastrow} = $value;
601               }
602            elsif ($type eq "w") { # default col width
603               ($value, $type, $rest) = split(/:/, $rest, 3);
604               $sheetattribs->{defaultcolwidth} = $value;
605               }
606            elsif ($type eq "h") { #default row height
607               ($value, $type, $rest) = split(/:/, $rest, 3);
608               $sheetattribs->{defaultrowheight} = $value;
609               }
610            elsif ($type eq "tf") { #default text format
611               ($value, $type, $rest) = split(/:/, $rest, 3);
612               $sheetattribs->{defaulttextformat} = $value;
613               }
614            elsif ($type eq "ntf") { #default not text format
615               ($value, $type, $rest) = split(/:/, $rest, 3);
616               $sheetattribs->{defaultnontextformat} = $value;
617               }
618            elsif ($type eq "layout") { #default layout number
619               ($value, $type, $rest) = split(/:/, $rest, 3);
620               $sheetattribs->{defaultlayout} = $value;
621               }
622            elsif ($type eq "font") { #default font number
623               ($value, $type, $rest) = split(/:/, $rest, 3);
624               $sheetattribs->{defaultfont} = $value;
625               }
626            elsif ($type eq "vf") { #default value format number (old)
627               ($value, $type, $rest) = split(/:/, $rest, 3);
628               $sheetattribs->{defaultnontextvalueformat} = $value;
629               $sheetattribs->{defaulttextvalueformat} = "";
630               }
631            elsif ($type eq "tvf") { #default text value format number
632               ($value, $type, $rest) = split(/:/, $rest, 3);
633               $sheetattribs->{defaulttextvalueformat} = $value;
634               }
635            elsif ($type eq "ntvf") { #default non-text (number) value format number
636               ($value, $type, $rest) = split(/:/, $rest, 3);
637               $sheetattribs->{defaultnontextvalueformat} = $value;
638               }
639            elsif ($type eq "color") { #default text color
640               ($value, $type, $rest) = split(/:/, $rest, 3);
641               $sheetattribs->{defaultcolor} = $value;
642               }
643            elsif ($type eq "bgcolor") { #default cell background color
644               ($value, $type, $rest) = split(/:/, $rest, 3);
645               $sheetattribs->{defaultbgcolor} = $value;
646               }
647            elsif ($type eq "circularreferencecell") { #cell with a circular reference
648               ($value, $type, $rest) = split(/:/, $rest, 3);
649               $sheetattribs->{circularreferencecell} = $value;
650               }
651            elsif ($type eq "recalc") { #recalc on or off
652               ($value, $type, $rest) = split(/:/, $rest, 3);
653               $sheetattribs->{recalc} = $value;
654               }
655            elsif ($type eq "needsrecalc") { #recalculation needed, computed values may not be correct
656               ($value, $type, $rest) = split(/:/, $rest, 3);
657               $sheetattribs->{needsrecalc} = $value;
658               }
659            else {
660               $errortext = "Unknown type '$type' in line:\n$_\n";
661               last;
662               }
663            }
664         }
665      elsif ($linetype eq "layout") {
666         ($layoutnum, $value) = split(/:/, $rest, 2);
667         $layoutstyles->[$layoutnum] = $value;
668         $layoutstylehash->{$value} = $layoutnum;
669         }
670      elsif ($linetype eq "font") {
671         ($fontnum, $value) = split(/:/, $rest, 2);
672         $fonts->[$fontnum] = $value;
673         $fonthash->{$value} = $fontnum;
674         }
675      elsif ($linetype eq "color") {
676         ($colornum, $value) = split(/:/, $rest, 2);
677         $colors->[$colornum] = $value;
678         $colorhash->{$value} = $colornum;
679         }
680      elsif ($linetype eq "border") {
681         ($style, $value) = split(/:/, $rest, 2);
682         $borderstyles->[$style] = $value;
683         $borderstylehash->{$value} = $style;
684         }
685      elsif ($linetype eq "cellformat") {
686         ($style, $value) = split(/:/, $rest, 2);
687         $cellformats->[$style] = decode_from_save($value);
688         $cellformathash->{$value} = $style;
689         }
690      elsif ($linetype eq "valueformat") {
691         ($style, $value) = split(/:/, $rest, 2);
692         $value = decode_from_save($value);
693         if ($sheetdata->{version} < 1.2) { # old format definitions - convert
694            $value = length($old_formats_map{$value})>=1 ? $old_formats_map{$value} : $value;
695            }
696         if ($value eq "General-separator") { # convert from 0.91
697            $value = "[,]General";
698            }
699         $valueformats->[$style] = $value;
700         $valueformathash->{$value} = $style;
701         }
702      elsif ($linetype eq "version") {
703         $sheetdata->{version} = $rest;
704         }
705      elsif ($linetype eq "") {
706         }
707      elsif ($linetype eq "clipboardrange") {
708         $sheetdata->{clipboard} = {}; # clear and create clipboard
709         $sheetdata->{clipboard}->{datavalues} = {};
710         $clipdatavalues = $sheetdata->{clipboard}->{datavalues};
711         $sheetdata->{clipboard}->{datatypes} = {};
712         $clipdatatypes = $sheetdata->{clipboard}->{datatypes};
713         $sheetdata->{clipboard}->{valuetypes} = {};
714         $clipvaluetypes = $sheetdata->{clipboard}->{valuetypes};
715         $sheetdata->{clipboard}->{formulas} = {};
716         $clipdataformulas = $sheetdata->{clipboard}->{formulas};
717         $sheetdata->{clipboard}->{cellerrors} = {};
718         $clipcellerrors = $sheetdata->{clipboard}->{cellerrors};
719         $sheetdata->{clipboard}->{cellattribs} = {};
720         $clipcellattribs = $sheetdata->{clipboard}->{cellattribs};
721
722         $coord = uc($rest);
723         $sheetdata->{clipboard}->{range} = $coord;
724         }
725      elsif ($linetype eq "clipboard") { # must have a clipboardrange command somewhere before it
726         ($coord, $type, $rest) = split(/:/, $rest, 3);
727         $coord = uc($coord);
728         if (!$sheetdata->{clipboard}->{range}) {
729            $errortext = "Missing clipboardrange before clipboard data in file\n";
730            $type = "norange";
731            }
732         $clipcellattribs->{$coord} = {'coord', $coord};
733         while ($type) {
734            if ($type eq "v") {
735               ($value, $type, $rest) = split(/:/, $rest, 3);
736               $clipdatavalues->{$coord} = decode_from_save($value);
737               $clipdatatypes->{$coord} = "v";
738               $clipvaluetypes->{$coord} = "n";
739               }
740            elsif ($type eq "t") {
741               ($value, $type, $rest) = split(/:/, $rest, 3);
742               $clipdatavalues->{$coord} = decode_from_save($value);
743               $clipdatatypes->{$coord} = "t";
744               $clipvaluetypes->{$coord} = "tw"; # Typed in text is treated as wiki text by default
745               }
746            elsif ($type eq "vt") {
747               ($valuetype, $value, $type, $rest) = split(/:/, $rest, 4);
748               $clipdatavalues->{$coord} = decode_from_save($value);
749               if (substr($valuetype,0,1) eq "n") {
750                  $clipdatatypes->{$coord} = "v";
751                  }
752               else {
753                  $clipdatatypes->{$coord} = "t";
754                  }
755               $clipvaluetypes->{$coord} = $valuetype;
756               }
757            elsif ($type eq "vtf") {
758               ($valuetype, $value, $formula, $type, $rest) = split(/:/, $rest, 5);
759               $clipdatavalues->{$coord} = decode_from_save($value);
760               $clipdataformulas->{$coord} = decode_from_save($formula);
761               $clipdatatypes->{$coord} = "f";
762               $clipvaluetypes->{$coord} = $valuetype;
763               }
764            elsif ($type eq "vtc") {
765               ($valuetype, $value, $formula, $type, $rest) = split(/:/, $rest, 5);
766               $clipdatavalues->{$coord} = decode_from_save($value);
767               $clipdataformulas->{$coord} = decode_from_save($formula);
768               $clipdatatypes->{$coord} = "c";
769               $clipvaluetypes->{$coord} = $valuetype;
770               }
771            elsif ($type eq "vf") { # old format
772               ($value, $formula, $type, $rest) = split(/:/, $rest, 4);
773               $clipdatavalues->{$coord} = decode_from_save($value);
774               $clipdataformulas->{$coord} = decode_from_save($formula);
775               $clipdatatypes->{$coord} = "f";
776               if (substr($value,0,1) eq "N") {
777                  $clipvaluetypes->{$coord} = "n";
778                  $clipdatavalues->{$coord} = substr($clipdatavalues->{$coord},1); # remove initial type code
779                  }
780               elsif (substr($value,0,1) eq "T") {
781                  $clipvaluetypes->{$coord} = "t";
782                  $clipdatavalues->{$coord} = substr($clipdatavalues->{$coord},1); # remove initial type code
783                  }
784               elsif (substr($value,0,1) eq "H") {
785                  $clipvaluetypes->{$coord} = "th";
786                  $clipdatavalues->{$coord} = substr($clipdatavalues->{$coord},1); # remove initial type code
787                  }
788               else {
789                  $clipvaluetypes->{$coord} = $clipvaluetypes->{$coord} =~ m/[^0-9+\-\.]/ ? "t" : "n";
790                  }
791               }
792            elsif ($type eq "e") {
793               ($value, $type, $rest) = split(/:/, $rest, 3);
794               $clipcellerrors->{$coord} = decode_from_save($value);
795               }
796            elsif ($type eq "b") {
797               my ($t, $r, $b, $l);
798               ($t, $r, $b, $l, $type, $rest) = split(/:/, $rest, 6);
799               $clipcellattribs->{$coord}->{bt} = $t;
800               $clipcellattribs->{$coord}->{br} = $r;
801               $clipcellattribs->{$coord}->{bb} = $b;
802               $clipcellattribs->{$coord}->{bl} = $l;
803               }
804            elsif ($type eq "l") {
805               ($value, $type, $rest) = split(/:/, $rest, 3);
806               $clipcellattribs->{$coord}->{layout} = $value;
807               }
808            elsif ($type eq "f") {
809               ($value, $type, $rest) = split(/:/, $rest, 3);
810               $clipcellattribs->{$coord}->{font} = $value;
811               }
812            elsif ($type eq "c") {
813               ($value, $type, $rest) = split(/:/, $rest, 3);
814               $clipcellattribs->{$coord}->{color} = $value;
815               }
816            elsif ($type eq "bg") {
817               ($value, $type, $rest) = split(/:/, $rest, 3);
818               $clipcellattribs->{$coord}->{bgcolor} = $value;
819               }
820            elsif ($type eq "cf") {
821               ($value, $type, $rest) = split(/:/, $rest, 3);
822               $clipcellattribs->{$coord}->{cellformat} = $value;
823               }
824            elsif ($type eq "cvf") { # old
825               ($value, $type, $rest) = split(/:/, $rest, 3);
826               $clipcellattribs->{$coord}->{nontextvalueformat} = $value;
827               }
828            elsif ($type eq "ntvf") {
829               ($value, $type, $rest) = split(/:/, $rest, 3);
830               $clipcellattribs->{$coord}->{nontextvalueformat} = $value;
831               }
832            elsif ($type eq "tvf") {
833               ($value, $type, $rest) = split(/:/, $rest, 3);
834               $clipcellattribs->{$coord}->{textvalueformat} = $value;
835               }
836            elsif ($type eq "colspan") {
837               ($value, $type, $rest) = split(/:/, $rest, 3);
838               $clipcellattribs->{$coord}->{colspan} = $value;
839               }
840            elsif ($type eq "rowspan") {
841               ($value, $type, $rest) = split(/:/, $rest, 3);
842               $clipcellattribs->{$coord}->{rowspan} = $value;
843               }
844            elsif ($type eq "cssc") {
845               ($value, $type, $rest) = split(/:/, $rest, 3);
846               $clipcellattribs->{$coord}->{cssc} = $value;
847               }
848            elsif ($type eq "csss") {
849               ($value, $type, $rest) = split(/:/, $rest, 3);
850               $clipcellattribs->{$coord}->{csss} = decode_from_save($value);
851               }
852            elsif ($type eq "mod") {
853               ($value, $type, $rest) = split(/:/, $rest, 3);
854               $clipcellattribs->{$coord}->{mod} = $value;
855               }
856            elsif ($type eq "norange") {
857               last;
858               }
859            else {
860               $errortext = "Unknown type '$type' in line:\n$_\n";
861               last;
862               }
863            }
864         }
865      else {
866#!!!!!!
867         $errortext = "Unknown linetype: $linetype\n" unless $linetype =~ m/^\s*#/;
868         }
869      }
870
871   $sheetattribs->{lastcol} ||= $maxcol || 1;
872   $sheetattribs->{lastrow} ||= $maxrow || 1;
873   }
874
875# # # # # # # # #
876#
877# $outstr = create_sheet_save(\%sheetdata)
878#
879# Sheet output routine. Returns a string ready to be saved in a file.
880#
881# # # # # # # # #
882
883sub create_sheet_save {
884
885   my ($rest, $linetype, $coord, $type, $value, $formula, $style, $colornum, $check, $maxrow, $maxcol, $row, $col);
886
887   my $sheetdata = shift @_;
888   my $outstr;
889
890   # Get references to the parts
891
892   my $datavalues = $sheetdata->{datavalues};
893   my $datatypes = $sheetdata->{datatypes};
894   my $valuetypes = $sheetdata->{valuetypes};
895   my $dataformulas = $sheetdata->{formulas};
896   my $cellerrors = $sheetdata->{cellerrors};
897   my $cellattribs = $sheetdata->{cellattribs};
898   my $colattribs = $sheetdata->{colattribs};
899   my $rowattribs = $sheetdata->{rowattribs};
900   my $sheetattribs = $sheetdata->{sheetattribs};
901   my $layoutstyles = $sheetdata->{layoutstyles};
902   my $layoutstylehash = $sheetdata->{layoutstylehash};
903   my $fonts = $sheetdata->{fonts};
904   my $fonthash = $sheetdata->{fonthash};
905   my $colors = $sheetdata->{colors};
906   my $colorhash = $sheetdata->{colorhash};
907   my $borderstyles = $sheetdata->{borderstyles};
908   my $borderstylehash = $sheetdata->{borderstylehash};
909   my $cellformats = $sheetdata->{cellformats};
910   my $cellformathash = $sheetdata->{cellformathash};
911   my $valueformats = $sheetdata->{valueformats};
912   my $valueformathash = $sheetdata->{valueformathash};
913
914   $outstr .= "version:1.2\n"; # sheet save version
915
916   for (my $row = 1; $row <= $sheetattribs->{lastrow}; $row++) {
917      for (my $col = 1; $col <= $sheetattribs->{lastcol}; $col++) {
918         $coord = cr_to_coord($col, $row);
919         next unless $cellattribs->{$coord}->{coord}; # skip if nothing set for this one
920         $outstr .= "cell:$coord";
921         if ($datatypes->{$coord} eq "v") {
922            $value = encode_for_save($datavalues->{$coord});
923            if (!$valuetypes->{$coord} || $valuetypes->{$coord} eq "n") { # use simpler version
924               $outstr .= ":v:$value";
925               }
926            else { # if we do fancy parsing to determine a type
927               $outstr .= ":vt:$valuetypes->{$coord}:$value";
928               }
929            }
930         elsif ($datatypes->{$coord} eq "t") {
931            $value = encode_for_save($datavalues->{$coord});
932            if (!$valuetypes->{$coord} || $valuetypes->{$coord} eq "tw") { # use simpler version
933               $outstr .= ":t:$value";
934               }
935            else { # if we do fancy parsing to determine a type
936               $outstr .= ":vt:$valuetypes->{$coord}:$value";
937               }
938            }
939         elsif ($datatypes->{$coord} eq "f") {
940            $value = encode_for_save($datavalues->{$coord});
941            $formula = encode_for_save($dataformulas->{$coord});
942            $outstr .= ":vtf:$valuetypes->{$coord}:$value:$formula";
943            }
944         elsif ($datatypes->{$coord} eq "c") {
945            $value = encode_for_save($datavalues->{$coord});
946            $formula = encode_for_save($dataformulas->{$coord});
947            $outstr .= ":vtc:$valuetypes->{$coord}:$value:$formula";
948            }
949
950         if ($cellerrors->{$coord}) {
951            $value = encode_for_save($cellerrors->{$coord});
952            $outstr .= ":e:$value";
953            }
954
955         my ($t, $r, $b, $l);
956         $t = $cellattribs->{$coord}->{bt};
957         $r = $cellattribs->{$coord}->{br};
958         $b = $cellattribs->{$coord}->{bb};
959         $l = $cellattribs->{$coord}->{bl};
960         $outstr .= ":b:$t:$r:$b:$l" if ($t || $r || $b || $l);
961
962         $outstr .= ":l:$cellattribs->{$coord}->{layout}" if $cellattribs->{$coord}->{layout};
963         $outstr .= ":f:$cellattribs->{$coord}->{font}" if $cellattribs->{$coord}->{font};
964         $outstr .= ":c:$cellattribs->{$coord}->{color}" if $cellattribs->{$coord}->{color};
965         $outstr .= ":bg:$cellattribs->{$coord}->{bgcolor}" if $cellattribs->{$coord}->{bgcolor};
966         $outstr .= ":cf:$cellattribs->{$coord}->{cellformat}" if $cellattribs->{$coord}->{cellformat};
967         $outstr .= ":tvf:$cellattribs->{$coord}->{textvalueformat}" if $cellattribs->{$coord}->{textvalueformat};
968         $outstr .= ":ntvf:$cellattribs->{$coord}->{nontextvalueformat}" if $cellattribs->{$coord}->{nontextvalueformat};
969         $outstr .= ":colspan:$cellattribs->{$coord}->{colspan}" if $cellattribs->{$coord}->{colspan};
970         $outstr .= ":rowspan:$cellattribs->{$coord}->{rowspan}" if $cellattribs->{$coord}->{rowspan};
971         $outstr .= ":cssc:$cellattribs->{$coord}->{cssc}" if $cellattribs->{$coord}->{cssc};
972         $outstr .= ":csss:" . encode_for_save($cellattribs->{$coord}->{csss}) if $cellattribs->{$coord}->{csss};
973         $outstr .= ":mod:$cellattribs->{$coord}->{mod}" if $cellattribs->{$coord}->{mod};
974
975         $outstr .= "\n";
976         }
977      }
978
979   for (my $col = 1; $col <= $sheetattribs->{lastcol}; $col++) {
980      $coord = cr_to_coord($col, 1);
981      $coord =~ s/\d+//;
982      $outstr .= "col:$coord:w:$colattribs->{$coord}->{width}\n" if $colattribs->{$coord}->{width};
983      $outstr .= "col:$coord:hide:$colattribs->{$coord}->{hide}\n" if $colattribs->{$coord}->{hide};
984      }
985
986   for (my $row = 1; $row <= $sheetattribs->{lastrow}; $row++) {
987      $outstr .= "row:$row:w:$rowattribs->{$row}->{height}\n" if $rowattribs->{$row}->{height};
988      $outstr .= "row:$row:hide:$rowattribs->{$row}->{hide}\n" if $rowattribs->{$row}->{hide};
989      }
990
991   $outstr .= "sheet";
992   foreach my $field (keys %sheetfields) {
993      my $value = encode_for_save($sheetattribs->{$field});
994      $outstr .= ":$sheetfields{$field}:$value" if $value;
995      }
996   $outstr .= "\n";
997
998   for (my $i=1; $i<@$layoutstyles; $i++) {
999      $outstr .= "layout:$i:$layoutstyles->[$i]\n";
1000      }
1001
1002   for (my $i=1; $i<@$fonts; $i++) {
1003      $outstr .= "font:$i:$fonts->[$i]\n";
1004      }
1005
1006   for (my $i=1; $i<@$colors; $i++) {
1007      $outstr .= "color:$i:$colors->[$i]\n";
1008      }
1009
1010   for (my $i=1; $i<@$borderstyles; $i++) {
1011      $outstr .= "border:$i:$borderstyles->[$i]\n";
1012      }
1013
1014   for (my $i=1; $i<@$cellformats; $i++) {
1015      $style = encode_for_save($cellformats->[$i]);
1016      $outstr .= "cellformat:$i:$style\n";
1017      }
1018
1019   for (my $i=1; $i<@$valueformats; $i++) {
1020      $style = encode_for_save($valueformats->[$i]);
1021      $outstr .= "valueformat:$i:$style\n";
1022      }
1023
1024   if ($sheetdata->{clipboard}) {
1025      my $clipdatavalues = $sheetdata->{clipboard}->{datavalues};
1026      my $clipdatatypes = $sheetdata->{clipboard}->{datatypes};
1027      my $clipvaluetypes = $sheetdata->{clipboard}->{valuetypes};
1028      my $clipdataformulas = $sheetdata->{clipboard}->{formulas};
1029      my $clipcellerrors = $sheetdata->{clipboard}->{cellerrors};
1030      my $clipcellattribs = $sheetdata->{clipboard}->{cellattribs};
1031
1032      $outstr .= "clipboardrange:$sheetdata->{clipboard}->{range}\n";
1033
1034      foreach my $coord (sort keys %$clipcellattribs) {
1035         $outstr .= "clipboard:$coord";
1036         if ($clipdatatypes->{$coord} eq "v") {
1037            $value = encode_for_save($clipdatavalues->{$coord});
1038            if (!$clipvaluetypes->{$coord} || $clipvaluetypes->{$coord} eq "n") { # use simpler version
1039               $outstr .= ":v:$value";
1040               }
1041            else { # if we do fancy parsing to determine a type
1042               $outstr .= ":vt:$clipvaluetypes->{$coord}:$value";
1043               }
1044            }
1045         elsif ($clipdatatypes->{$coord} eq "t") {
1046            $value = encode_for_save($clipdatavalues->{$coord});
1047            if (!$clipvaluetypes->{$coord} || $clipvaluetypes->{$coord} eq "tw") { # use simpler version
1048               $outstr .= ":t:$value";
1049               }
1050            else { # if we do fancy parsing to determine a type
1051               $outstr .= ":vt:$clipvaluetypes->{$coord}:$value";
1052               }
1053            }
1054         elsif ($clipdatatypes->{$coord} eq "f") {
1055            $value = encode_for_save($clipdatavalues->{$coord});
1056            $formula = encode_for_save($clipdataformulas->{$coord});
1057            $outstr .= ":vtf:$clipvaluetypes->{$coord}:$value:$formula";
1058            }
1059         elsif ($clipdatatypes->{$coord} eq "c") {
1060            $value = encode_for_save($clipdatavalues->{$coord});
1061            $formula = encode_for_save($clipdataformulas->{$coord});
1062            $outstr .= ":vtc:$clipvaluetypes->{$coord}:$value:$formula";
1063            }
1064
1065         if ($clipcellerrors->{$coord}) {
1066            $value = encode_for_save($clipcellerrors->{$coord});
1067            $outstr .= ":e:$value";
1068            }
1069
1070         my ($t, $r, $b, $l);
1071         $t = $clipcellattribs->{$coord}->{bt};
1072         $r = $clipcellattribs->{$coord}->{br};
1073         $b = $clipcellattribs->{$coord}->{bb};
1074         $l = $clipcellattribs->{$coord}->{bl};
1075         $outstr .= ":b:$t:$r:$b:$l" if ($t || $r || $b || $l);
1076
1077         $outstr .= ":l:$clipcellattribs->{$coord}->{layout}" if $clipcellattribs->{$coord}->{layout};
1078         $outstr .= ":f:$clipcellattribs->{$coord}->{font}" if $clipcellattribs->{$coord}->{font};
1079         $outstr .= ":c:$clipcellattribs->{$coord}->{color}" if $clipcellattribs->{$coord}->{color};
1080         $outstr .= ":bg:$clipcellattribs->{$coord}->{bgcolor}" if $clipcellattribs->{$coord}->{bgcolor};
1081         $outstr .= ":cf:$clipcellattribs->{$coord}->{cellformat}" if $clipcellattribs->{$coord}->{cellformat};
1082         $outstr .= ":tvf:$clipcellattribs->{$coord}->{textvalueformat}" if $clipcellattribs->{$coord}->{textvalueformat};
1083         $outstr .= ":ntvf:$clipcellattribs->{$coord}->{nontextvalueformat}" if $clipcellattribs->{$coord}->{nontextvalueformat};
1084         $outstr .= ":colspan:$clipcellattribs->{$coord}->{colspan}" if $clipcellattribs->{$coord}->{colspan};
1085         $outstr .= ":rowspan:$clipcellattribs->{$coord}->{rowspan}" if $clipcellattribs->{$coord}->{rowspan};
1086         $outstr .= ":cssc:$clipcellattribs->{$coord}->{cssc}" if $clipcellattribs->{$coord}->{cssc};
1087         $outstr .= ":csss:" . encode_for_save($clipcellattribs->{$coord}->{csss}) if $clipcellattribs->{$coord}->{csss};
1088         $outstr .= ":mod:$clipcellattribs->{$coord}->{mod}" if $clipcellattribs->{$coord}->{mod};
1089
1090         $outstr .= "\n";
1091         }
1092
1093      }
1094
1095   return $outstr;
1096   }
1097
1098
1099# # # # # # # # #
1100#
1101# $ok = execute_sheet_command($sheetdata, $command)
1102#
1103# Executes commands that modify the sheet data. Sets sheet "needsrecalc" as needed.
1104#
1105# The commands are in the forms:
1106#
1107#    set sheet attributename value (plus lastcol and lastrow)
1108#    set 22 attributename value
1109#    set B attributename value
1110#    set A1 attributename value1 value2... (see each attribute below for details)
1111#    set A1:B5 attributename value1 value2...
1112#    erase/copy/cut/paste/fillright/filldown A1:B5 all/formulas/format
1113#    clearclipboard
1114#    merge C3:F3
1115#    unmerge C3
1116#    insertcol/insertrow C5
1117#    deletecol/deleterow C5:E7
1118#
1119# # # # # # # # #
1120
1121sub execute_sheet_command {
1122
1123   my ($sheetdata, $command) = @_;
1124
1125   # Get references to the parts
1126
1127   my $datavalues = $sheetdata->{datavalues};
1128   my $datatypes = $sheetdata->{datatypes};
1129   my $valuetypes = $sheetdata->{valuetypes};
1130   my $dataformulas = $sheetdata->{formulas};
1131   my $cellerrors = $sheetdata->{cellerrors};
1132   my $cellattribs = $sheetdata->{cellattribs};
1133   my $colattribs = $sheetdata->{colattribs};
1134   my $rowattribs = $sheetdata->{rowattribs};
1135   my $sheetattribs = $sheetdata->{sheetattribs};
1136   my $layoutstyles = $sheetdata->{layoutstyles};
1137   my $layoutstylehash = $sheetdata->{layoutstylehash};
1138   my $fonts = $sheetdata->{fonts};
1139   my $fonthash = $sheetdata->{fonthash};
1140   my $colors = $sheetdata->{colors};
1141   my $colorhash = $sheetdata->{colorhash};
1142   my $borderstyles = $sheetdata->{borderstyles};
1143   my $borderstylehash = $sheetdata->{borderstylehash};
1144   my $cellformats = $sheetdata->{cellformats};
1145   my $cellformathash = $sheetdata->{cellformathash};
1146   my $valueformats = $sheetdata->{valueformats};
1147   my $valueformathash = $sheetdata->{valueformathash};
1148
1149   my ($cmd1, $rest, $what, $coord1, $coord2, $attrib, $value, $v1, $v2, $v3, $errortext);
1150
1151   ($cmd1, $rest) = split(/ /, $command, 2);
1152
1153   if ($cmd1 eq "set") {
1154      ($what, $attrib, $rest) = split(/ /, $rest, 3);
1155      if ($what eq "sheet") { # sheet attributes
1156         if ($attrib eq "defaultcolwidth") {
1157            $sheetattribs->{defaultcolwidth} = $rest;
1158            }
1159         elsif ($attrib eq "defaultcolor" || $attrib eq "defaultbgcolor") {
1160            my $colordef = 0;
1161            $colordef = $colorhash->{$rest} if $rest;
1162            if (!$colordef) {
1163               if ($rest) {
1164                  push @$colors, "" unless scalar @$colors;
1165                  $colordef = (push @$colors, $rest) - 1;
1166                  $colorhash->{$rest} = $colordef;
1167                  }
1168                }
1169            $sheetattribs->{$attrib} = $colordef;
1170            }
1171         elsif ($attrib eq "defaultlayout") {
1172            my $layoutdef = 0;
1173            $layoutdef = $layoutstylehash->{$rest} if $rest;
1174            if (!$layoutdef) {
1175               if ($rest) {
1176                  push @$layoutstyles, "" unless scalar @$layoutstyles;
1177                  $layoutdef = (push @$layoutstyles, $rest) - 1;
1178                  $layoutstylehash->{$rest} = $layoutdef;
1179                  }
1180                }
1181            $sheetattribs->{$attrib} = $layoutdef;
1182            }
1183         elsif ($attrib eq "defaultfont") {
1184            my $fontdef = 0;
1185            $rest = "" if $rest eq "* * *";
1186            $fontdef = $fonthash->{$rest} if $rest;
1187            if (!$fontdef) {
1188               if ($rest) {
1189                  push @$fonts, "" unless scalar @$fonts;
1190                  $fontdef = (push @$fonts, $rest) - 1;
1191                  $fonthash->{$rest} = $fontdef;
1192                  }
1193                }
1194            $sheetattribs->{$attrib} = $fontdef;
1195            }
1196         elsif ($attrib eq "defaulttextformat"  || $attrib eq "defaultnontextformat") {
1197            my $formatdef = 0;
1198            $formatdef = $cellformathash->{$rest} if $rest;
1199            if (!$formatdef) {
1200               if ($rest) {
1201                  push @$cellformats, "" unless scalar @$cellformats;
1202                  $formatdef = (push @$cellformats, $rest) - 1;
1203                  $cellformathash->{$rest} = $formatdef;
1204                  }
1205                }
1206            $sheetattribs->{$attrib} = $formatdef;
1207            }
1208         elsif ($attrib eq "defaulttextvalueformat" || $attrib eq "defaultnontextvalueformat") {
1209            my $formatdef = 0;
1210            $formatdef = $valueformathash->{$rest} if length($rest);
1211            if (!$formatdef) {
1212               if (length($rest)) {
1213                  push @$valueformats, "" unless scalar @$valueformats;
1214                  $formatdef = (push @$valueformats, $rest) - 1;
1215                  $valueformathash->{$rest} = $formatdef;
1216                  }
1217                }
1218            $sheetattribs->{$attrib} = $formatdef;
1219            }
1220         elsif ($attrib eq "lastcol") {
1221            $sheetattribs->{lastcol} = $rest+0;
1222            $sheetattribs->{lastcol} = 1 if ($sheetattribs->{lastcol} <= 0);
1223            }
1224         elsif ($attrib eq "lastrow") {
1225            $sheetattribs->{lastrow} = $rest+0;
1226            $sheetattribs->{lastrow} = 1 if ($sheetattribs->{lastrow} <= 0);
1227            }
1228         }
1229      elsif ($what =~ m/^(\d+)(\:(\d+)){0,1}$/) { # row attributes
1230         my ($row1, $row2);
1231         if ($what =~ m/^(.+?):(.+?)$/) {
1232            $row1 = $1;
1233            $row2 = $2;
1234            }
1235         else {
1236            $row1 = $what;
1237            $row2 = $row1;
1238            }
1239         if ($attrib eq "hide") {
1240            for (my $r = $row1; $r <= $row2; $r++) {
1241               $rowattribs->{$r} = {'coord' => $r} unless $rowattribs->{$r};
1242               $rowattribs->{$r}->{hide} = $rest;
1243               }
1244            }
1245         else {
1246            $errortext = "Unknown attributename '$attrib' in line:\n$command\n";
1247            return 0;
1248            }
1249         }
1250      elsif ($what =~ m/(^[a-zA-Z])([a-zA-Z])?(:[a-zA-Z][a-zA-Z]?){0,1}$/) { # column attributes
1251         my ($col1, $col2);
1252         if ($what =~ m/(.+?):(.+?)/) {
1253            $col1 = col_to_number($1);
1254            $col2 = col_to_number($2);
1255            }
1256         else {
1257            $col1 = col_to_number($what);
1258            $col2 = $col1;
1259            }
1260         if ($attrib eq "width") {
1261            for (my $c = $col1; $c <= $col2; $c++) {
1262               my $colname = number_to_col($c);
1263               $colattribs->{$colname} = {'coord' => $colname} unless $colattribs->{$colname};
1264               $colattribs->{$colname}->{width} = $rest;
1265               }
1266            }
1267         if ($attrib eq "hide") {
1268            for (my $c = $col1; $c <= $col2; $c++) {
1269               my $colname = number_to_col($c);
1270               $colattribs->{$colname} = {'coord' => $colname} unless $colattribs->{$colname};
1271               $colattribs->{$colname}->{hide} = $rest;
1272               }
1273            }
1274         else {
1275            $errortext = "Unknown attributename '$attrib' in line:\n$command\n";
1276            return 0;
1277            }
1278         }
1279      elsif ($what =~ m/([a-z]|[A-Z])([a-z]|[A-Z])?(\d+)/) { # cell attributes
1280         $what = uc($what);
1281         ($coord1, $coord2) = split(/:/, $what);
1282         my ($c1, $r1) = coord_to_cr($coord1);
1283         my $c2 = $c1;
1284         my $r2 = $r1;
1285         ($c2, $r2) = coord_to_cr($coord2) if $coord2;
1286         $sheetattribs->{lastcol} = $c2 if $c2 > $sheetattribs->{lastcol};
1287         $sheetattribs->{lastrow} = $r2 if $r2 > $sheetattribs->{lastrow};
1288         for (my $r = $r1; $r <= $r2; $r++) {
1289            for (my $c = $c1; $c <= $c2; $c++) {
1290               my $cr = cr_to_coord($c, $r);
1291               if ($attrib eq "value") { # set coord value type numeric-value
1292                  $cellattribs->{$cr} = {'coord' => $cr} unless $cellattribs->{$cr}->{coord};
1293                  ($v1, $v2) = split(/ /, $rest, 2);
1294                  $datavalues->{$cr} = $v2;
1295                  delete $cellerrors->{$cr};
1296                  $datatypes->{$cr} = "v";
1297                  $valuetypes->{$cr} = $v1;
1298                  $sheetdata->{sheetattribs}->{needsrecalc} = "yes";
1299                  }
1300               elsif ($attrib eq "text") { # set coord text type text-value
1301                  $cellattribs->{$cr} = {'coord' => $cr} unless $cellattribs->{$cr}->{coord};
1302                  ($v1, $v2) = split(/ /, $rest, 2);
1303                  $datavalues->{$cr} = $v2;
1304                  delete $cellerrors->{$cr};
1305                  $datatypes->{$cr} = "t";
1306                  $valuetypes->{$cr} = $v1;
1307                  $sheetdata->{sheetattribs}->{needsrecalc} = "yes";
1308                  }
1309               elsif ($attrib eq "formula") { # set coord formula formula-body-less-initial-=
1310                  $cellattribs->{$cr} = {'coord' => $cr} unless $cellattribs->{$cr}->{coord};
1311                  $datavalues->{$cr} = 0;
1312                  delete $cellerrors->{$cr};
1313                  $datatypes->{$cr} = "f";
1314                  $valuetypes->{$cr} = "n"; # until recalc'ed
1315                  $dataformulas->{$cr} = $rest;
1316                  $sheetdata->{sheetattribs}->{needsrecalc} = "yes";
1317                  }
1318               elsif ($attrib eq "constant") { # set coord constant type numeric-value source-text
1319                  $cellattribs->{$cr} = {'coord' => $cr} unless $cellattribs->{$cr}->{coord};
1320                  ($v1, $v2, $v3) = split(/ /, $rest, 3);
1321                  $datavalues->{$cr} = $v2;
1322                  if (substr($v1,0,1) eq "e") { # error
1323                     $cellerrors->{$cr} = substr($v1,1);
1324                     }
1325                  else {
1326                     delete $cellerrors->{$cr};
1327                     }
1328                  $datatypes->{$cr} = "c";
1329                  $valuetypes->{$cr} = $v1;
1330                  $dataformulas->{$cr} = $v3;
1331                  $sheetdata->{sheetattribs}->{needsrecalc} = "yes";
1332                  }
1333               elsif ($attrib eq "empty") { # erase value
1334                  delete $datavalues->{$cr};
1335                  delete $cellerrors->{$cr};
1336                  delete $datatypes->{$cr};
1337                  delete $valuetypes->{$cr};
1338                  $sheetdata->{sheetattribs}->{needsrecalc} = "yes";
1339                  }
1340               elsif ($attrib =~ m/^b[trbl]$/) {
1341                  $cellattribs->{$cr} = {'coord' => $cr} unless $cellattribs->{$cr}->{coord};
1342                  my $borderdef = 0;
1343                  $borderdef = $borderstylehash->{$rest} if $rest;
1344                  if (!$borderdef) {
1345                     if ($rest) {
1346                        push @$borderstyles, "" unless scalar @$borderstyles;
1347                        $borderdef = (push @$borderstyles, $rest) - 1;
1348                        $borderstylehash->{$rest} = $borderdef;
1349                        }
1350                     }
1351                  $cellattribs->{$cr}->{$attrib} = $borderdef;
1352                  }
1353               elsif ($attrib eq "color" || $attrib eq "bgcolor") {
1354                  $cellattribs->{$cr} = {'coord' => $cr} unless $cellattribs->{$cr}->{coord};
1355                  my $colordef = 0;
1356                  $colordef = $colorhash->{$rest} if $rest;
1357                  if (!$colordef) {
1358                     if ($rest) {
1359                        push @$colors, "" unless scalar @$colors;
1360                        $colordef = (push @$colors, $rest) - 1;
1361                        $colorhash->{$rest} = $colordef;
1362                        }
1363                     }
1364                  $cellattribs->{$cr}->{$attrib} = $colordef;
1365                  }
1366               elsif ($attrib eq "layout") {
1367                  $cellattribs->{$cr} = {'coord' => $cr} unless $cellattribs->{$cr}->{coord};
1368                  my $layoutdef = 0;
1369                  $layoutdef = $layoutstylehash->{$rest} if $rest;
1370                  if (!$layoutdef) {
1371                     if ($rest) {
1372                        push @$layoutstyles, "" unless scalar @$layoutstyles;
1373                        $layoutdef = (push @$layoutstyles, $rest) - 1;
1374                        $layoutstylehash->{$rest} = $layoutdef;
1375                        }
1376                     }
1377                  $cellattribs->{$cr}->{$attrib} = $layoutdef;
1378                  }
1379               elsif ($attrib eq "font") {
1380                  $cellattribs->{$cr} = {'coord' => $cr} unless $cellattribs->{$cr}->{coord};
1381                  my $fontdef = 0;
1382                  $rest = "" if $rest eq "* * *";
1383                  $fontdef = $fonthash->{$rest} if $rest;
1384                  if (!$fontdef) {
1385                     if ($rest) {
1386                        push @$fonts, "" unless scalar @$fonts;
1387                        $fontdef = (push @$fonts, $rest) - 1;
1388                        $fonthash->{$rest} = $fontdef;
1389                        }
1390                     }
1391                  $cellattribs->{$cr}->{$attrib} = $fontdef;
1392                  }
1393               elsif ($attrib eq "cellformat") {
1394                  $cellattribs->{$cr} = {'coord' => $cr} unless $cellattribs->{$cr}->{coord};
1395                  my $formatdef = 0;
1396                  $formatdef = $cellformathash->{$rest} if $rest;
1397                   if (!$formatdef) {
1398                      if ($rest) {
1399                         push @$cellformats, "" unless scalar @$cellformats;
1400                         $formatdef = (push @$cellformats, $rest) - 1;
1401                         $cellformathash->{$rest} = $formatdef;
1402                         }
1403                      }
1404                  $cellattribs->{$cr}->{$attrib} = $formatdef;
1405                  }
1406               elsif ($attrib eq "textvalueformat" || $attrib eq "nontextvalueformat") {
1407                  $cellattribs->{$cr} = {'coord' => $cr} unless $cellattribs->{$cr}->{coord};
1408                  my $formatdef = 0;
1409                  $formatdef = $valueformathash->{$rest} if length($rest);
1410                  if (!$formatdef) {
1411                     if (length($rest)) {
1412                        push @$valueformats, "" unless scalar @$valueformats;
1413                        $formatdef = (push @$valueformats, $rest) - 1;
1414                        $valueformathash->{$rest} = $formatdef;
1415                        }
1416                     }
1417                  $cellattribs->{$cr}->{$attrib} = $formatdef;
1418                  }
1419               elsif ($attrib eq "cssc") {
1420                  $cellattribs->{$cr} = {'coord' => $cr} unless $cellattribs->{$cr}->{coord};
1421                  $rest =~ s/[^a-zA-Z0-9\-]//g;
1422                  $cellattribs->{$cr}->{$attrib} = $rest;
1423                  }
1424               elsif ($attrib eq "csss") {
1425                  $cellattribs->{$cr} = {'coord' => $cr} unless $cellattribs->{$cr}->{coord};
1426                  $rest =~ s/\n//g;
1427                  $cellattribs->{$cr}->{$attrib} = $rest;
1428                  }
1429               elsif ($attrib eq "mod") {
1430                  $cellattribs->{$cr} = {'coord' => $cr} unless $cellattribs->{$cr}->{coord};
1431                  $rest =~ s/[^yY]//g;
1432                  $cellattribs->{$cr}->{$attrib} = lc $rest;
1433                  }
1434               else {
1435                  $errortext = "Unknown attributename '$attrib' in line:\n$command\n";
1436                  return 0;
1437                  }
1438               }
1439            }
1440         }
1441      }
1442
1443   elsif ($cmd1 =~ m/^(?:erase|copy|cut|paste|fillright|filldown|sort)$/) {
1444      ($what, $rest) = split(/ /, $rest, 2);
1445      $what = uc($what);
1446      ($coord1, $coord2) = split(/:/, $what);
1447      my ($c1, $r1) = coord_to_cr($coord1);
1448      my $c2 = $c1;
1449      my $r2 = $r1;
1450      ($c2, $r2) = coord_to_cr($coord2) if $coord2;
1451      $sheetattribs->{lastcol} = $c2 if $c2 > $sheetattribs->{lastcol};
1452      $sheetattribs->{lastrow} = $r2 if $r2 > $sheetattribs->{lastrow};
1453
1454      if ($cmd1 eq "erase") {
1455         for (my $r = $r1; $r <= $r2; $r++) {
1456            for (my $c = $c1; $c <= $c2; $c++) {
1457               my $cr = cr_to_coord($c, $r);
1458               if ($rest eq "all") {
1459                  delete $cellattribs->{$cr};
1460                  delete $datavalues->{$cr};
1461                  delete $dataformulas->{$cr};
1462                  delete $cellerrors->{$cr};
1463                  delete $datatypes->{$cr};
1464                  delete $valuetypes->{$cr};
1465                  }
1466               elsif ($rest eq "formulas") {
1467                  delete $datavalues->{$cr};
1468                  delete $dataformulas->{$cr};
1469                  delete $cellerrors->{$cr};
1470                  delete $datatypes->{$cr};
1471                  delete $valuetypes->{$cr};
1472                  }
1473               elsif ($rest eq "formats") {
1474                  $cellattribs->{$cr} = {'coord' => $cr}; # Leave with minimal set
1475                  }
1476               }
1477            }
1478         $sheetdata->{sheetattribs}->{needsrecalc} = "yes";
1479         }
1480
1481      elsif ($cmd1 eq "fillright" || $cmd1 eq "filldown") {
1482         my ($fillright, $rowstart, $colstart);
1483         if ($cmd1 eq "fillright") {
1484            $fillright = 1;
1485            $rowstart = $r1;
1486            $colstart = $c1 + 1;
1487            }
1488         else {
1489            $rowstart = $r1 + 1;
1490            $colstart = $c1;
1491            }
1492         for (my $r = $rowstart; $r <= $r2; $r++) {
1493            for (my $c = $colstart; $c <= $c2; $c++) {
1494               my $cr = cr_to_coord($c, $r);
1495               my ($crbase, $rowoffset, $coloffset);
1496               if ($fillright) {
1497                  $crbase = cr_to_coord($c1, $r);
1498                  $coloffset = $c - $colstart + 1;
1499                  $rowoffset = 0;
1500                  }
1501               else {
1502                  $crbase = cr_to_coord($c, $r1);
1503                  $coloffset = 0;
1504                  $rowoffset = $r - $rowstart + 1;
1505                  }
1506               if ($rest eq "all" || $rest eq "formats") {
1507                  $cellattribs->{$cr} = {'coord' => $cr}; # Start with minimal set
1508                  foreach my $attribtype (keys %{$cellattribs->{$crbase}}) {
1509                     if ($attribtype ne "coord") {
1510                        $cellattribs->{$cr}->{$attribtype} = $cellattribs->{$crbase}->{$attribtype};
1511                        }
1512                     }
1513                  }
1514               if ($rest eq "all" || $rest eq "formulas") {
1515                  $cellattribs->{$cr} = {'coord' => $cr} unless $cellattribs->{$cr}->{coord}; # Make sure this exists
1516                  $datavalues->{$cr} = $datavalues->{$crbase};
1517                  $datatypes->{$cr} = $datatypes->{$crbase};
1518                  $valuetypes->{$cr} = $valuetypes->{$crbase};
1519                  if ($datatypes->{$cr} eq "f") {
1520                     $dataformulas->{$cr} = offset_formula_coords($dataformulas->{$crbase}, $coloffset, $rowoffset);
1521                     }
1522                  else {
1523                     $dataformulas->{$cr} = $dataformulas->{$crbase};
1524                     }
1525                  $cellerrors->{$cr} = $cellerrors->{$crbase};
1526                  }
1527               }
1528            }
1529         $sheetdata->{sheetattribs}->{needsrecalc} = "yes";
1530         }
1531
1532      elsif ($cmd1 eq "copy" || $cmd1 eq "cut") {
1533         $sheetdata->{clipboard} = {}; # clear and create clipboard
1534         $sheetdata->{clipboard}->{datavalues} = {};
1535         my $clipdatavalues = $sheetdata->{clipboard}->{datavalues};
1536         $sheetdata->{clipboard}->{datatypes} = {};
1537         my $clipdatatypes = $sheetdata->{clipboard}->{datatypes};
1538         $sheetdata->{clipboard}->{valuetypes} = {};
1539         my $clipvaluetypes = $sheetdata->{clipboard}->{valuetypes};
1540         $sheetdata->{clipboard}->{formulas} = {};
1541         my $clipdataformulas = $sheetdata->{clipboard}->{formulas};
1542         $sheetdata->{clipboard}->{cellerrors} = {};
1543         my $clipcellerrors = $sheetdata->{clipboard}->{cellerrors};
1544         $sheetdata->{clipboard}->{cellattribs} = {};
1545         my $clipcellattribs = $sheetdata->{clipboard}->{cellattribs};
1546
1547         for (my $r = $r1; $r <= $r2; $r++) {
1548            for (my $c = $c1; $c <= $c2; $c++) {
1549               my $cr = cr_to_coord($c, $r);
1550               $clipcellattribs->{$cr}->{'coord' => $cr}; # make sure something (used for save)
1551               if ($rest eq "all" || $rest eq "formats") {
1552                  foreach my $attribtype (keys %{$cellattribs->{$cr}}) {
1553                     $clipcellattribs->{$cr}->{$attribtype} = $cellattribs->{$cr}->{$attribtype};
1554                     }
1555                  if ($cmd1 eq "cut") {
1556                     delete $cellattribs->{$cr};
1557                     $cellattribs->{$cr} = {'coord' => $cr} if $rest eq "formats";
1558                     }
1559                  }
1560               if ($rest eq "all" || $rest eq "formulas") {
1561                  $clipcellattribs->{$cr}->{coord} = $cellattribs->{$cr}->{coord}; # used by save
1562                  $clipdatavalues->{$cr} = $datavalues->{$cr};
1563                  $clipdataformulas->{$cr} = $dataformulas->{$cr};
1564                  $clipcellerrors->{$cr} = $cellerrors->{$cr};
1565                  $clipdatatypes->{$cr} = $datatypes->{$cr};
1566                  $clipvaluetypes->{$cr} = $valuetypes->{$cr};
1567                  if ($cmd1 eq "cut") {
1568                     delete $datavalues->{$cr};
1569                     delete $dataformulas->{$cr};
1570                     delete $cellerrors->{$cr};
1571                     delete $datatypes->{$cr};
1572                     delete $valuetypes->{$cr};
1573                     }
1574                  }
1575               }
1576            }
1577         $sheetdata->{clipboard}->{range} = $coord2 ? "$coord1:$coord2" : "$coord1:$coord1";
1578         $sheetdata->{sheetattribs}->{needsrecalc} = "yes" if $cmd1 eq "cut";
1579         }
1580
1581      elsif ($cmd1 eq "paste") {
1582         my $crbase = $sheetdata->{clipboard}->{range};
1583         if (!$crbase) {
1584            $errortext = "Empty clipboard\n";
1585            return 0;
1586            }
1587         my $clipdatavalues = $sheetdata->{clipboard}->{datavalues};
1588         my $clipdatatypes = $sheetdata->{clipboard}->{datatypes};
1589         my $clipvaluetypes = $sheetdata->{clipboard}->{valuetypes};
1590         my $clipdataformulas = $sheetdata->{clipboard}->{formulas};
1591         my $clipcellerrors = $sheetdata->{clipboard}->{cellerrors};
1592         my $clipcellattribs = $sheetdata->{clipboard}->{cellattribs};
1593
1594         my ($clipcoord1, $clipcoord2) = split(/:/, $crbase);
1595         $clipcoord2 = $clipcoord1 unless $clipcoord2;
1596         my ($clipc1, $clipr1) = coord_to_cr($clipcoord1);
1597         my ($clipc2, $clipr2) = coord_to_cr($clipcoord2);
1598         my $coloffset = $c1 - $clipc1;
1599         my $rowoffset = $r1 - $clipr1;
1600         my $numcols = $clipc2 - $clipc1 + 1;
1601         my $numrows = $clipr2 - $clipr1 + 1;
1602         $sheetattribs->{lastcol} = $c1 + $numcols - 1 if $c1 + $numcols - 1 > $sheetattribs->{lastcol};
1603         $sheetattribs->{lastrow} = $r1 + $numrows - 1 if $r1 + $numrows - 1 > $sheetattribs->{lastrow};
1604
1605         for (my $r = 0; $r < $numrows; $r++) {
1606            for (my $c = 0; $c < $numcols; $c++) {
1607               my $cr = cr_to_coord($c1+$c, $r1+$r);
1608               my $clipcr = cr_to_coord($clipc1+$c, $clipr1+$r);
1609               if ($rest eq "all" || $rest eq "formats") {
1610                  $cellattribs->{$cr} = {'coord' => $cr}; # Start with minimal set
1611                  foreach my $attribtype (keys %{$clipcellattribs->{$clipcr}}) {
1612                     if ($attribtype ne "coord") {
1613                        $cellattribs->{$cr}->{$attribtype} = $clipcellattribs->{$clipcr}->{$attribtype};
1614                        }
1615                     }
1616                  }
1617               if ($rest eq "all" || $rest eq "formulas") {
1618                  $cellattribs->{$cr} = {'coord' => $cr} unless $cellattribs->{$cr}->{coord}; # Make sure this exists
1619                  $datavalues->{$cr} = $clipdatavalues->{$clipcr};
1620                  $datatypes->{$cr} = $clipdatatypes->{$clipcr};
1621                  $valuetypes->{$cr} = $clipvaluetypes->{$clipcr};
1622                  if ($datatypes->{$cr} eq "f") {
1623                     $dataformulas->{$cr} = offset_formula_coords($clipdataformulas->{$clipcr}, $coloffset, $rowoffset);
1624                     }
1625                  else {
1626                     $dataformulas->{$cr} = $clipdataformulas->{$clipcr};
1627                     }
1628                  $cellerrors->{$cr} = $clipcellerrors->{$clipcr};
1629                  }
1630               }
1631            }
1632         $sheetdata->{sheetattribs}->{needsrecalc} = "yes";
1633         }
1634
1635      elsif ($cmd1 eq "sort") { # sort cr1:cr2 col1 up/down col2 up/down col3 up/down
1636         my @col_dirs = split(/\s+/, $rest);
1637         my (@cols, @dirs);
1638         ($cols[1], $dirs[1], $cols[2], $dirs[2], $cols[3], $dirs[3]) = @col_dirs;
1639         my $nsortcols = int ((scalar @col_dirs)/2);
1640         my $sortdata = {}; # make a place to hold data to sort
1641         $sortdata->{datavalues} = {};
1642         my $sortdatavalues = $sortdata->{datavalues};
1643         $sortdata->{datatypes} = {};
1644         my $sortdatatypes = $sortdata->{datatypes};
1645         $sortdata->{valuetypes} = {};
1646         my $sortvaluetypes = $sortdata->{valuetypes};
1647         $sortdata->{formulas} = {};
1648         my $sortdataformulas = $sortdata->{formulas};
1649         $sortdata->{cellerrors} = {};
1650         my $sortcellerrors = $sortdata->{cellerrors};
1651         $sortdata->{cellattribs} = {};
1652         my $sortcellattribs = $sortdata->{cellattribs};
1653
1654         my (@sortlist, @sortvalues, @sorttypes, @rowvalues, @rowtypes);
1655         for (my $r = $r1; $r <= $r2; $r++) { # make a copy to replace over original in new order
1656            for (my $c = $c1; $c <= $c2; $c++) {
1657               my $cr = cr_to_coord($c, $r);
1658               next if !$cellattribs->{$cr}->{coord}; # don't copy blank cells
1659               $sortcellattribs->{$cr}->{'coord' => $cr};
1660               foreach my $attribtype (keys %{$cellattribs->{$cr}}) {
1661                  $sortcellattribs->{$cr}->{$attribtype} = $cellattribs->{$cr}->{$attribtype};
1662                  }
1663               $sortcellattribs->{$cr}->{coord} = $cellattribs->{$cr}->{coord}; # used by save
1664               $sortdatavalues->{$cr} = $datavalues->{$cr};
1665               $sortdataformulas->{$cr} = $dataformulas->{$cr};
1666               $sortcellerrors->{$cr} = $cellerrors->{$cr};
1667               $sortdatatypes->{$cr} = $datatypes->{$cr};
1668               $sortvaluetypes->{$cr} = $valuetypes->{$cr};
1669               }
1670            push @sortlist, scalar @sortlist; # make list to sort (0..numrows-1)
1671            @rowvalues = ();
1672            @rowtypes = ();
1673            for (my $i=1;$i<=$nsortcols;$i++) { # save values and types for comparing
1674               my $cr = "$cols[$i]$r"; # get from each sorting column
1675               push @rowvalues, $datavalues->{$cr};
1676               push @rowtypes, (substr($valuetypes->{$cr},0,1) || "b"); # just major type
1677               }
1678            push @sortvalues, [@rowvalues];
1679            push @sorttypes, [@rowtypes];
1680            }
1681
1682         # Do the sort
1683
1684         my ($a1, $b1, $ta, $tb, $cresult);
1685         @sortlist = sort {
1686                          for (my $i=0;$i<$nsortcols;$i++) {
1687                             if ($dirs[$i+1] eq "up") { # handle sort direction
1688                                $a1 = $a; $b1 = $b;
1689                                }
1690                             else {
1691                                $a1 = $b; $b1 = $a;
1692                                }
1693                             $ta = $sorttypes[$a1][$i];
1694                             $tb = $sorttypes[$b1][$i];
1695                             if ($ta eq "t") { # numbers < text < errors, blank always last no matter what dir
1696                                if ($tb eq "t") {
1697                                   $cresult = (lc $sortvalues[$a1][$i]) cmp (lc $sortvalues[$b1][$i]);
1698                                   }
1699                                elsif ($tb eq "n") {
1700                                   $cresult = 1;
1701                                   }
1702                                elsif ($tb eq "b") {
1703                                   $cresult = $dirs[$i+1] eq "up" ? -1 : 1;
1704                                   }
1705                                elsif ($tb eq "e") {
1706                                   $cresult = -1;
1707                                   }
1708                                }
1709                             elsif ($ta eq "n") {
1710                                if ($tb eq "t") {
1711                                   $cresult = -1;
1712                                   }
1713                                elsif ($tb eq "n") {
1714                                   $cresult = $sortvalues[$a1][$i] <=> $sortvalues[$b1][$i];
1715                                   }
1716                                elsif ($tb eq "b") {
1717                                   $cresult = $dirs[$i+1] eq "up" ? -1 : 1;
1718                                   }
1719                                elsif ($tb eq "e") {
1720                                   $cresult = -1;
1721                                   }
1722                                }
1723                             elsif ($ta eq "e") {
1724                                if ($tb eq "e") {
1725                                   $cresult = $sortvalues[$a1][$i] <=> $sortvalues[$b1][$i];
1726                                   }
1727                                elsif ($tb eq "b") {
1728                                   $cresult = $dirs[$i+1] eq "up" ? -1 : 1;
1729                                   }
1730                                else {
1731                                   $cresult = 1;
1732                                   }
1733                                }
1734                             elsif ($ta eq "b") {
1735                                if ($tb eq "b") {
1736                                   $cresult = 0;
1737                                   }
1738                                else {
1739                                   $cresult = $dirs[$i+1] eq "up" ? 1 : -1;
1740                                   }
1741                                }
1742                             return $cresult if $cresult;
1743                             }
1744                          return $a cmp $b;
1745                          } @sortlist;
1746
1747         my $originalrow;
1748         for (my $r = $r1; $r <= $r2; $r++) { # copy original back over in new rows
1749            $originalrow = $sortlist[$r-$r1];
1750            for (my $c = $c1; $c <= $c2; $c++) {
1751               my $cr = cr_to_coord($c, $r);
1752               my $sortedcr = cr_to_coord($c, $r1+$originalrow);
1753               if (!$sortcellattribs->{$sortedcr}->{coord}) { # copying an empty cell
1754                  delete $cellattribs->{$cr};
1755                  delete $datavalues->{$cr};
1756                  delete $dataformulas->{$cr};
1757                  delete $cellerrors->{$cr};
1758                  delete $datatypes->{$cr};
1759                  delete $valuetypes->{$cr};
1760                  next;
1761                  }
1762               $cellattribs->{$cr} = {'coord' => $cr};
1763               foreach my $attribtype (keys %{$sortcellattribs->{$sortedcr}}) {
1764                  if ($attribtype ne "coord") {
1765                     $cellattribs->{$cr}->{$attribtype} = $sortcellattribs->{$sortedcr}->{$attribtype};
1766                     }
1767                  }
1768               $datavalues->{$cr} = $sortdatavalues->{$sortedcr};
1769               $datatypes->{$cr} = $sortdatatypes->{$sortedcr};
1770               $valuetypes->{$cr} = $sortvaluetypes->{$sortedcr};
1771               if ($sortdatatypes->{$sortedcr} eq "f") {
1772                  $dataformulas->{$cr} = offset_formula_coords($sortdataformulas->{$sortedcr}, 0, ($r-$r1)-$originalrow);
1773                  }
1774               else {
1775                  $dataformulas->{$cr} = $sortdataformulas->{$sortedcr};
1776                  }
1777               $cellerrors->{$cr} = $sortcellerrors->{$sortedcr};
1778               }
1779            }
1780         $sheetdata->{sheetattribs}->{needsrecalc} = "yes";
1781         }
1782      }
1783
1784   elsif ($cmd1 eq "clearclipboard") {
1785      delete $sheetdata->{clipboard};
1786      }
1787
1788   elsif ($cmd1 eq "merge") {
1789      ($what, $rest) = split(/ /, $rest, 2);
1790      $what = uc($what);
1791      ($coord1, $coord2) = split(/:/, $what);
1792      my ($c1, $r1) = coord_to_cr($coord1);
1793      my $c2 = $c1;
1794      my $r2 = $r1;
1795      ($c2, $r2) = coord_to_cr($coord2) if $coord2;
1796      $sheetattribs->{lastcol} = $c2 if $c2 > $sheetattribs->{lastcol};
1797      $sheetattribs->{lastrow} = $r2 if $r2 > $sheetattribs->{lastrow};
1798
1799      $cellattribs->{$coord1} = {'coord' => $coord1} unless $cellattribs->{$coord1}->{coord};
1800
1801      delete $cellattribs->{$coord1}->{colspan};
1802      $cellattribs->{$coord1}->{colspan} = $c2 - $c1 + 1 if $c2 > $c1;
1803      delete $cellattribs->{$coord1}->{rowspan};
1804      $cellattribs->{$coord1}->{rowspan} = $r2 - $r1 + 1 if $r2 > $r1;
1805      }
1806
1807   elsif ($cmd1 eq "unmerge") {
1808      ($what, $rest) = split(/ /, $rest, 2);
1809      $what = uc($what);
1810      ($coord1, $coord2) = split(/:/, $what);
1811
1812      $cellattribs->{$coord1} = {'coord' => $coord1} unless $cellattribs->{$coord1}->{coord};
1813
1814      delete $cellattribs->{$coord1}->{colspan};
1815      delete $cellattribs->{$coord1}->{rowspan};
1816      }
1817
1818   elsif ($cmd1 eq "insertcol" || $cmd1 eq "insertrow") {
1819      ($what, $rest) = split(/ /, $rest, 2);
1820      $what = uc($what);
1821      ($coord1, $coord2) = split(/:/, $what);
1822      my ($c1, $r1) = coord_to_cr($coord1);
1823      my $lastcol = $sheetattribs->{lastcol};
1824      my $lastrow = $sheetattribs->{lastrow};
1825      my ($coloffset, $rowoffset, $colend, $rowend, $newcolstart, $newcolend, $newrowstart, $newrowend);
1826      if ($cmd1 eq "insertcol") {
1827         $coloffset = 1;
1828         $colend = $c1;
1829         $rowend = 1;
1830         $newcolstart = $c1;
1831         $newcolend = $c1;
1832         $newrowstart = 1;
1833         $newrowend = $lastrow;
1834         }
1835      else {
1836         $rowoffset = 1;
1837         $rowend = $r1;
1838         $colend = 1;
1839         $newcolstart = 1;
1840         $newcolend = $lastcol;
1841         $newrowstart = $r1;
1842         $newrowend = $r1;
1843         }
1844
1845      for (my $row = $lastrow; $row >= $rowend; $row--) { # copy the cells forward
1846         for (my $col = $lastcol; $col >= $colend; $col--) {
1847            my $coord = cr_to_coord($col, $row);
1848            my $coordnext = cr_to_coord($col+$coloffset, $row+$rowoffset);
1849            if (!$cellattribs->{$coord}) { # copying empty cell
1850               delete $cellattribs->{$coordnext};
1851               delete $datavalues->{$coordnext};
1852               delete $datatypes->{$coordnext};
1853               delete $valuetypes->{$coordnext};
1854               delete $dataformulas->{$coordnext};
1855               delete $cellerrors->{$coordnext};
1856               next;
1857               }
1858            $cellattribs->{$coordnext} = {'coord' => $coordnext}; # Start with minimal set
1859            foreach my $attribtype (keys %{$cellattribs->{$coord}}) {
1860               if ($attribtype ne "coord") {
1861                  $cellattribs->{$coordnext}->{$attribtype} = $cellattribs->{$coord}->{$attribtype};
1862                  }
1863               }
1864            $datavalues->{$coordnext} = $datavalues->{$coord};
1865            $datatypes->{$coordnext} = $datatypes->{$coord};
1866            $valuetypes->{$coordnext} = $valuetypes->{$coord};
1867            $dataformulas->{$coordnext} = $dataformulas->{$coord};
1868            $cellerrors->{$coordnext} = $cellerrors->{$coord};
1869            }
1870         }
1871      for (my $r = $newrowstart; $r <= $newrowend; $r++) { # fill the new cells
1872         for (my $c = $newcolstart; $c <= $newcolend; $c++) {
1873            my $cr = cr_to_coord($c, $r);
1874            delete $cellattribs->{$cr};
1875            delete $datavalues->{$cr};
1876            delete $datatypes->{$cr};
1877            delete $valuetypes->{$cr};
1878            delete $dataformulas->{$cr};
1879            delete $cellerrors->{$cr};
1880            my $crbase = cr_to_coord($c-$coloffset, $r-$rowoffset); # copy attribs of the one before (0 give you A or 1)
1881            if ($cellattribs->{$crbase}) {
1882               $cellattribs->{$cr} = {'coord' => $cr};
1883               foreach my $attribtype (keys %{$cellattribs->{$crbase}}) {
1884                  if ($attribtype ne "coord") {
1885                     $cellattribs->{$cr}->{$attribtype} = $cellattribs->{$crbase}->{$attribtype};
1886                     }
1887                  }
1888               }
1889            }
1890         }
1891      foreach my $cr (keys %$dataformulas) { # update cell references to moved cells in calculated formulas
1892         if ($datatypes->{$cr} eq "f") {
1893            $dataformulas->{$cr} = adjust_formula_coords($dataformulas->{$cr}, $c1, $coloffset, $r1, $rowoffset);
1894            }
1895         }
1896      for (my $row = $lastrow; $row >= $rowend && $cmd1 eq "insertrow"; $row--) { # copy the row attributes forward
1897         my $rownext = $row + $rowoffset;
1898         $rowattribs->{$rownext} = {'coord' => $rownext}; # start clean
1899         foreach my $attribtype (keys %{$rowattribs->{$row}}) {
1900            if ($attribtype ne "coord") {
1901               $rowattribs->{$rownext}->{$attribtype} = $rowattribs->{$row}->{$attribtype};
1902               }
1903            }
1904         }
1905      for (my $col = $lastcol; $col >= $colend && $cmd1 eq "insertcol"; $col--) { # copy the column attributes forward
1906         my $colthis = number_to_col($col);
1907         my $colnext = number_to_col($col + $coloffset);
1908         $colattribs->{$colnext} = {'coord' => $colnext};
1909         foreach my $attribtype (keys %{$colattribs->{$colthis}}) {
1910            if ($attribtype ne "coord") {
1911               $colattribs->{$colnext}->{$attribtype} = $colattribs->{$colthis}->{$attribtype};
1912               }
1913            }
1914         }
1915
1916      $sheetattribs->{lastcol} += $coloffset;
1917      $sheetattribs->{lastrow} += $rowoffset;
1918      $sheetdata->{sheetattribs}->{needsrecalc} = "yes";
1919      }
1920
1921   elsif ($cmd1 eq "deletecol" || $cmd1 eq "deleterow") {
1922      ($what, $rest) = split(/ /, $rest, 2);
1923      $what = uc($what);
1924      ($coord1, $coord2) = split(/:/, $what);
1925      my ($c1, $r1) = coord_to_cr($coord1);
1926      my $c2 = $c1;
1927      my $r2 = $r1;
1928      ($c2, $r2) = coord_to_cr($coord2) if $coord2;
1929      my $lastcol = $sheetattribs->{lastcol};
1930      my $lastrow = $sheetattribs->{lastrow};
1931      my ($coloffset, $rowoffset, $colstart, $rowstart);
1932      if ($cmd1 eq "deletecol") {
1933         $coloffset = $c1 - $c2 - 1;
1934         $colstart = $c2 + 1;
1935         $rowstart = 1;
1936         }
1937      else {
1938         $rowoffset = $r1 - $r2 - 1;
1939         $rowstart = $r2 + 1;
1940         $colstart = 1;
1941         }
1942
1943      for (my $row = $rowstart; $row <= $lastrow - $rowoffset; $row++) { # copy the cells backwards - extra so no dup of last set
1944         for (my $col = $colstart; $col <= $lastcol - $coloffset; $col++) {
1945            my $coord = cr_to_coord($col, $row);
1946            my $coordbefore = cr_to_coord($col+$coloffset, $row+$rowoffset);
1947            if (!$cellattribs->{$coord}) { # copying empty cell
1948               delete $cellattribs->{$coordbefore};
1949               delete $datavalues->{$coordbefore};
1950               delete $datatypes->{$coordbefore};
1951               delete $valuetypes->{$coordbefore};
1952               delete $dataformulas->{$coordbefore};
1953               delete $cellerrors->{$coordbefore};
1954               next;
1955               }
1956            $cellattribs->{$coordbefore} = {'coord' => $coordbefore}; # Start with minimal set
1957            foreach my $attribtype (keys %{$cellattribs->{$coord}}) {
1958               if ($attribtype ne "coord") {
1959                  $cellattribs->{$coordbefore}->{$attribtype} = $cellattribs->{$coord}->{$attribtype};
1960                  }
1961               }
1962            $datavalues->{$coordbefore} = $datavalues->{$coord};
1963            $datatypes->{$coordbefore} = $datatypes->{$coord};
1964            $valuetypes->{$coordbefore} = $valuetypes->{$coord};
1965            $dataformulas->{$coordbefore} = $dataformulas->{$coord};
1966            $cellerrors->{$coordbefore} = $cellerrors->{$coord};
1967            }
1968         }
1969      foreach my $cr (keys %$dataformulas) { # update references to moved cells in calculated formulas
1970         if ($datatypes->{$cr} eq "f") {
1971            $dataformulas->{$cr} = adjust_formula_coords($dataformulas->{$cr}, $c1, $coloffset, $r1, $rowoffset);
1972            }
1973         }
1974      for (my $row = $rowstart; $row <= $lastrow - $rowoffset && $cmd1 eq "deleterow"; $row++) { # copy the row attributes backward
1975         my $rowbefore = $row + $rowoffset;
1976         $rowattribs->{$rowbefore} = {'coord' => $rowbefore}; # start with only coord
1977         foreach my $attribtype (keys %{$rowattribs->{$row}}) {
1978            if ($attribtype ne "coord") {
1979               $rowattribs->{$rowbefore}->{$attribtype} = $rowattribs->{$row}->{$attribtype};
1980               }
1981            }
1982         }
1983      for (my $col = $colstart; $col <= $lastcol - $coloffset && $cmd1 eq "deletecol"; $col++) { # copy the column attributes backward
1984         my $colthis = number_to_col($col);
1985         my $colbefore = number_to_col($col + $coloffset);
1986         $colattribs->{$colbefore} = {'coord' => $colbefore};
1987         foreach my $attribtype (keys %{$colattribs->{$colthis}}) {
1988            if ($attribtype ne "coord") {
1989               $colattribs->{$colbefore}->{$attribtype} = $colattribs->{$colthis}->{$attribtype};
1990               }
1991            }
1992         }
1993
1994      if ($cmd1 eq "deletecol") {
1995         if ($c1 <= $lastcol) { # shrink sheet unless deleted phantom cols off the end
1996            if ($c2 <= $lastcol) {
1997               $sheetattribs->{lastcol} += $coloffset;
1998               }
1999            else {
2000               $sheetattribs->{lastcol} = $c1 - 1;
2001               }
2002            }
2003         }
2004      else {
2005         if ($r1 <= $lastrow) { # shrink sheet unless deleted phantom rows off the end
2006            if ($r2 <= $lastrow) {
2007               $sheetattribs->{lastrow} += $rowoffset;
2008               }
2009            else {
2010               $sheetattribs->{lastrow} = $r1 - 1;
2011               }
2012            }
2013         }
2014      $sheetdata->{sheetattribs}->{needsrecalc} = "yes";
2015      }
2016
2017   else {
2018      $errortext = "Unknown command '$cmd1' in line:\n$command\n";
2019      return 0;
2020      }
2021
2022   return $command;
2023   }
2024
2025# # # # # # # # #
2026#
2027# $updatedformula = offset_formula_coords($formula, $coloffset, $rowoffset)
2028#
2029# Change relative cell references by offsets, even those to other worksheets
2030#
2031# # # # # # # # #
2032
2033sub offset_formula_coords {
2034
2035   my ($formula, $coloffset, $rowoffset) = @_;
2036
2037   my $parseinfo = parse_formula_into_tokens($formula);
2038
2039   my $parsed_token_text = $parseinfo->{tokentext};
2040   my $parsed_token_type = $parseinfo->{tokentype};
2041   my $parsed_token_opcode = $parseinfo->{tokenopcode};
2042
2043   my ($ttype, $ttext, $sheetref, $updatedformula);
2044   for (my $i=0; $i<scalar @$parsed_token_text; $i++) {
2045      $ttype = $parsed_token_type->[$i];
2046      $ttext = $parsed_token_text->[$i];
2047      if ($ttype == $token_coord) {
2048         if (($i < scalar @$parsed_token_text-1)
2049             && $parsed_token_type->[$i+1] == $token_op && $parsed_token_text->[$i+1] eq "!") {
2050            $sheetref = 1; # This is a sheetname that looks like a coord - don't offset it
2051            }
2052         my ($c, $r) = coord_to_cr($ttext);
2053         my $abscol = $ttext =~ m/^\$/;
2054         $c += $coloffset unless $abscol || $sheetref;
2055         my $absrow = $ttext =~ m/^\${0,1}[a-zA-Z]{1,2}\$\d+$/;
2056         $r += $rowoffset unless $absrow || $sheetref;
2057         $sheetref = 0; # only lasts for one coord
2058         $ttext = cr_to_coord($c, $r);
2059         $ttext =~ s/^/\$/ if $abscol;
2060         $ttext =~ s/(\d+)$/\$$1/ if $absrow;
2061         if ($r < 1 || $c < 1) {
2062            $ttext = "WKCERRCELL";
2063            }
2064         }
2065      elsif ($ttype == $token_string) {
2066         $ttext =~ s/"/""/g;
2067         $ttext = '"' . $ttext . '"';
2068         }
2069      elsif ($ttype == $token_op) {
2070         $ttext = $token_op_expansion{$ttext} || $ttext; # make sure short tokens (e.g., "G") go back full (">=")
2071         }
2072      $updatedformula .= $ttext;
2073      }
2074
2075   return $updatedformula;
2076
2077}
2078
2079
2080# # # # # # # # #
2081#
2082# $updatedformula = adjust_formula_coords($formula, $col, $coloffset, $row, $rowoffset)
2083#
2084# Change all cell references to cells starting with $col/$row by offsets
2085#
2086# # # # # # # # #
2087
2088sub adjust_formula_coords {
2089
2090   my ($formula, $col, $coloffset, $row, $rowoffset) = @_;
2091
2092   my $parseinfo = parse_formula_into_tokens($formula);
2093
2094   my $parsed_token_text = $parseinfo->{tokentext};
2095   my $parsed_token_type = $parseinfo->{tokentype};
2096   my $parsed_token_opcode = $parseinfo->{tokenopcode};
2097
2098   my ($ttype, $ttext, $sheetref, $updatedformula);
2099   for (my $i=0; $i<scalar @$parsed_token_text; $i++) {
2100      $ttype = $parsed_token_type->[$i];
2101      $ttext = $parsed_token_text->[$i];
2102      if ($ttype == $token_op) { # references with sheet specifier are not offset
2103         if ($ttext eq "!") {
2104            $sheetref = 1; # found a sheet reference
2105            }
2106         elsif ($ttext ne ":") { # for everything but a range, reset
2107            $sheetref = 0;
2108            }
2109         $ttext = $token_op_expansion{$ttext} || $ttext; # make sure short tokens (e.g., "G") go back full (">=")
2110         }
2111      if ($ttype == $token_coord) {
2112         if (($i < scalar @$parsed_token_text-1)
2113             && $parsed_token_type->[$i+1] == $token_op && $parsed_token_text->[$i+1] eq "!") {
2114            $sheetref = 1; # This is a sheetname that looks like a coord
2115            }
2116         my ($c, $r) = coord_to_cr($ttext);
2117         if (($c == $col && $coloffset < 0) || ($r == $row && $rowoffset < 0)) { # refs to deleted cells become invalid
2118            $c = 0 unless $sheetref;
2119            $r = 0 unless $sheetref;
2120            }
2121         my $abscol = $ttext =~ m/^\$/;
2122         $c += $coloffset if $c >= $col && !$sheetref;
2123         my $absrow = $ttext =~ m/^\${0,1}[a-zA-Z]{1,2}\$\d+$/;
2124         $r += $rowoffset if $r >= $row && !$sheetref;
2125         $ttext = cr_to_coord($c, $r);
2126         $ttext =~ s/^/\$/ if $abscol;
2127         $ttext =~ s/(\d+)$/\$$1/ if $absrow;
2128         if ($r < 1 || $c < 1) {
2129            $ttext = "WKCERRCELL";
2130            }
2131         }
2132      elsif ($ttype == $token_string) {
2133         $ttext =~ s/"/""/g;
2134         $ttext = '"' . $ttext . '"';
2135         }
2136      $updatedformula .= $ttext;
2137      }
2138
2139   return $updatedformula;
2140
2141}
2142
2143
2144# # # # # # # # #
2145#
2146# ($stylestr, $outstr) = render_sheet($sheetdata, $extratableattribs, $styleprefix, $anchorsuffix, $editmode, $editcoords, $onclickstr, $linkstyle)
2147#
2148# Sheet rendering routine
2149#
2150# Editmode may be "ajax" (grid), "publish" (no grid, cssc used), "embed" (publish for Javascript embedding),
2151# "inline" (publish with inline CSS and no stylesheet classes except explicit cssc), or null (no grid)
2152#
2153# # # # # # # # #
2154
2155sub render_sheet {
2156
2157   my ($sheetdata, $extratableattribs, $extratdattribs, $styleprefix, $anchorsuffix, $editmode, $editcoords, $onclickstr, $linkstyle) = @_;
2158   $styleprefix ||= "s";
2159   $extratableattribs = " $extratableattribs" if $extratableattribs;
2160   $extratdattribs = " $extratdattribs" if $extratdattribs;
2161
2162   my ($publishmode, $embedmode, $inlinemode);
2163   if ($editmode eq "publish") {
2164      $publishmode = 1;
2165      $editmode = "";
2166      }
2167   elsif ($editmode eq "embed") {
2168      $publishmode = 1;
2169      $embedmode = 1;
2170      $editmode = "";
2171      }
2172   elsif ($editmode eq "inline") {
2173      $publishmode = 1;
2174      $inlinemode = 1;
2175      $editmode = "";
2176      }
2177
2178   # Get references to the parts
2179
2180   my $datavalues = $sheetdata->{datavalues};
2181   my $datatypes = $sheetdata->{datatypes};
2182   my $valuetypes = $sheetdata->{valuetypes};
2183   my $dataformulas = $sheetdata->{formulas};
2184   my $cellerrors = $sheetdata->{cellerrors};
2185   my $cellattribs = $sheetdata->{cellattribs};
2186   my $colattribs = $sheetdata->{colattribs};
2187   my $rowattribs = $sheetdata->{rowattribs};
2188   my $sheetattribs = $sheetdata->{sheetattribs};
2189   my $layoutstyles = $sheetdata->{layoutstyles};
2190   my $layoutstylehash = $sheetdata->{layoutstylehash};
2191   my $fonts = $sheetdata->{fonts};
2192   my $fonthash = $sheetdata->{fonthash};
2193   my $colors = $sheetdata->{colors};
2194   my $colorhash = $sheetdata->{colorhash};
2195   my $borderstyles = $sheetdata->{borderstyles};
2196   my $borderstylehash = $sheetdata->{borderstylehash};
2197   my $cellformats = $sheetdata->{cellformats};
2198   my $cellformathash = $sheetdata->{cellformathash};
2199   my $valueformats = $sheetdata->{valueformats};
2200   my $valueformathash = $sheetdata->{valueformathash};
2201
2202   my ($outstr, $stylestr);
2203   my ($rest, $linetype, $coord, $cellattribscoord, $type, $value, $style, $layoutnum, $fontnum, $fontstr, $colornum, $check, $displayvalue,
2204       $valueformat, $span, $spanstr, $cellclass, $valuetype, $explicitstyle, $jsstr);
2205   my (@styles, %stylehash, %cellskip, %selected);
2206   my ($lastcol, $lastrow);
2207
2208   my $defaultlayoutnum = $sheetattribs->{defaultlayout};
2209   my $defaultlayout = $defaultlayoutnum ? $layoutstyles->[$defaultlayoutnum] : $WKCStrings{"sheetdefaultlayoutstyle"};
2210
2211   my $defaultfontnum = $sheetattribs->{defaultfont};
2212   my $defaultfont = $defaultfontnum ? $fonts->[$defaultfontnum] : "* * *";
2213   $defaultfont =~ s/^\*/normal normal/;
2214   $defaultfont =~ s/(.+)\*(.+)/$1small$2/;
2215   $defaultfont =~ s/\*$/$WKCStrings{sheetdefaultfontfamily}/e;
2216   $defaultfont =~ m/^(\S+? \S+?) (\S+?) (\S.*)$/;
2217   my $defaultfontstyle = $1;
2218   my $defaultfontsize = $2;
2219   my $defaultfontfamily = $3;
2220
2221   $editcoords =~ s/:\w+$//; # only single cell
2222
2223   if ($embedmode) { # need special codes and no ID
2224      $outstr .= <<"EOF";
2225c|<table cellspacing="0" cellpadding="0" style="border-collapse:collapse;"$extratableattribs>
2226EOF
2227      }
2228   else {
2229      $outstr .= <<"EOF"; # output table tag
2230<table cellspacing="0" cellpadding="0" style="border-collapse:collapse;"$extratableattribs>
2231EOF
2232      }
2233   if ($editmode) {
2234      $selected{$editcoords} = 1;
2235      my $c = $editcoords;
2236      $c =~ s/\d+//;
2237      $selected{$c} = "selectedcolname";
2238      my $r = $editcoords;
2239      $r =~ s/\D+//;
2240      $selected{$r} = "selectedrowname";
2241      ($c, $r) = coord_to_cr($editcoords);
2242      $lastcol = $c < $sheetattribs->{lastcol} ? $sheetattribs->{lastcol} : ($c > $sheetattribs->{lastcol} ? $c : $sheetattribs->{lastcol});
2243      $lastrow = $r < $sheetattribs->{lastrow} ? $sheetattribs->{lastrow} : ($r > $sheetattribs->{lastrow} ? $r : $sheetattribs->{lastrow});
2244      }
2245   else {
2246      my ($c, $r) = coord_to_cr($editcoords);
2247      $lastcol = $sheetattribs->{lastcol};
2248      $lastrow = $sheetattribs->{lastrow};
2249      }
2250
2251   my ($maxcol, $maxrow);
2252
2253   for (my $row = 1; $row <= $lastrow; $row++) { # if span, set to skip other cells in column/row
2254      for (my $col = 1; $col <= $lastcol; $col++) {
2255         $coord = cr_to_coord($col, $row);
2256         next if $cellskip{$coord};
2257         my $colspan = $cellattribs->{$coord}->{colspan} || 1;
2258         my $rowspan = $cellattribs->{$coord}->{rowspan} || 1;
2259         $cellattribs->{$coord}->{hrowspan} = 0;
2260         $cellattribs->{$coord}->{hcolspan} = 0;
2261         for (my $srow=$row; $srow<$row+$rowspan; $srow++) {
2262            $cellattribs->{$coord}->{hrowspan}++ if $rowattribs->{$srow}->{hide} ne "yes";
2263            for (my $scol=$col; $scol<$col+$colspan; $scol++) {
2264               $cellattribs->{$coord}->{hcolspan}++ if (($srow==$row) && ($colattribs->{number_to_col($scol)}->{hide} ne "yes"));
2265               my $scoord = cr_to_coord($scol, $srow);
2266               $cellskip{$scoord} = $coord unless $scoord eq $coord;
2267               $maxcol = $scol if $scol > $maxcol;
2268               $maxrow = $srow if $srow > $maxrow;
2269               }
2270            }
2271         }
2272      }
2273   $lastcol = $maxcol; # merged cells may go past cells with content
2274   $lastrow = $maxrow;
2275
2276   $lastrow += 10 if $editmode; # Show a little extra
2277
2278   $outstr .= "c|" if $embedmode; # add special codes used by embedding Javascript
2279   $outstr .= "<colgroup>";
2280   $outstr .= qq!<col width="30">! if $editmode; # one for the row number
2281   for (my $col = 1; $col <= $lastcol; $col++) {
2282      $coord = cr_to_coord($col, 1); # calculate the width definitions for each column
2283      $coord =~ s/\d+//;
2284      $value = $colattribs->{$coord}->{width} || $sheetattribs->{defaultcolwidth} || "80";
2285      $value = "" if ($value eq "blank" || $value eq "auto");
2286      if ($embedmode) {
2287         $outstr .= qq!<col width="$value">!;
2288         }
2289      else {
2290         $outstr .= qq!<col id="c_$coord" width="$value">!;
2291         }
2292      }
2293   $outstr .= "\n";
2294
2295   if ($editmode) { # output column names
2296      $outstr .= qq!<tr><td class="upperleft">&nbsp;</td>!;
2297      for (my $col = 1; $col <= $lastcol; $col++) {
2298         $coord = cr_to_coord($col, 1);
2299         $coord =~ s/\d+//;
2300         if ($selected{$coord}) {
2301            $outstr .= qq!<td class="$selected{$coord}" id="cn_$coord">$coord</td>!; # includes id for colname
2302            }
2303         else {
2304            $outstr .= qq!<td class="colname" id="cn_$coord">$coord</td>!;
2305            }
2306         }
2307      $outstr .= "</tr>\n";
2308      }
2309
2310   for (my $row = 1; $row <= $lastrow; $row++) {
2311
2312      if ($editmode) {
2313         if ($selected{$row}) {
2314            $outstr .= qq!<tr id="r_$row"><td class="$selected{$row}" id="rn_$row">$row</td>\n!; # includes ids for row and row name
2315            }
2316         else {
2317            $outstr .= qq!<tr id="r_$row"><td class="rowname" id="rn_$row">$row</td>\n!;
2318            }
2319         }
2320      else {
2321         next if $rowattribs->{$row}->{hide} eq "yes"; # do row hides if not editing
2322         $outstr .= "c|" if $embedmode;
2323         $outstr .= "<tr>\n";
2324         }
2325
2326      for (my $col = 1; $col <= $lastcol; $col++) {
2327         next if (!$editmode && $colattribs->{number_to_col($col)}->{hide} eq "yes"); # do column hiding
2328
2329         $coord = cr_to_coord($col, $row);
2330
2331         next if $cellskip{$coord}; # skip if within a span
2332
2333         $cellattribscoord = $cellattribs->{$coord};
2334
2335         $spanstr = ""; # get span string if starting a span
2336         if ($span = $cellattribscoord->{$editmode ? "colspan" : "hcolspan"}) {
2337            $spanstr .= " colspan=$span" if $span > 1;
2338            }
2339         if ($span = $cellattribscoord->{$editmode ? "rowspan" : "hrowspan"}) {
2340            $spanstr .= " rowspan=$span" if $span > 1;
2341            }
2342
2343         $displayvalue = $datavalues->{$coord}; # start with raw value to format
2344         $displayvalue = format_value_for_display($sheetdata, $displayvalue, $coord, $linkstyle);
2345
2346         $stylestr = "";
2347
2348         $layoutnum = $cellattribscoord->{layout} || $sheetattribs->{defaultlayout};
2349         if ($layoutnum) {
2350            $stylestr .= $layoutstyles->[$layoutnum];
2351            }
2352         else {
2353            $stylestr .= $defaultlayout;
2354            }
2355
2356         $fontnum = $cellattribscoord->{font} || $sheetattribs->{defaultfont};
2357         if ($fontnum) {
2358            $fontstr = $fonts->[$fontnum];
2359            $fontstr =~ s/^\*/$defaultfontstyle/;
2360            $fontstr =~ s/(.+)\*(.+)/$1$defaultfontsize$2/;
2361            $fontstr =~ s/\*$/$defaultfontfamily/;
2362            $stylestr .= "font:$fontstr;";
2363            }
2364
2365         $colornum = $cellattribscoord->{color} || $sheetattribs->{defaultcolor};
2366         $stylestr .= "color:$colors->[$colornum];" if $colornum;
2367
2368         $colornum = $cellattribscoord->{bgcolor} || $sheetattribs->{defaultbgcolor};
2369         $stylestr .= "background-color:$colors->[$colornum];" if $colornum;
2370
2371         $style = $cellattribscoord->{cellformat};
2372         if ($style) {
2373            $stylestr .= "text-align:$cellformats->[$style];";
2374            }
2375         else {
2376            $valuetype = substr($valuetypes->{$coord},0,1); # get general type
2377            if ($valuetype eq "t") {
2378               $style = $sheetattribs->{defaulttextformat};
2379               if ($style) {
2380                  $stylestr .= "text-align:$cellformats->[$style];";
2381                  }
2382               }
2383            elsif ($valuetype eq "n") {
2384               $style = $sheetattribs->{defaultnontextformat};
2385               if ($style) {
2386                  $stylestr .= "text-align:$cellformats->[$style];";
2387                  }
2388               else {
2389                  $stylestr .= "text-align:right;"
2390                  }
2391               }
2392            else { # empty
2393               $stylestr .= "text-align:left;"
2394               }
2395            }
2396
2397         if ($editmode eq "ajax" && $selected{$coord}) {
2398            $cellclass = "cellcursor";
2399            }
2400         else {
2401            $cellclass = "cellnormal";
2402            }
2403
2404         if ($editmode) {
2405            $style = $cellattribscoord->{bt};
2406            $check = cr_to_coord($col, $row - 1);
2407            $check = $cellskip{$check} if $cellskip{$check}; # look past ignored cells
2408            if ($style) {
2409               $stylestr .= "border-top:$borderstyles->[$style];" if (!$cellattribs->{$check}->{bb} || $row==1);
2410               }
2411            else {
2412               $stylestr .= "border-top:1px dotted #CCCCCC;" if (!$cellattribs->{$check}->{bb} && $row!=1);
2413               }
2414
2415            $style = $cellattribscoord->{br};
2416            if ($style) {
2417               $stylestr .= "border-right:$borderstyles->[$style];";
2418               }
2419            else {
2420               $check = cr_to_coord($col + 1, $row);
2421               $check = $cellskip{$check} if $cellskip{$check};
2422               $stylestr .= "border-right:1px dotted #CCCCCC;" if (!$cellattribs->{$check}->{bl});
2423               }
2424
2425            $style = $cellattribscoord->{bb};
2426            if ($style) {
2427               $stylestr .= "border-bottom:$borderstyles->[$style];";
2428               }
2429            else {
2430               $check = cr_to_coord($col, $row + 1);
2431               $check = $cellskip{$check} if $cellskip{$check};
2432               $stylestr .= "border-bottom:1px dotted #CCCCCC;" if (!$cellattribs->{$check}->{bt});
2433               }
2434
2435            $style = $cellattribscoord->{bl};
2436            $check = cr_to_coord($col - 1, $row);
2437            $check = $cellskip{$check} if $cellskip{$check};
2438            if ($style) {
2439               $stylestr .= "border-left:$borderstyles->[$style];" if (!$cellattribs->{$check}->{br} || $col==1);
2440               }
2441            else {
2442               $stylestr .= "border-left:1px dotted #CCCCCC;" if (!$cellattribs->{$check}->{br} && $col!=1);
2443               }
2444            }
2445         else {
2446            $style = $cellattribscoord->{bt};
2447            $check = cr_to_coord($col, $row - 1);
2448            $check = $cellskip{$check} if $cellskip{$check}; # look past ignored cells
2449            if ($style) {
2450               $stylestr .= "border-top:$borderstyles->[$style];" if (!$cellattribs->{$check}->{bb} || $row==1);
2451               }
2452            $style = $cellattribscoord->{br};
2453            if ($style) {
2454               $stylestr .= "border-right:$borderstyles->[$style];";
2455               }
2456            $style = $cellattribscoord->{bb};
2457            if ($style) {
2458               $stylestr .= "border-bottom:$borderstyles->[$style];";
2459               }
2460            $style = $cellattribscoord->{bl};
2461            $check = cr_to_coord($col - 1, $row);
2462            $check = $cellskip{$check} if $cellskip{$check};
2463            if ($style) {
2464               $stylestr .= "border-left:$borderstyles->[$style];" if (!$cellattribs->{$check}->{br} || $col==1);
2465               }
2466            }
2467
2468         if ($publishmode && $cellattribscoord->{cssc}) {
2469            $style = $cellattribscoord->{cssc};
2470            }
2471         else {
2472            $style = $stylehash{$stylestr};
2473            if (!$style) {
2474               $style = @styles || 1;
2475               $stylehash{$stylestr} = $style;
2476               $styles[$style] = $stylestr;
2477               }
2478            $style = "$styleprefix$style";
2479            }
2480
2481         $explicitstyle = "";
2482         if ($cellattribscoord->{csss}) { # explicit style
2483            $explicitstyle = qq! style="$cellattribscoord->{csss}"!;
2484            }
2485
2486         my $onclickstrp = $onclickstr;
2487         $onclickstrp =~ s/\$coord/$coord/ge;
2488
2489         if ($editmode) {
2490            $outstr .= <<"EOF";
2491<td$extratdattribs class="$style"$explicitstyle$spanstr$onclickstrp id="$coord"><div class="$cellclass">$displayvalue</div></td>
2492EOF
2493            }
2494         elsif ($embedmode) {
2495            $outstr .= $style;
2496            if ($cellattribscoord->{hcolspan}>1 || $cellattribscoord->{hrowspan}>1 || $explicitstyle) {
2497               $outstr .= $cellattribscoord->{cssc} ? ":y" : ":n"; # always add this field if more
2498               $outstr .= ":$cellattribscoord->{hcolspan}:$cellattribscoord->{hrowspan}";
2499               if ($explicitstyle) {
2500                  $outstr .= ":*" . encode_for_javascript($cellattribscoord->{csss});
2501                  }
2502               }
2503            else {
2504               $outstr .= ":y" if $cellattribscoord->{cssc}; # only add if cssc
2505               }
2506            $jsstr = encode_for_javascript($displayvalue);
2507            $outstr .= "|$jsstr\n";
2508            }
2509         elsif ($inlinemode) {
2510            if ($cellattribscoord->{cssc}) {
2511               $outstr .= <<"EOF";
2512<td$extratdattribs class="$cellattribscoord->{cssc}"$explicitstyle$spanstr$onclickstrp>$displayvalue</td>
2513EOF
2514               }
2515            else {
2516               $outstr .= <<"EOF";
2517<td$extratdattribs style="$stylestr"$explicitstyle$spanstr$onclickstrp>$displayvalue</td>
2518EOF
2519               }
2520            }
2521         else {
2522            $outstr .= <<"EOF";
2523<td$extratdattribs class="$style"$explicitstyle$spanstr$onclickstrp>$displayvalue</td>
2524EOF
2525            }
2526         }
2527      $outstr .= "c|" if $embedmode;
2528      $outstr .= "</tr>\n";
2529      }
2530
2531   $outstr .= "c|" if $embedmode;
2532   $outstr .= "<tr>"; # output one last row with no spans to make sure browsers like IE have enough columns for layout
2533   $outstr .= qq!<td></td>! if $editmode; # one for the row number
2534   for (my $col = 1; $col <= $lastcol; $col++) {
2535      $outstr .= qq!<td$extratdattribs></td>!;
2536      }
2537   $outstr .= "</tr>\n";
2538
2539   $outstr .= "c|" if $embedmode;
2540   $outstr .= <<"EOF";
2541</table>
2542EOF
2543
2544   $stylestr = "";
2545
2546   $stylestr .= <<"EOF" if $editmode;
2547.colname {text-align: center;color: white;background-color: #CCCC99;border:none;}
2548.selectedcolname {text-align: center;color: white;background-color: #666633;border-left:3px solid #666633;border-right:3px solid #666633;}
2549.rowname {text-align: right;color: white;background-color: #CCCC99;padding-left:1em;border:none;}
2550.selectedrowname {text-align: right;color: white;background-color: #666633;padding-left:1em;border-top:3px solid #666633;border-bottom:3px solid #666633;}
2551.upperleft {border: 0px solid black;}
2552.skippedcell {background-color:#CCCCCC;}
2553EOF
2554
2555   for (my $i = 1; $i < @styles; $i++) {
2556      if ($embedmode) {
2557         $stylestr .= "styles.$styleprefix$i='" . encode_for_javascript($styles[$i]) . "';\n";
2558         }
2559      else {
2560         $stylestr .= <<"EOF";
2561.$styleprefix$i {$styles[$i]}
2562EOF
2563         }
2564      }
2565   return ($stylestr, $outstr);
2566
2567
2568};
2569
2570
2571# # # # # # # # #
2572#
2573# $displayvalue = format_value_for_display(\%sheetdata, $value, $cr, $linkstyle)
2574#
2575# # # # # # # # #
2576
2577sub format_value_for_display {
2578
2579   my ($sheetdata, $value, $cr, $linkstyle) = @_;
2580
2581   my ($valueformat, $has_parens, $has_commas, $valuetype, $valuesubtype);
2582
2583   # Get references to the parts
2584
2585   my $datavalues = $sheetdata->{datavalues};
2586   my $valuetypes = $sheetdata->{valuetypes};
2587   my $cellerrors = $sheetdata->{cellerrors};
2588   my $cellattribs = $sheetdata->{cellattribs};
2589   my $sheetattribs = $sheetdata->{sheetattribs};
2590   my $valueformats = $sheetdata->{valueformats};
2591
2592   my $datatypes = $sheetdata->{datatypes};
2593   my $dataformulas = $sheetdata->{formulas};
2594
2595   my $displayvalue = $value;
2596
2597   my $valuetype = $valuetypes->{$cr}; # get type of value to determine formatting
2598   my $valuesubtype = substr($valuetype,1);
2599   $valuetype = substr($valuetype,0,1);
2600
2601   if ($cellerrors->{$cr}) {
2602      $displayvalue = expand_markup($cellerrors->{$cr}, $sheetdata, $linkstyle) || $valuesubtype || "Error in cell";
2603      return $displayvalue;
2604      }
2605
2606   if ($valuetype eq "t") {
2607      $valueformat = $valueformats->[($cellattribs->{$cr}->{textvalueformat} || $sheetattribs->{defaulttextvalueformat})] || "";
2608      if ($valueformat eq "formula") {
2609         if ($datatypes->{$cr} eq "f") {
2610            $displayvalue = special_chars("=$dataformulas->{$cr}") || "&nbsp;";
2611            }
2612         elsif ($datatypes->{$cr} eq "c") {
2613            $displayvalue = special_chars("'$dataformulas->{$cr}") || "&nbsp;";
2614            }
2615         else {
2616            $displayvalue = special_chars("'$displayvalue") || "&nbsp;";
2617            }
2618         return $displayvalue;
2619         }
2620      $displayvalue = format_text_for_display($displayvalue, $valuetypes->{$cr}, $valueformat, $sheetdata, $linkstyle);
2621      }
2622
2623   elsif ($valuetype eq "n") {
2624      $valueformat = $cellattribs->{$cr}->{nontextvalueformat};
2625      if (length($valueformat) == 0) { # "0" is a legal value format
2626         $valueformat = $sheetattribs->{defaultnontextvalueformat};
2627         }
2628      $valueformat = $valueformats->[$valueformat];
2629      if (length($valueformat) == 0) {
2630         $valueformat = "";
2631         }
2632      $valueformat = "" if $valueformat eq "none";
2633      if ($valueformat eq "formula") {
2634         if ($datatypes->{$cr} eq "f") {
2635            $displayvalue = special_chars("=$dataformulas->{$cr}") || "&nbsp;";
2636            }
2637         elsif ($datatypes->{$cr} eq "c") {
2638            $displayvalue = special_chars("'$dataformulas->{$cr}") || "&nbsp;";
2639            }
2640         else {
2641            $displayvalue = special_chars("'$displayvalue") || "&nbsp;";
2642            }
2643         return $displayvalue;
2644         }
2645      elsif ($valueformat eq "forcetext") {
2646         if ($datatypes->{$cr} eq "f") {
2647            $displayvalue = special_chars("=$dataformulas->{$cr}") || "&nbsp;";
2648            }
2649         elsif ($datatypes->{$cr} eq "c") {
2650            $displayvalue = special_chars($dataformulas->{$cr}) || "&nbsp;";
2651            }
2652         else {
2653            $displayvalue = special_chars($displayvalue) || "&nbsp;";
2654            }
2655         return $displayvalue;
2656         }
2657      $displayvalue = format_number_for_display($displayvalue, $valuetypes->{$cr}, $valueformat);
2658      }
2659   else { # unknown type - probably blank
2660      $displayvalue = "&nbsp;";
2661      }
2662
2663   return $displayvalue;
2664
2665   }
2666
2667
2668# # # # # # # # #
2669#
2670# $displayvalue = format_text_for_display($rawvalue, $valuetype, $valueformat, $sheetdata, $linkstyle)
2671#
2672# # # # # # # # #
2673
2674sub format_text_for_display {
2675
2676   my ($rawvalue, $valuetype, $valueformat, $sheetdata, $linkstyle) = @_;
2677
2678   my $valuesubtype = substr($valuetype,1);
2679
2680   my $displayvalue = $rawvalue;
2681
2682   $valueformat = "" if $valueformat eq "none";
2683   $valueformat = "" unless $valueformat =~ m/^(text-|custom|hidden)/;
2684   if (!$valueformat || $valueformat eq "General") { # determine format from type
2685      $valueformat = "text-html" if ($valuesubtype eq "h");
2686      $valueformat = "text-wiki" if ($valuesubtype eq "w");
2687      $valueformat = "text-plain" unless $valuesubtype;
2688      }
2689   if ($valueformat eq "text-html") { # HTML - output as it as is
2690      ;
2691      }
2692   elsif ($valueformat eq "text-wiki") { # wiki text
2693#      $linkstyle = "http://127.0.0.1:6556/?editthispage=site1/[[pagename]]";
2694      $displayvalue = expand_markup($displayvalue, $sheetdata, $linkstyle); # do wiki markup
2695      }
2696   elsif ($valueformat eq "text-url") { # text is a URL for a link
2697      my $dvsc = special_chars($displayvalue);
2698      my $dvue = url_encode($displayvalue);
2699      $dvue =~ s/\Q{{amp}}/%26/g;
2700      $displayvalue = qq!<a href="$dvue">$dvsc</a>!;
2701      }
2702   elsif ($valueformat eq "text-link") { # text is a URL for a link shown as Link
2703      my $dvsc = special_chars($displayvalue);
2704      my $dvue = url_encode($displayvalue);
2705      $dvue =~ s/\Q{{amp}}/%26/g;
2706      $displayvalue = qq!<a href="$dvue">$WKCStrings{linkformatstring}</a>!;
2707      }
2708   elsif ($valueformat eq "text-image") { # text is a URL for an image
2709      my $dvue = url_encode($displayvalue);
2710      $dvue =~ s/\Q{{amp}}/%26/g;
2711      $displayvalue = qq!<img src="$dvue">!;
2712      }
2713   elsif ($valueformat =~ m/^text-custom\:/) { # construct a custom text format: @r = text raw, @s = special chars, @u = url encoded
2714      my $dvsc = special_chars($displayvalue); # do special chars
2715      $dvsc =~ s/  /&nbsp; /g; # keep multiple spaces
2716      $dvsc =~ s/\n/<br>/g;  # keep line breaks
2717      my $dvue = url_encode($displayvalue);
2718      $dvue =~ s/\Q{{amp}}/%26/g;
2719      my %textval;
2720      $textval{r} = $displayvalue;
2721      $textval{s} = $dvsc;
2722      $textval{u} = $dvue;
2723      $displayvalue = $valueformat;
2724      $displayvalue =~ s/^text-custom\://;
2725      $displayvalue =~ s/@(r|s|u)/$textval{$1}/ge;
2726      }
2727   elsif ($valueformat =~ m/^custom/) { # custom
2728      $displayvalue = special_chars($displayvalue); # do special chars
2729      $displayvalue =~ s/  /&nbsp; /g; # keep multiple spaces
2730      $displayvalue =~ s/\n/<br>/g;  # keep line breaks
2731      $displayvalue .= " (custom format)";
2732      }
2733   elsif ($valueformat eq "hidden") {
2734      $displayvalue = "&nbsp;";
2735      }
2736   else { # plain text
2737      $displayvalue = special_chars($displayvalue); # do special chars
2738      $displayvalue =~ s/  /&nbsp; /g; # keep multiple spaces
2739      $displayvalue =~ s/\n/<br>/g;  # keep line breaks
2740      }
2741
2742   return $displayvalue;
2743
2744   }
2745
2746
2747# # # # # # # # #
2748#
2749# $displayvalue = format_number_for_display($rawvalue, $valuetype, $valueformat)
2750#
2751# # # # # # # # #
2752
2753sub format_number_for_display {
2754
2755   my ($rawvalue, $valuetype, $valueformat) = @_;
2756
2757   my ($has_parens, $has_commas);
2758
2759   my $displayvalue = $rawvalue;
2760   my $valuesubtype = substr($valuetype,1);
2761
2762   if ($valueformat eq "Auto" || length($valueformat) == 0) { # cases with default format
2763      if ($valuesubtype eq "%") { # will display a % character
2764         $valueformat = "#,##0.0%";
2765         }
2766      elsif ($valuesubtype eq '$') {
2767         $valueformat = '[$]#,##0.00';
2768         }
2769      elsif ($valuesubtype eq 'dt') {
2770         $valueformat = $WKCStrings{"defaultformatdt"};
2771         }
2772      elsif ($valuesubtype eq 'd') {
2773         $valueformat = $WKCStrings{"defaultformatd"};
2774         }
2775      elsif ($valuesubtype eq 't') {
2776         $valueformat = $WKCStrings{"defaultformatt"};
2777         }
2778      elsif ($valuesubtype eq 'l') {
2779         $valueformat = 'logical';
2780         }
2781      else {
2782         $valueformat = "General";
2783         }
2784      }
2785
2786   if ($valueformat eq "logical") { # do logical format
2787      return $rawvalue ? $WKCStrings{"displaytrue"} : $WKCStrings{"displayfalse"};
2788      }
2789
2790   if ($valueformat eq "hidden") { # do hidden format
2791      return "&nbsp;";
2792      }
2793
2794   # Use format
2795
2796   return format_number_with_format_string($rawvalue, $valueformat);
2797
2798   }
2799
2800
2801# # # # # # # # #
2802#
2803# $result = format_number_with_format_string($value, $format_string, $currency_char)
2804#
2805# Use a format string to format a numeric value. Returns a string with the result.
2806# This is a subset of the normal styles accepted by many other spreadsheets, without fractions, E format, and @,
2807# and with any number of comparison fields and with [style=style-specification] (e.g., [style=color:red])
2808#
2809# # # # # # # # #
2810
2811   my %allowedcolors = (BLACK => "#000000", BLUE => "#0000FF", CYAN => "#00FFFF", GREEN => "#00FF00", MAGENTA => "#FF00FF",
2812                        RED => "#FF0000", WHITE => "#FFFFFF", YELLOW => "#FFFF00");
2813
2814   my %alloweddates = (H => "h]", M => "m]", MM => "mm]", "S" => "s]", "SS" => "ss]");
2815
2816   my %format_definitions;
2817   my $cmd_copy = 1;
2818   my $cmd_color = 2;
2819   my $cmd_integer_placeholder = 3;
2820   my $cmd_fraction_placeholder = 4;
2821   my $cmd_decimal = 5;
2822   my $cmd_currency = 6;
2823   my $cmd_general = 7;
2824   my $cmd_separator = 8;
2825   my $cmd_date = 9;
2826   my $cmd_comparison = 10;
2827   my $cmd_section = 11;
2828   my $cmd_style = 12;
2829
2830sub format_number_with_format_string {
2831
2832   my ($rawvalue, $format_string, $currency_char) = @_;
2833
2834   $currency_char ||= '$';
2835
2836   my ($op, $operandstr, $fromend, $cval, $operandstrlc);
2837   my ($yr, $mn, $dy, $hrs, $mins, $secs, $ehrs, $emins, $esecs, $ampmstr);
2838   my $result;
2839
2840   my $value = $rawvalue+0; # get a working copy that's numeric
2841
2842   my $negativevalue = $value < 0 ? 1 : 0; # determine sign, etc.
2843   $value = -$value if $negativevalue;
2844   my $zerovalue = $value == 0 ? 1 : 0;
2845
2846   parse_format_string(\%format_definitions, $format_string); # make sure format is parsed
2847   my $thisformat = $format_definitions{$format_string}; # Get format structure
2848
2849   return "Format error!" unless $thisformat;
2850
2851   my $section = (scalar @{$thisformat->{sectioninfo}}) - 1; # get number of sections - 1
2852
2853   if ($thisformat->{hascomparison}) { # has comparisons - determine which section
2854      $section = 0; # set to which section we will use
2855      my $gotcomparison = 0; # this section has no comparison
2856      for (my $cpos; ;$cpos++) { # scan for comparisons
2857         $op = $thisformat->{operators}->[$cpos];
2858         $operandstr = $thisformat->{operands}->[$cpos]; # get next operator and operand
2859         if (!$op) { # at end with no match
2860            if ($gotcomparison) { # if comparison but no match
2861               $format_string = "General"; # use default of General
2862               parse_format_string(\%format_definitions, $format_string);
2863               $thisformat = $format_definitions{$format_string};
2864               $section = 0;
2865               }
2866            last; # if no comparision, matchines on this section
2867            }
2868         if ($op == $cmd_section) { # end of section
2869            if (!$gotcomparison) { # no comparison, so it's a match
2870               last;
2871               }
2872            $gotcomparison = 0;
2873            $section++; # check out next one
2874            next;
2875            }
2876         if ($op == $cmd_comparison) { # found a comparison - do we meet it?
2877            my ($compop, $compval) = split(/:/, $operandstr, 2);
2878            $compval = 0+$compval;
2879            if (($compop eq "<" && $rawvalue < $compval) ||
2880                ($compop eq "<=" && $rawvalue <= $compval) ||
2881                ($compop eq "<>" && $rawvalue != $compval) ||
2882                ($compop eq ">=" && $rawvalue >= $compval) ||
2883                ($compop eq ">" && $rawvalue > $compval)) { # a match
2884               last;
2885               }
2886            $gotcomparison = 1;
2887            }
2888         }
2889      }
2890   elsif ($section > 0) { # more than one section (separated by ";")
2891      if ($section == 1) { # two sections
2892         if ($negativevalue) {
2893            $negativevalue = 0; # sign will provided by section, not automatically
2894            $section = 1; # use second section for negative values
2895            }
2896         else {
2897            $section = 0; # use first for all others
2898            }
2899         }
2900      elsif ($section == 2) { # three sections
2901         if ($negativevalue) {
2902            $negativevalue = 0; # sign will provided by section, not automatically
2903            $section = 1; # use second section for negative values
2904            }
2905         elsif ($zerovalue) {
2906            $section = 2; # use third section for zero values
2907            }
2908         else {
2909            $section = 0; # use first for positive
2910            }
2911         }
2912      }
2913
2914   # Get values for our section
2915   my ($sectionstart, $integerdigits, $fractiondigits, $commas, $percent, $thousandssep) =
2916      @{%{$thisformat->{sectioninfo}->[$section]}}{qw(sectionstart integerdigits fractiondigits commas percent thousandssep)};
2917
2918   if ($commas > 0) { # scale by thousands
2919      for (my $i=0; $i<$commas; $i++) {
2920         $value /= 1000;
2921         }
2922      }
2923   if ($percent > 0) { # do percent scaling
2924      for (my $i=0; $i<$percent; $i++) {
2925         $value *= 100;
2926         }
2927      }
2928
2929   my $decimalscale = 1; # cut down to required number of decimal digits
2930   for (my $i=0; $i<$fractiondigits; $i++) {
2931      $decimalscale *= 10;
2932      }
2933   my $scaledvalue = int($value * $decimalscale + 0.5);
2934   $scaledvalue = $scaledvalue / $decimalscale;
2935
2936   $negativevalue = 0 if ($scaledvalue == 0 && ($fractiondigits || $integerdigits)); # no "-0" unless using multiple sections or General
2937
2938   my $strvalue = "$scaledvalue"; # convert to string
2939   if ($strvalue =~ m/e/) { # converted to scientific notation
2940      return "$rawvalue"; # Just return plain converted raw value
2941      }
2942   $strvalue =~ m/^\+{0,1}(\d*)(?:\.(\d*)){0,1}$/; # get integer and fraction as character arrays
2943   my $integervalue = $1;
2944   $integervalue = "" if ($integervalue == 0);
2945   my @integervalue = split(//, $integervalue);
2946   my $fractionvalue = $2;
2947   $fractionvalue = "" if ($fractionvalue == 0);
2948   my @fractionvalue = split(//, $fractionvalue);
2949
2950   if ($thisformat->{sectioninfo}->[$section]->{hasdate}) { # there are date placeholders
2951      if ($rawvalue < 0) { # bad date
2952         return "??-???-??&nbsp;??:??:??";
2953         }
2954      my $startval = ($rawvalue-int($rawvalue)) * $seconds_in_a_day; # get date/time parts
2955      my $estartval = $rawvalue * $seconds_in_a_day; # do elapsed time version, too
2956      $hrs = int($startval / $seconds_in_an_hour);
2957      $ehrs = int($estartval / $seconds_in_an_hour);
2958      $startval = $startval - $hrs * $seconds_in_an_hour;
2959      $mins = int($startval / 60);
2960      $emins = int($estartval / 60);
2961      $secs = $startval - $mins * 60;
2962      $decimalscale = 1; # round appropriately depending if there is ss.0
2963      for (my $i=0; $i<$fractiondigits; $i++) {
2964         $decimalscale *= 10;
2965         }
2966      $secs = int($secs * $decimalscale + 0.5);
2967      $secs = $secs / $decimalscale;
2968      $esecs = int($estartval * $decimalscale + 0.5);
2969      $esecs = $esecs / $decimalscale;
2970      if ($secs >= 60) { # handle round up into next second, minute, etc.
2971         $secs = 0;
2972         $mins++; $emins++;
2973         if ($mins >= 60) {
2974            $mins = 0;
2975            $hrs++; $ehrs++;
2976            if ($hrs >= 24) {
2977               $hrs = 0;
2978               $rawvalue++;
2979               }
2980            }
2981         }
2982      @fractionvalue = split(//, $secs-int($secs)); # for "hh:mm:ss.00"
2983      shift @fractionvalue; shift @fractionvalue;
2984      ($yr, $mn, $dy) = convert_date_julian_to_gregorian(int($rawvalue+$julian_offset));
2985
2986      my $minOK; # says "m" can be minutes
2987      my $mspos = $sectionstart; # m scan position in ops
2988      for ( ; ; $mspos++) { # scan for "m" and "mm" to see if any minutes fields, and am/pm
2989         $op = $thisformat->{operators}->[$mspos];
2990         $operandstr = $thisformat->{operands}->[$mspos]; # get next operator and operand
2991         last unless $op; # don't go past end
2992         last if $op == $cmd_section;
2993         if ($op == $cmd_date) {
2994            if ((lc($operandstr) eq "am/pm" || lc($operandstr) eq "a/p") && !$ampmstr) {
2995               if ($hrs >= 12) {
2996                  $hrs -= 12;
2997                  $ampmstr = lc($operandstr) eq "a/p" ? "P" : "PM";
2998                  }
2999               else {
3000                  $ampmstr = lc($operandstr) eq "a/p" ? "A" : "AM";
3001                  }
3002               $ampmstr = lc $ampmstr if $operandstr !~ m/$ampmstr/;
3003               }
3004            if ($minOK && ($operandstr eq "m" || $operandstr eq "mm")) {
3005               $thisformat->{operands}->[$mspos] .= "in"; # turn into "min" or "mmin"
3006               }
3007            if (substr($operandstr,0,1) eq "h") {
3008               $minOK = 1; # m following h or hh or [h] is minutes not months
3009               }
3010            else {
3011               $minOK = 0;
3012               }
3013            }
3014         elsif ($op != $cmd_copy) { # copying chars can be between h and m
3015            $minOK = 0;
3016            }
3017         }
3018      $minOK = 0;
3019      for (--$mspos; ; $mspos--) { # scan other way for s after m
3020         $op = $thisformat->{operators}->[$mspos];
3021         $operandstr = $thisformat->{operands}->[$mspos]; # get next operator and operand
3022         last unless $op; # don't go past end
3023         last if $op == $cmd_section;
3024         if ($op == $cmd_date) {
3025            if ($minOK && ($operandstr eq "m" || $operandstr eq "mm")) {
3026               $thisformat->{operands}->[$mspos] .= "in"; # turn into "min" or "mmin"
3027               }
3028            if ($operandstr eq "ss") {
3029               $minOK = 1; # m before ss is minutes not months
3030               }
3031            else {
3032               $minOK = 0;
3033               }
3034            }
3035         elsif ($op != $cmd_copy) { # copying chars can be between ss and m
3036            $minOK = 0;
3037            }
3038         }
3039      }
3040
3041   my $integerdigits2 = 0; # init counters, etc.
3042   my $integerpos = 0;
3043   my $fractionpos = 0;
3044   my $textcolor = "";
3045   my $textstyle = "";
3046   my $separatorchar = $WKCStrings{"separatorchar"};
3047   $separatorchar =~ s/ /&nbsp;/g;
3048   my $decimalchar = $WKCStrings{"decimalchar"};
3049   $decimalchar =~ s/ /&nbsp;/g;
3050
3051   my $oppos = $sectionstart;
3052
3053   while ($op = $thisformat->{operators}->[$oppos]) { # execute format
3054      $operandstr = $thisformat->{operands}->[$oppos++]; # get next operator and operand
3055      if ($op == $cmd_copy) { # put char in result
3056         $result .= $operandstr;
3057         }
3058
3059      elsif ($op == $cmd_color) { # set color
3060         $textcolor = $operandstr;
3061         }
3062
3063      elsif ($op == $cmd_style) { # set style
3064         $textstyle = $operandstr;
3065         }
3066
3067      elsif ($op == $cmd_integer_placeholder) { # insert number part
3068         if ($negativevalue) {
3069            $result .= "-";
3070            $negativevalue = 0;
3071            }
3072         $integerdigits2++;
3073         if ($integerdigits2 == 1) { # first one
3074            if ((scalar @integervalue) > $integerdigits) { # see if integer wider than field
3075               for (;$integerpos < ((scalar @integervalue) - $integerdigits); $integerpos++) {
3076                  $result .= $integervalue[$integerpos];
3077                  if ($thousandssep) { # see if this is a separator position
3078                     $fromend = (scalar @integervalue) - $integerpos - 1;
3079                     if ($fromend > 2 && $fromend % 3 == 0) {
3080                        $result .= $separatorchar;
3081                        }
3082                     }
3083                  }
3084               }
3085            }
3086         if ((scalar @integervalue) < $integerdigits
3087             && $integerdigits2 <= $integerdigits - (scalar @integervalue)) { # field is wider than value
3088            if ($operandstr eq "0" || $operandstr eq "?") { # fill with appropriate characters
3089               $result .= $operandstr eq "0" ? "0" : "&nbsp;";
3090               if ($thousandssep) { # see if this is a separator position
3091                  $fromend = $integerdigits - $integerdigits2;
3092                  if ($fromend > 2 && $fromend % 3 == 0) {
3093                     $result .= $separatorchar;
3094                     }
3095                  }
3096               }
3097            }
3098         else { # normal integer digit - add it
3099            $result .= $integervalue[$integerpos];
3100            if ($thousandssep) { # see if this is a separator position
3101               $fromend = (scalar @integervalue) - $integerpos - 1;
3102               if ($fromend > 2 && $fromend % 3 == 0) {
3103                  $result .= $separatorchar;
3104                  }
3105               }
3106            $integerpos++;
3107            }
3108         }
3109      elsif ($op == $cmd_fraction_placeholder) { # add fraction part of number
3110         if ($fractionpos >= scalar @fractionvalue) {
3111            if ($operandstr eq "0" || $operandstr eq "?") {
3112               $result .= $operandstr eq "0" ? "0" : "&nbsp;";
3113               }
3114            }
3115         else {
3116            $result .= $fractionvalue[$fractionpos];
3117            }
3118         $fractionpos++;
3119         }
3120
3121      elsif ($op == $cmd_decimal) { # decimal point
3122         if ($negativevalue) {
3123            $result .= "-";
3124            $negativevalue = 0;
3125            }
3126         $result .= $decimalchar;
3127         }
3128
3129      elsif ($op == $cmd_currency) { # currency symbol
3130         if ($negativevalue) {
3131            $result .= "-";
3132            $negativevalue = 0;
3133            }
3134         $result .= $operandstr;
3135         }
3136
3137      elsif ($op == $cmd_general) { # insert "General" conversion
3138         my $gvalue = $rawvalue+0; # make sure it's numeric
3139         if ($negativevalue) {
3140            $result .= "-";
3141            $negativevalue = 0;
3142            $gvalue = -$gvalue;
3143            }
3144         $strvalue = "$gvalue"; # convert original value to string
3145         if ($strvalue =~ m/e/) { # converted to scientific notation
3146            $result .= "$strvalue";
3147            next;
3148            }
3149         $strvalue =~ m/^\+{0,1}(\d*)(?:\.(\d*)){0,1}$/;
3150         $integervalue = $1;
3151         $integervalue = "" if ($integervalue == 0);
3152         @integervalue = split(//, $integervalue);
3153         $fractionvalue = $2;
3154         $fractionvalue = "" if ($fractionvalue == 0);
3155         @fractionvalue = split(//, $fractionvalue);
3156         $integerpos = 0;
3157         $fractionpos = 0;
3158         if (scalar @integervalue) {
3159            for (;$integerpos < scalar @integervalue; $integerpos++) {
3160               $result .= $integervalue[$integerpos];
3161               if ($thousandssep) { # see if this is a separator position
3162                  $fromend = (scalar @integervalue) - $integerpos - 1;
3163                  if ($fromend > 2 && $fromend % 3 == 0) {
3164                     $result .= $separatorchar;
3165                     }
3166                  }
3167               }
3168             }
3169         else {
3170            $result .= "0";
3171            }
3172         if (scalar @fractionvalue) {
3173            $result .= $decimalchar;
3174            for (;$fractionpos < scalar @fractionvalue; $fractionpos++) {
3175               $result .= $fractionvalue[$fractionpos];
3176               }
3177            }
3178         }
3179
3180      elsif ($op == $cmd_date) { # date placeholder
3181         $operandstrlc = lc $operandstr;
3182         if ($operandstrlc eq "y" || $operandstrlc eq "yy") {
3183            $result .= substr("$yr",-2);
3184            }
3185         elsif ($operandstrlc eq "yyyy") {
3186            $result .= "$yr";
3187            }
3188         elsif ($operandstrlc eq "d") {
3189            $result .= "$dy";
3190            }
3191         elsif ($operandstrlc eq "dd") {
3192            $cval = 1000 + $dy;
3193            $result .= substr("$cval", -2);
3194            }
3195         elsif ($operandstrlc eq "ddd") {
3196            $cval = int($rawvalue+6) % 7;
3197            $result .= (split(/ /, $WKCStrings{"daynames3"}))[$cval];
3198            }
3199         elsif ($operandstrlc eq "dddd") {
3200            $cval = int($rawvalue+6) % 7;
3201            $result .= (split(/ /, $WKCStrings{"daynames"}))[$cval];
3202            }
3203         elsif ($operandstrlc eq "m") {
3204            $result .= "$mn";
3205            }
3206         elsif ($operandstrlc eq "mm") {
3207            $cval = 1000 + $mn;
3208            $result .= substr("$cval", -2);
3209            }
3210         elsif ($operandstrlc eq "mmm") {
3211            $result .= (split(/ /, $WKCStrings{"monthnames3"}))[$mn-1];
3212            }
3213         elsif ($operandstrlc eq "mmmm") {
3214            $result .= (split(/ /, $WKCStrings{"monthnames"}))[$mn-1];
3215            }
3216         elsif ($operandstrlc eq "mmmmm") {
3217            $result .= substr((split(/ /, $WKCStrings{"monthnames"}))[$mn-1], 0, 1);
3218            }
3219         elsif ($operandstrlc eq "h") {
3220            $result .= "$hrs";
3221            }
3222         elsif ($operandstrlc eq "h]") {
3223            $result .= "$ehrs";
3224            }
3225         elsif ($operandstrlc eq "mmin") {
3226            $cval = 1000 + $mins;
3227            $result .= substr("$cval", -2);
3228            }
3229         elsif ($operandstrlc eq "mm]") {
3230            if ($emins < 100) {
3231               $cval = 1000 + $emins;
3232               $result .= substr("$cval", -2);
3233               }
3234            else {
3235               $result .= "$emins";
3236               }
3237            }
3238         elsif ($operandstrlc eq "min") {
3239            $result .= "$mins";
3240            }
3241         elsif ($operandstrlc eq "m]") {
3242            $result .= "$emins";
3243            }
3244         elsif ($operandstrlc eq "hh") {
3245            $cval = 1000 + $hrs;
3246            $result .= substr("$cval", -2);
3247            }
3248         elsif ($operandstrlc eq "s") {
3249            $cval = int($secs);
3250            $result .= "$cval";
3251            }
3252         elsif ($operandstrlc eq "ss") {
3253            $cval = 1000 + int($secs);
3254            $result .= substr("$cval", -2);
3255            }
3256         elsif ($operandstrlc eq "am/pm" || $operandstrlc eq "a/p") {
3257            $result .= $ampmstr;
3258            }
3259         elsif ($operandstrlc eq "ss]") {
3260            if ($esecs < 100) {
3261               $cval = 1000 + int($esecs);
3262               $result .= substr("$cval", -2);
3263               }
3264            else {
3265               $cval = int($esecs);
3266               $result = "$cval";
3267               }
3268            }
3269         }
3270
3271      elsif ($op == $cmd_section) { # end of section
3272         last;
3273         }
3274
3275      elsif ($op == $cmd_comparison) { # ignore
3276         next;
3277         }
3278
3279      else {
3280         $result .= "!! Parse error !!";
3281         }
3282      }
3283
3284   if ($textcolor) {
3285      $result = qq!<span style="color:$textcolor;">$result</span>!;
3286      }
3287   if ($textstyle) {
3288      $result = qq!<span style="$textstyle;">$result</span>!;
3289      }
3290
3291   return $result;
3292}
3293
3294# # # # # # # # #
3295#
3296# parse_format_string(\%format_defs, $format_string)
3297#
3298# Takes a format string (e.g., "#,##0.00_);(#,##0.00)") and fills in %foramt_defs with the parsed info
3299#
3300# %format_defs
3301#    {"#,##0.0"}->{} # elements in the hash are one hash for each format
3302#       {operators}->[] # array of operators from parsing the format string (each a number)
3303#       {operands}->[] # array of corresponding operators (each usually a string)
3304#       {sectioninfo}->[] # one hash for each section of the format
3305#          {start}
3306#          {integerdigits}
3307#          {fractiondigits}
3308#          {commas}
3309#          {percent}
3310#          {thousandssep}
3311#          {hasdates}
3312#       {hascomparison} # true if any section has [<100], etc.
3313#
3314# # # # # # # # #
3315
3316sub parse_format_string {
3317
3318   my ($format_defs, $format_string) = @_;
3319
3320   return if ($format_defs->{$format_string}); # already defined - nothing to do
3321
3322   my $thisformat = {operators => [], operands => [], sectioninfo => [{}]}; # create info structure for this format
3323   $format_defs->{$format_string} = $thisformat; # add to other format definitions
3324
3325   my $section = 0; # start with section 0
3326   my $sectioninfo = $thisformat->{sectioninfo}->[$section]; # get reference to info for current section
3327   $sectioninfo->{sectionstart} = 0; # position in operands that starts this section
3328
3329   my @formatchars = split //, $format_string; # break into individual characters
3330
3331   my $integerpart = 1; # start out in integer part
3332   my $lastwasinteger; # last char was an integer placeholder
3333   my $lastwasslash; # last char was a backslash - escaping following character
3334   my $lastwasasterisk; # repeat next char
3335   my $lastwasunderscore; # last char was _ which picks up following char for width
3336   my ($inquote, $quotestr); # processing a quoted string
3337   my ($inbracket, $bracketstr, $cmd); # processing a bracketed string
3338   my ($ingeneral, $gpos); # checks for characters "General"
3339   my $ampmstr; # checks for characters "A/P" and "AM/PM"
3340   my $indate; # keeps track of date/time placeholders
3341
3342   foreach my $ch (@formatchars) { # parse
3343      if ($inquote) {
3344         if ($ch eq '"') {
3345            $inquote = 0;
3346            push @{$thisformat->{operators}}, $cmd_copy;
3347            push @{$thisformat->{operands}}, $quotestr;
3348            next;
3349            }
3350         $quotestr .= $ch;
3351         next;
3352         }
3353      if ($inbracket) {
3354         if ($ch eq ']') {
3355            $inbracket = 0;
3356            ($cmd, $bracketstr) = parse_format_bracket($bracketstr);
3357            if ($cmd == $cmd_separator) {
3358               $sectioninfo->{thousandssep} = 1; # explicit [,]
3359               next;
3360               }
3361            if ($cmd == $cmd_date) {
3362               $sectioninfo->{hasdate} = 1;
3363               }
3364            if ($cmd == $cmd_comparison) {
3365               $thisformat->{hascomparison} = 1;
3366               }
3367            push @{$thisformat->{operators}}, $cmd;
3368            push @{$thisformat->{operands}}, $bracketstr;
3369            next;
3370            }
3371         $bracketstr .= $ch;
3372         next;
3373         }
3374      if ($lastwasslash) {
3375         push @{$thisformat->{operators}}, $cmd_copy;
3376         push @{$thisformat->{operands}}, $ch;
3377         $lastwasslash = 0;
3378         next;
3379         }
3380      if ($lastwasasterisk) {
3381         push @{$thisformat->{operators}}, $cmd_copy;
3382         push @{$thisformat->{operands}}, $ch x 5;
3383         $lastwasasterisk = 0;
3384         next;
3385         }
3386      if ($lastwasunderscore) {
3387         push @{$thisformat->{operators}}, $cmd_copy;
3388         push @{$thisformat->{operands}}, "&nbsp;";
3389         $lastwasunderscore = 0;
3390         next;
3391         }
3392      if ($ingeneral) {
3393         if (substr("general", $ingeneral, 1) eq lc $ch) {
3394            $ingeneral++;
3395            if ($ingeneral == 7) {
3396               push @{$thisformat->{operators}}, $cmd_general;
3397               push @{$thisformat->{operands}}, $ch;
3398               $ingeneral = 0;
3399               }
3400            next;
3401            }
3402         $ingeneral = 0;
3403         }
3404      if ($indate) { # last char was part of a date placeholder
3405         if (substr($indate,0,1) eq $ch) { # another of the same char
3406            $indate .= $ch; # accumulate it
3407            next;
3408            }
3409         push @{$thisformat->{operators}}, $cmd_date; # something else, save date info
3410         push @{$thisformat->{operands}}, $indate;
3411         $sectioninfo->{hasdate} = 1;
3412         $indate = "";
3413         }
3414      if ($ampmstr) {
3415         $ampmstr .= $ch;
3416         if ("am/pm" =~ m/^$ampmstr/i || "a/p" =~ m/^$ampmstr/i) {
3417            if (("am/pm" eq lc $ampmstr) || ("a/p" eq lc $ampmstr)) {
3418               push @{$thisformat->{operators}}, $cmd_date;
3419               push @{$thisformat->{operands}}, $ampmstr;
3420               $ampmstr = "";
3421               }
3422            next;
3423            }
3424         $ampmstr = "";
3425         }
3426      if ($ch eq "#" || $ch eq "0" || $ch eq "?") { # placeholder
3427         if ($integerpart) {
3428            $sectioninfo->{integerdigits}++;
3429            if ($sectioninfo->{commas}) { # comma inside of integer placeholders
3430               $sectioninfo->{thousandssep} = 1; # any number is thousands separator
3431               $sectioninfo->{commas} = 0; # reset count of "thousand" factors
3432               }
3433            $lastwasinteger = 1;
3434            push @{$thisformat->{operators}}, $cmd_integer_placeholder;
3435            push @{$thisformat->{operands}}, $ch;
3436            }
3437         else {
3438            $sectioninfo->{fractiondigits}++;
3439            push @{$thisformat->{operators}}, $cmd_fraction_placeholder;
3440            push @{$thisformat->{operands}}, $ch;
3441            }
3442         }
3443      elsif ($ch eq ".") { # decimal point
3444         $lastwasinteger = 0;
3445         push @{$thisformat->{operators}}, $cmd_decimal;
3446         push @{$thisformat->{operands}}, $ch;
3447         $integerpart = 0;
3448         }
3449      elsif ($ch eq '$') { # currency char
3450         $lastwasinteger = 0;
3451         push @{$thisformat->{operators}}, $cmd_currency;
3452         push @{$thisformat->{operands}}, $ch;
3453         }
3454      elsif ($ch eq ",") {
3455         if ($lastwasinteger) {
3456            $sectioninfo->{commas}++;
3457            }
3458         else {
3459            push @{$thisformat->{operators}}, $cmd_copy;
3460            push @{$thisformat->{operands}}, $ch;
3461            }
3462         }
3463      elsif ($ch eq "%") {
3464         $lastwasinteger = 0;
3465         $sectioninfo->{percent}++;
3466         push @{$thisformat->{operators}}, $cmd_copy;
3467         push @{$thisformat->{operands}}, $ch;
3468         }
3469      elsif ($ch eq '"') {
3470         $lastwasinteger = 0;
3471         $inquote = 1;
3472         $quotestr = "";
3473         }
3474      elsif ($ch eq '[') {
3475         $lastwasinteger = 0;
3476         $inbracket = 1;
3477         $bracketstr = "";
3478         }
3479      elsif ($ch eq '\\') {
3480         $lastwasslash = 1;
3481         $lastwasinteger = 0;
3482         }
3483      elsif ($ch eq '*') {
3484         $lastwasasterisk = 1;
3485         $lastwasinteger = 0;
3486         }
3487      elsif ($ch eq '_') {
3488         $lastwasunderscore = 1;
3489         $lastwasinteger = 0;
3490         }
3491      elsif ($ch eq ";") {
3492         $section++; # start next section
3493         $thisformat->{sectioninfo}->[$section] = {}; # create a new section
3494         $sectioninfo = $thisformat->{sectioninfo}->[$section]; # set to point to the new section
3495         $sectioninfo->{sectionstart} = 1 + scalar @{$thisformat->{operators}}; # remember where it starts
3496         $integerpart = 1; # reset for new section
3497         $lastwasinteger = 0;
3498         push @{$thisformat->{operators}}, $cmd_section;
3499         push @{$thisformat->{operands}}, $ch;
3500         }
3501      elsif ((lc $ch) eq "g") {
3502         $ingeneral = 1;
3503         $lastwasinteger = 0;
3504         }
3505      elsif ((lc $ch) eq "a") {
3506         $ampmstr = $ch;
3507         $lastwasinteger = 0;
3508         }
3509      elsif ($ch =~ m/[dmyhHs]/) {
3510         $indate = $ch;
3511         }
3512      else {
3513         $lastwasinteger = 0;
3514         push @{$thisformat->{operators}}, $cmd_copy;
3515         push @{$thisformat->{operands}}, $ch;
3516         }
3517      }
3518
3519   if ($indate) { # last char was part of unsaved date placeholder
3520      push @{$thisformat->{operators}}, $cmd_date; # save what we got
3521      push @{$thisformat->{operands}}, $indate;
3522      $sectioninfo->{hasdate} = 1;
3523      }
3524
3525   return;
3526
3527   }
3528
3529
3530# # # # # # # # #
3531#
3532# ($operator, $operand) = parse_format_bracket($bracketstr)
3533#
3534# # # # # # # # #
3535
3536sub parse_format_bracket {
3537
3538   my $bracketstr = shift @_;
3539
3540   my ($operator, $operand);
3541
3542   if (substr($bracketstr, 0, 1) eq '$') { # currency
3543      $operator = $cmd_currency;
3544      if ($bracketstr =~ m/^\$(.+?)(\-.+?){0,1}$/) {
3545         $operand = $1 || $WKCStrings{"currencychar"} || '$';
3546         }
3547      else {
3548         $operand = substr($bracketstr,1) || $WKCStrings{"currencychar"} || '$';
3549         }
3550      }
3551   elsif ($bracketstr eq '?$') {
3552      $operator = $cmd_currency;
3553      $operand = '[?$]';
3554      }
3555   elsif ($allowedcolors{uc $bracketstr}) {
3556      $operator = $cmd_color;
3557      $operand = $allowedcolors{uc $bracketstr};
3558      }
3559   elsif ($bracketstr =~ m/^style=([^"]*)$/) { # [style=...]
3560      $operator = $cmd_style;
3561      $operand = $1;
3562      }
3563   elsif ($bracketstr eq ",") {
3564      $operator = $cmd_separator;
3565      $operand = $bracketstr;
3566      }
3567   elsif ($alloweddates{uc $bracketstr}) {
3568      $operator = $cmd_date;
3569      $operand = $alloweddates{uc $bracketstr};
3570      }
3571   elsif ($bracketstr =~ m/^[<>=]/) { # comparison operator
3572      $bracketstr =~ m/^([<>=]+)(.+)$/; # split operator and value
3573      $operator = $cmd_comparison;
3574      $operand = "$1:$2";
3575      }
3576   else { # unknown bracket
3577      $operator = $cmd_copy;
3578      $operand = "[$bracketstr]";
3579      }
3580
3581   return ($operator, $operand);
3582
3583   }
3584
3585# # # # # # # # #
3586#
3587# $juliandate = convert_date_gregorian_to_julian($year, $month, $day)
3588#
3589# From: http://aa.usno.navy.mil/faq/docs/JD_Formula.html
3590# Uses: Fliegel, H. F. and van Flandern, T. C. (1968). Communications of the ACM, Vol. 11, No. 10 (October, 1968).
3591# Translated from the FORTRAN
3592#
3593#      I= YEAR
3594#      J= MONTH
3595#      K= DAY
3596#C
3597#      JD= K-32075+1461*(I+4800+(J-14)/12)/4+367*(J-2-(J-14)/12*12)
3598#     2    /12-3*((I+4900+(J-14)/12)/100)/4
3599#
3600# # # # # # # # #
3601
3602sub convert_date_gregorian_to_julian {
3603
3604   my ($year, $month, $day) = @_;
3605
3606   my $juliandate= $day-32075+int(1461*($year+4800+int(($month-14)/12))/4);
3607   $juliandate += int(367*($month-2-int(($month-14)/12)*12)/12);
3608   $juliandate = $juliandate -int(3*int(($year+4900+int(($month-14)/12))/100)/4);
3609
3610   return $juliandate;
3611
3612}
3613
3614
3615# # # # # # # # #
3616#
3617# ($year, $month, $day) = convert_date_julian_to_gregorian($juliandate)
3618#
3619# From: http://aa.usno.navy.mil/faq/docs/JD_Formula.html
3620# Uses: Fliegel, H. F. and van Flandern, T. C. (1968). Communications of the ACM, Vol. 11, No. 10 (October, 1968).
3621# Translated from the FORTRAN
3622#
3623# # # # # # # # #
3624
3625sub convert_date_julian_to_gregorian {
3626
3627   my $juliandate = shift @_;
3628
3629   my ($L, $N, $I, $J, $K);
3630
3631   $L = $juliandate+68569;
3632   $N = int(4*$L/146097);
3633   $L = $L-int((146097*$N+3)/4);
3634   $I = int(4000*($L+1)/1461001);
3635   $L = $L-int(1461*$I/4)+31;
3636   $J = int(80*$L/2447);
3637   $K = $L-int(2447*$J/80);
3638   $L = int($J/11);
3639   $J = $J+2-12*$L;
3640   $I = 100*($N-49)+$I+$L;
3641
3642   return ($I, $J, $K);
3643
3644}
3645
3646
3647# # # # # # # # #
3648#
3649# $value = determine_value_type($rawvalue, \$type)
3650#
3651# Takes a value and looks for special formatting like $, %, numbers, etc.
3652# Returns the value as a number or string and the type.
3653# Tries to follow the spec for spreadsheet function VALUE(v).
3654#
3655# # # # # # # # #
3656
3657sub determine_value_type {
3658
3659   my ($rawvalue, $type) = @_;
3660
3661   my $value = $rawvalue;
3662
3663   $$type = "t";
3664
3665   my $fch = substr($value, 0, 1);
3666   my $tvalue = $value;
3667   $tvalue =~ s/^\s+//; # value with leading and trailing spaces removed
3668   $tvalue =~ s/\s+$//;
3669
3670   if (length $value == 0) {
3671      $$type = "";
3672      }
3673   elsif ($value =~ m/^\s+$/) { # just blanks
3674      ; # leave as is with type "t"
3675      }
3676   elsif ($tvalue =~ m/^[-+]?\d*(?:\.)?\d*(?:[eE][-+]?\d+)?$/) { # general number, including E
3677      $value = $tvalue + 0;
3678      $$type = "n";
3679      }
3680   elsif ($tvalue =~ m/^[-+]?\d*(?:\.)?\d*\s*%$/) { # 15.1%
3681      $value = substr($tvalue,0,-1) / 100;
3682      $$type = "n%";
3683      }
3684   elsif ($tvalue =~ m/^[-+]?\$\s*\d*(?:\.)?\d*\s*$/ && $tvalue =~ m/\d/) { # $1.49
3685      $tvalue =~ s/\$//;
3686      $value = $tvalue;
3687      $$type = 'n$';
3688      }
3689   elsif ($tvalue =~ m/^[-+]?(\d*,\d*)+(?:\.)?\d*$/) { # 1,234.49
3690      $tvalue =~ s/,//g;
3691      $value = $tvalue;
3692      $$type = 'n';
3693      }
3694   elsif ($tvalue =~ m/^[-+]?(\d*,\d*)+(?:\.)?\d*\s*%$/) { # 1,234.49%
3695      $tvalue =~ s/,//g;
3696      $value = substr($tvalue,0,-1) / 100;
3697      $$type = 'n%';
3698      }
3699   elsif ($tvalue =~ m/^[-+]?\$\s*(\d*,\d*)+(?:\.)?\d*$/ && $tvalue =~ m/\d/) { # $1,234.49
3700      $tvalue =~ s/,//g;
3701      $tvalue =~ s/\$//;
3702      $value = $tvalue;
3703      $$type = 'n$';
3704      }
3705   elsif ($value =~ m/^(\d{1,2})[\/\-](\d{1,2})[\/\-](\d{1,4})\s*$/) { # MM/DD/YYYY, MM/DD/YYYY
3706      my $year = $3 < 1000 ? $3 + 2000 : $3;
3707      $value = convert_date_gregorian_to_julian($year, $1, $2)-2415019;
3708      $$type = 'nd';
3709      }
3710   elsif ($value =~ m/^(\d{4})[\/\-](\d{1,2})[\/\-](\d{1,2})\s*$/) { # YYYY-MM-DD, YYYY/MM/DD
3711      my $year = $1 < 1000 ? $1 + 2000 : $1;
3712      $value = convert_date_gregorian_to_julian($year, $2, $3)-2415019;
3713      $$type = 'nd';
3714      }
3715   elsif ($value =~ m/^(\d{1,2}):(\d{1,2})\s*$/) { # HH:MM
3716      my $hour = $1;
3717      my $minute = $2;
3718      if ($hour < 24 && $minute < 60) {
3719         $value = $hour/24 + $minute/(24*60);
3720         $$type = 'nt';
3721         }
3722      }
3723   elsif ($value =~ m/^(\d{1,2}):(\d{1,2}):(\d{1,2})\s*$/) { # HH:MM:SS
3724      my $hour = $1;
3725      my $minute = $2;
3726      my $second = $3;
3727      if ($hour < 24 && $minute < 60 && $second < 60) {
3728         $value = $hour/24 + $minute/(24*60) + $second/(24*60*60);
3729         $$type = 'nt';
3730         }
3731      }
3732   elsif ($value =~ m/^\s*([-+]?\d+) (\d+)\/(\d+)\s*$/) { # 1 1/2
3733      my $int = $1;
3734      my $num = $2;
3735      my $denom = $3;
3736      if ($denom > 0) {
3737         $value = $int + $num/$denom;
3738         $$type = 'n';
3739         }
3740      }
3741   elsif ($input_constants{uc($value)}) {
3742      ($value, $$type) = split(/,/, $input_constants{uc($value)});
3743      }
3744
3745   return $value;
3746
3747   }
3748
3749
3750# # # # # # # # #
3751#
3752# ($lastcol, $lastrow) = render_values_only(\%sheetdata, \%celldata, $linkstyle)
3753#
3754# Routine to create a structure of cell-by-cell display values, etc., for AJAX-style updating
3755#
3756# The format of celldata:
3757#
3758# $celldata{coord}
3759#    {type} - v, t, f, c (value, text, formula, constant) or e (empty)
3760#    {display} - display value, as HTML
3761#    {align} - left, right, center
3762#    {colspan} - 1 or more
3763#    {rowspan} - 1 or more
3764#    {skip} - coord of cell to go to when you navigate to this one (null means this one)
3765#
3766# # # # # # # # #
3767
3768sub render_values_only {
3769
3770   my ($sheetdata, $celldata, $linkstyle) = @_;
3771
3772   # Get references to the parts
3773
3774   my $datavalues = $sheetdata->{datavalues};
3775   my $datatypes = $sheetdata->{datatypes};
3776   my $valuetypes = $sheetdata->{valuetypes};
3777   my $dataformulas = $sheetdata->{formulas};
3778   my $cellerrors = $sheetdata->{cellerrors};
3779   my $cellattribs = $sheetdata->{cellattribs};
3780   my $colattribs = $sheetdata->{colattribs};
3781   my $rowattribs = $sheetdata->{rowattribs};
3782   my $sheetattribs = $sheetdata->{sheetattribs};
3783   my $cellformats = $sheetdata->{cellformats};
3784   my $cellformathash = $sheetdata->{cellformathash};
3785   my $valueformats = $sheetdata->{valueformats};
3786   my $valueformathash = $sheetdata->{valueformathash};
3787
3788   my ($colspan, $rowspan, $coord, $cellattribscoord, $type, $style, $displayvalue, $valueformat, $align, $valuetype);
3789   my %cellskip;
3790
3791   my ($maxcol, $maxrow);
3792
3793   my $lastcol = $sheetattribs->{lastcol};
3794   my $lastrow = $sheetattribs->{lastrow};
3795
3796   for (my $row = 1; $row <= $lastrow; $row++) { # if span, set to skip other cells in column/row
3797      for (my $col = 1; $col <= $lastcol; $col++) {
3798         $coord = cr_to_coord($col, $row);
3799         next if $cellskip{$coord};
3800         $colspan = $cellattribs->{$coord}->{colspan} || 1;
3801         $rowspan = $cellattribs->{$coord}->{rowspan} || 1;
3802         for (my $srow=$row; $srow<$row+$rowspan; $srow++) {
3803            for (my $scol=$col; $scol<$col+$colspan; $scol++) {
3804               my $scoord = cr_to_coord($scol, $srow);
3805               $cellskip{$scoord} = $coord unless $scoord eq $coord;
3806               $maxcol = $scol if $scol > $maxcol;
3807               $maxrow = $srow if $srow > $maxrow;
3808               }
3809            }
3810         }
3811      }
3812
3813   $lastrow = $maxrow+10; # Add the extra rows shown
3814
3815   for (my $row = 1; $row <= $lastrow; $row++) {
3816      for (my $col = 1; $col <= $lastcol; $col++) {
3817
3818         $coord = cr_to_coord($col, $row);
3819
3820         my $cellspecific = ($celldata->{$coord} = {});
3821
3822         if ($cellskip{$coord}) { # treat specially if within a span
3823            $cellspecific->{skip} = $cellskip{$coord};
3824            next;
3825            }
3826         $cellattribscoord = $cellattribs->{$coord};
3827
3828         $type = $datatypes->{$coord} || "e";
3829
3830         $displayvalue = $datavalues->{$coord};
3831         $displayvalue = format_value_for_display($sheetdata, $displayvalue, $coord, $linkstyle);
3832
3833         $align = "left";
3834         $style = $cellattribscoord->{cellformat};
3835         $valuetype = substr($valuetypes->{$coord},0,1); # get general type
3836         if ($style) {
3837            $align = $cellformats->[$style];
3838            }
3839         elsif ($valuetype eq "t") {
3840            $style = $sheetattribs->{defaulttextformat};
3841            if ($style) {
3842               $align = $cellformats->[$style];
3843               }
3844            }
3845         else {
3846            $style = $sheetattribs->{defaultnontextformat};
3847            if ($style) {
3848               $align = $cellformats->[$style];
3849               }
3850            else {
3851               $align = "right";
3852               }
3853            }
3854
3855         $colspan = $cellattribs->{$coord}->{colspan} || 1;
3856         $rowspan = $cellattribs->{$coord}->{rowspan} || 1;
3857
3858         $cellspecific->{type} = $type;
3859         $cellspecific->{display} = $displayvalue;
3860         $cellspecific->{align} = $align;
3861         $cellspecific->{colspan} = $colspan;
3862         $cellspecific->{rowspan} = $rowspan;
3863         }
3864      }
3865
3866   return ($lastcol, $lastrow);
3867
3868 };
3869
3870
3871# # # # # # # # #
3872#
3873# $error = recalc_sheet(\%sheetdata)
3874#
3875# Recalculates the entire spreadsheet
3876#
3877# # # # # # # # #
3878
3879sub recalc_sheet {
3880
3881   my $sheetdata = shift @_;
3882
3883   my $dataformulas = $sheetdata->{formulas};
3884
3885   $sheetdata->{checked} = {};
3886   delete $sheetdata->{sheetattribs}->{circularreferencecell};
3887
3888   foreach my $coord (keys %$dataformulas) {
3889      next unless $coord;
3890      my $err = check_and_calc_cell($sheetdata, $coord);
3891      }
3892
3893   delete $sheetdata->{sheetattribs}->{needsrecalc}; # remember recalc done
3894   }
3895
3896
3897# # # # # # # # #
3898#
3899# $circref = check_and_calc_cell(\%sheetdata, $coord)
3900#
3901# Recalculates one cell after making sure dependencies are calc'ed, too
3902# If circular reference, returns non-null.
3903#
3904# # # # # # # # #
3905
3906sub check_and_calc_cell {
3907
3908   my ($sheetdata, $coord) = @_;
3909
3910   my $datavalues = $sheetdata->{datavalues};
3911   my $datatypes = $sheetdata->{datatypes};
3912   my $valuetypes = $sheetdata->{valuetypes};
3913   my $dataformulas = $sheetdata->{formulas};
3914   my $cellerrors = $sheetdata->{cellerrors};
3915   my $coordchecked = $sheetdata->{checked};
3916
3917   if ($datatypes->{$coord} ne 'f') {
3918      return "";
3919      }
3920   if ($coordchecked->{$coord} == 2) { # Already calculated this time
3921      return "";
3922      }
3923   elsif ($coordchecked->{$coord} == 1) { # Circular reference
3924      $cellerrors->{$coord} = "Circular reference to $coord";
3925      return $cellerrors->{$coord};
3926      }
3927
3928   my $line = $dataformulas->{$coord};
3929   my $parseinfo = parse_formula_into_tokens($line);
3930
3931   my $parsed_token_text = $parseinfo->{tokentext};
3932   my $parsed_token_type = $parseinfo->{tokentype};
3933   my ($ttype, $ttext, $sheetref);
3934   $coordchecked->{$coord} = 1; # Remember we are in progress
3935   for (my $i=0; $i<@$parsed_token_text; $i++) {
3936      $ttype = $parsed_token_type->[$i];
3937      $ttext = $parsed_token_text->[$i];
3938      if ($ttype == $token_op) { # references with sheet specifier are not recursed into
3939         if ($ttext eq "!") {
3940            $sheetref = 1; # found a sheet reference
3941            }
3942         elsif ($ttext ne ":") { # for everything but a range, reset
3943            $sheetref = 0;
3944            }
3945         }
3946      if ($ttype == $token_coord) {
3947# Sheetnames may be references!
3948#        if (($i < scalar @$parsed_token_text-1)
3949#             && $parsed_token_type->[$i+1] == $token_op && $parsed_token_text->[$i+1] eq "!") {
3950#            $sheetref = 1; # This is a sheetname that looks like a coord
3951#            }
3952         if ($i >= 2
3953             && $parsed_token_type->[$i-1] == $token_op && $parsed_token_text->[$i-1] eq ':'
3954             && $parsed_token_type->[$i-2] == $token_coord
3955             && !$sheetref) { # Range -- check each cell
3956
3957#!!!! Add stuff for named ranges eventually!!!
3958
3959            my ($c1, $r1) = coord_to_cr($parsed_token_text->[$i-2]);
3960            my ($c2, $r2) = coord_to_cr($ttext);
3961            ($c2, $c1) = ($c1, $c2) if ($c1 > $c2);
3962            ($r2, $r1) = ($r1, $r2) if ($r1 > $r2);
3963            for (my $r=$r1;$r<=$r2;$r++) { # Checks first cell a second time, but that should just return
3964               for (my $c=$c1;$c<=$c2;$c++) {
3965                  my $rangecoord = cr_to_coord($c, $r);
3966                  my $circref = check_and_calc_cell($sheetdata, $rangecoord);
3967                  $sheetdata->{sheetattribs}->{circularreferencecell} = "$coord|$rangecoord" if $circref;
3968                  }
3969               }
3970            }
3971         elsif (!$sheetref) { # Single cell reference
3972            $ttext =~ s/\$//g;
3973            my $circref = check_and_calc_cell($sheetdata, $ttext);
3974            $sheetdata->{sheetattribs}->{circularreferencecell} = "$coord|$ttext" if $circref; # remember at least one circ ref
3975            }
3976         }
3977      }
3978   my ($value, $valuetype, $errortext) = evaluate_parsed_formula($parseinfo, $sheetdata);
3979   $datavalues->{$coord} = $value;
3980   $valuetypes->{$coord} = $valuetype;
3981   if ($errortext) {
3982      $cellerrors->{$coord} = $errortext;
3983      }
3984   elsif ($cellerrors->{$coord}) {
3985      delete $cellerrors->{$coord};
3986      }
3987   $coordchecked->{$coord} = 2; # Remember we were here
3988   return "";
3989   }
3990
3991
3992# # # # # # # # #
3993#
3994# \%parseinfo = parse_formula_into_tokens($line)
3995#
3996# Parses a text string as if it was a spreadsheet formula
3997#
3998# This uses a simple state machine run on each character in turn.
3999# States remember whether a number is being gathered, etc.
4000# The result is %parseinfo which has the following arrays with one entry for each token:
4001#   {tokentext}->[] - the characters making up the parsed token,
4002#   {tokentype}->[] - the type of the token,
4003#   {tokenopcode}->[] - a single character version of an operator suitable for use in the
4004#                       precedence table and distinguishing between unary and binary + and -.
4005#
4006# # # # # # # # #
4007
4008sub parse_formula_into_tokens {
4009
4010   my $line = shift @_;
4011
4012   my @ch = unpack("C*", $line);
4013   push @ch, ord('#'); # add eof at end
4014
4015   my $state = 0;
4016   my $state_num = 1;
4017   my $state_alpha = 2;
4018   my $state_coord = 3;
4019   my $state_string = 4;
4020   my $state_stringquote = 5;
4021   my $state_numexp1 = 6;
4022   my $state_numexp2 = 7;
4023   my $state_alphanumeric = 8;
4024
4025   my $str;
4026   my ($cclass, $chrc, $ucchrc, $last_token_type, $last_token_text, $t);
4027
4028   my %parseinfo;
4029
4030   $parseinfo{tokentext} = [];
4031   $parseinfo{tokentype} = [];
4032   $parseinfo{tokenopcode} = [];
4033   my $parsed_token_text = $parseinfo{tokentext};
4034   my $parsed_token_type = $parseinfo{tokentype};
4035   my $parsed_token_opcode = $parseinfo{tokenopcode};
4036
4037   foreach my $c (@ch) {
4038      $chrc = chr($c);
4039      $ucchrc = uc $chrc;
4040      $cclass = $char_class[($c <= 127 ? (($c >= 32) ? $c : 32) : 32) - 32];
4041
4042      if ($state == $state_num) {
4043         if ($cclass == $char_class_num) {
4044            $str .= $chrc;
4045            }
4046         elsif ($cclass == $char_class_numstart && index($str, '.') == -1) {
4047            $str .= $chrc;
4048            }
4049         elsif ($ucchrc eq 'E') {
4050            $str .= $chrc;
4051            $state = $state_numexp1;
4052            }
4053         else { # end of number - save it
4054            push @$parsed_token_text, $str;
4055            push @$parsed_token_type, $token_num;
4056            push @$parsed_token_opcode, 0;
4057            $state = 0;
4058            }
4059         }
4060
4061      if ($state == $state_numexp1) {
4062         if ($cclass == $state_num) {
4063            $state = $state_numexp2;
4064            }
4065         elsif (($chrc eq '+' || $chrc eq '-') && (uc substr($str,-1)) eq 'E') {
4066            $str .= $chrc;
4067            }
4068         elsif ($ucchrc eq 'E') {
4069            ;
4070            }
4071         else {
4072            push @$parsed_token_text, $WKCStrings{"parseerrexponent"};
4073            push @$parsed_token_type, $token_error;
4074            push @$parsed_token_opcode, 0;
4075            $state = 0;
4076            }
4077         }
4078
4079      if ($state == $state_numexp2) {
4080         if ($cclass == $char_class_num) {
4081            $str .= $chrc;
4082            }
4083         else { # end of number - save it
4084            push @$parsed_token_text, $str;
4085            push @$parsed_token_type, $token_num;
4086            push @$parsed_token_opcode, 0;
4087            $state = 0;
4088            }
4089         }
4090
4091      if ($state == $state_alpha) {
4092         if ($cclass == $char_class_num) {
4093            $state = $state_coord;
4094            }
4095         elsif ($cclass == $char_class_alpha) {
4096            $str .= $ucchrc; # coords and functions are uppercase, names ignore case
4097            }
4098         elsif ($cclass == $char_class_incoord) {
4099            $state = $state_coord;
4100            }
4101         elsif ($cclass == $char_class_op || $cclass == $char_class_numstart
4102                || $cclass == $char_class_space || $cclass == $char_class_eof) {
4103            push @$parsed_token_text, $str;
4104            push @$parsed_token_type, $token_name;
4105            push @$parsed_token_opcode, 0;
4106            $state = 0;
4107            }
4108         else {
4109            push @$parsed_token_text, $str;
4110            push @$parsed_token_type, $token_error;
4111            push @$parsed_token_opcode, 0;
4112            $state = 0;
4113            }
4114         }
4115
4116      if ($state == $state_coord) {
4117         if ($cclass == $char_class_num) {
4118            $str .= $chrc;
4119            }
4120         elsif ($cclass == $char_class_incoord) {
4121            $str .= $chrc;
4122            }
4123         elsif ($cclass == $char_class_alpha) {
4124            $state = $state_alphanumeric;
4125            }
4126         elsif ($cclass == $char_class_op || $cclass == $char_class_numstart || $cclass == $char_class_eof) {
4127            if ($str =~ m/^\$?[A-Z]{1,2}\$?[1-9]\d*$/) {
4128               $t = $token_coord;
4129               }
4130            else {
4131               $t = $token_name;
4132               }
4133            push @$parsed_token_text, $str;
4134            push @$parsed_token_type, $t;
4135            push @$parsed_token_opcode, 0;
4136            $state = 0;
4137            }
4138         else {
4139            push @$parsed_token_text, $str;
4140            push @$parsed_token_type, $token_error;
4141            push @$parsed_token_opcode, 0;
4142            $state = 0;
4143            }
4144         }
4145
4146
4147      if ($state == $state_alphanumeric) {
4148         if ($cclass == $char_class_num || $cclass == $char_class_alpha) {
4149            $str .= $ucchrc; # coords and functions are uppercase, names ignore case
4150            }
4151         elsif ($cclass == $char_class_op || $cclass == $char_class_numstart
4152                || $cclass == $char_class_space || $cclass == $char_class_eof) {
4153            push @$parsed_token_text, $str;
4154            push @$parsed_token_type, $token_name;
4155            push @$parsed_token_opcode, 0;
4156            $state = 0;
4157            }
4158         else {
4159            push @$parsed_token_text, $str;
4160            push @$parsed_token_type, $token_error;
4161            push @$parsed_token_opcode, 0;
4162            $state = 0;
4163            }
4164         }
4165
4166      if ($state == $state_string) {
4167         if ($cclass == $char_class_quote) {
4168            $state = $state_stringquote; # got quote in string: is it doubled (quote in string) or by itself (end of string)?
4169            }
4170         else {
4171            $str .= $chrc;
4172            }
4173         }
4174      elsif ($state == $state_stringquote) { # note elseif here
4175         if ($cclass == $char_class_quote) {
4176            $str .='"';
4177            $state = $state_string; # double quote: add one then continue getting string
4178            }
4179         else { # something else -- end of string
4180            push @$parsed_token_text, $str;
4181            push @$parsed_token_type, $token_string;
4182            push @$parsed_token_opcode, 0;
4183            $state = 0; # drop through to process
4184            }
4185         }
4186
4187      if ($state == 0) {
4188         if ($cclass == $char_class_num || $cclass == $char_class_numstart) {
4189            $str = $chrc;
4190            $state = $state_num;
4191            }
4192         elsif ($cclass == $char_class_alpha || $cclass == $char_class_incoord) {
4193            $str = $ucchrc;
4194            $state = $state_alpha;
4195            }
4196         elsif ($cclass == $char_class_op) {
4197            $str = chr($c);
4198            if (@$parsed_token_type) {
4199               $last_token_type = $parsed_token_type->[@$parsed_token_type-1];
4200               $last_token_text = $parsed_token_text->[@$parsed_token_text-1];
4201               if ($last_token_type == $char_class_op) {
4202                  if ($last_token_text eq '<' || $last_token_text eq ">") {
4203                     $str = $last_token_text . $str;
4204                     pop @$parsed_token_text;
4205                     pop @$parsed_token_type;
4206                     pop @$parsed_token_opcode;
4207                     if (@$parsed_token_type) {
4208                        $last_token_type = $parsed_token_type->[@$parsed_token_type-1];
4209                        $last_token_text = $parsed_token_text->[@$parsed_token_text-1];
4210                        }
4211                     else {
4212                        $last_token_type = $char_class_eof;
4213                        $last_token_text = "EOF";
4214                        }
4215                     }
4216                  }
4217               }
4218            else {
4219               $last_token_type = $char_class_eof;
4220               $last_token_text = "EOF";
4221               }
4222            $t = $token_op;
4223            if ((@$parsed_token_type == 0)
4224                || ($last_token_type == $char_class_op && $last_token_text ne ')' && $last_token_text ne '%')) { # Unary operator
4225               if ($str eq '-') { # M is unary minus
4226                  $str = "M";
4227                  $c = ord($str);
4228                  }
4229               elsif ($str eq '+') { # P is unary plus
4230                  $str = "P";
4231                  $c = ord($str);
4232                  }
4233               elsif ($str eq ')' && $last_token_text eq '(') { # null arg list OK
4234                  ;
4235                  }
4236               elsif ($str ne '(') { # binary-op open-paren OK, others no
4237                  $t = $token_error;
4238                  $str = $WKCStrings{"parseerrtwoops"};
4239                  }
4240               }
4241            elsif (length $str > 1) {
4242               if ($str eq '>=') { # G is >=
4243                  $str = "G";
4244                  $c = ord($str);
4245                  }
4246               elsif ($str eq '<=') { # L is <=
4247                  $str = "L";
4248                  $c = ord($str);
4249                  }
4250               elsif ($str eq '<>') { # N is <>
4251                  $str = "N";
4252                  $c = ord($str);
4253                  }
4254               else {
4255                  $t = $token_error;
4256                  $str = $WKCStrings{"parseerrtwoops"};
4257                  }
4258               }
4259            push @$parsed_token_text, $str;
4260            push @$parsed_token_type, $t;
4261            push @$parsed_token_opcode, $c;
4262            $state = 0;
4263            }
4264         elsif ($cclass == $char_class_quote) { # starting a string
4265            $str = "";
4266            $state = $state_string;
4267            }
4268         elsif ($cclass == $char_class_space) { # store so can reconstruct spacing
4269            push @$parsed_token_text, " ";
4270            push @$parsed_token_type, $token_space;
4271            push @$parsed_token_opcode, 0;
4272            }
4273         elsif ($cclass == $char_class_eof) { # ignore
4274            }
4275         }
4276
4277      }
4278
4279   return \%parseinfo;
4280
4281}
4282
4283
4284# # # # # # # # #
4285#
4286# ($value, $valuetype, $errortext) = evaluate_parsed_formula(\%parseinfo, \%sheetdata)
4287#
4288# Does the calculation expressed in a parsed formula, returning a value, its type, and error info
4289#
4290# The following operators and functions are allowed among others:
4291#
4292#    +, -, *, /, ^, unary + and -, unary %, (, ), sum(1,2,A1:B7), wkcerrcell
4293#
4294# # # # # # # # #
4295
4296sub evaluate_parsed_formula {
4297
4298   my ($parseinfo, $sheetdata) = @_;
4299
4300   my $parsed_token_text = $parseinfo->{tokentext};
4301   my $parsed_token_type = $parseinfo->{tokentype};
4302   my $parsed_token_opcode = $parseinfo->{tokenopcode};
4303
4304   # # # # # # #
4305   #
4306   # Convert infix to reverse polish notation
4307   #
4308   # Based upon the algorithm shown in Wikipedia "Reverse Polish notation" article
4309   # and then enhanced for additional spreadsheet things
4310   #
4311   # The @revpolish array ends up with a sequence of references to tokens by number
4312   #
4313
4314   my @revpolish;
4315   my @parsestack;
4316
4317   my $function_start = -1;
4318
4319   my ($ttype, $ttext, $tprecedence, $tstackprecedence, $errortext);
4320
4321   for (my $i=0; $i<scalar @$parsed_token_text; $i++) {
4322      $ttype = $parsed_token_type->[$i];
4323      $ttext = $parsed_token_text->[$i];
4324      if ($ttype == $token_num || $ttype == $token_coord || $ttype == $token_string) {
4325         push @revpolish, $i;
4326         }
4327      elsif ($ttype == $token_name) {
4328         push @parsestack, $i;
4329         push @revpolish, $function_start;
4330         }
4331      elsif ($ttype == $token_space) { # ignore
4332         next;
4333         }
4334      elsif ($ttext eq ',') {
4335         while (@parsestack && $parsed_token_text->[$parsestack[@parsestack - 1]] ne '(') {
4336            push @revpolish, pop @parsestack;
4337            }
4338         if (@parsestack == 0) { # no ( -- error
4339            $errortext = $WKCStrings{"parseerrmissingopenparen"};
4340            last;
4341            }
4342         }
4343      elsif ($ttext eq '(') {
4344         push @parsestack, $i;
4345         }
4346      elsif ($ttext eq ')') {
4347         while (@parsestack && $parsed_token_text->[$parsestack[@parsestack - 1]] ne '(') {
4348            push @revpolish, pop @parsestack;
4349            }
4350         if (@parsestack == 0) { # no ( -- error
4351            $errortext = $WKCStrings{"parseerrcloseparennoopen"};
4352            last;
4353            }
4354         pop @parsestack;
4355         if (@parsestack && $parsed_token_type->[$parsestack[@parsestack - 1]] == $token_name) {
4356            push @revpolish, pop @parsestack;
4357            }
4358         }
4359      elsif ($ttype == $token_op) {
4360         if (@parsestack && $parsed_token_type->[$parsestack[@parsestack - 1]] == $token_name) {
4361            push @revpolish, pop @parsestack;
4362            }
4363         while (@parsestack && $parsed_token_type->[$parsestack[@parsestack - 1]] == $token_op
4364                && $parsed_token_text->[$parsestack[@parsestack - 1]] ne '(') {
4365            $tprecedence = $token_precedence[$parsed_token_opcode->[$i]-32];
4366            $tstackprecedence = $token_precedence[$parsed_token_opcode->[$parsestack[@parsestack - 1]]-32];
4367            if ($tprecedence >= 0 && $tprecedence < $tstackprecedence) {
4368               last;
4369               }
4370            elsif ($tprecedence < 0) {
4371               $tprecedence = -$tprecedence;
4372               $tstackprecedence = -$tstackprecedence if $tstackprecedence < 0;
4373               if ($tprecedence <= $tstackprecedence) {
4374                  last;
4375                  }
4376               }
4377            push @revpolish, pop @parsestack;
4378            }
4379         push @parsestack, $i;
4380         }
4381      elsif ($ttype == $token_error) {
4382         $errortext = $ttext;
4383         last;
4384         }
4385      else {
4386         $errortext = "Internal error while processing parsed formula. ";
4387         last;
4388         }
4389      }
4390   while (@parsestack) {
4391      if ($parsed_token_text->[$parsestack[@parsestack-1]] eq '(') {
4392         $errortext = $WKCStrings{"parseerrmissingcloseparen"};
4393         last;
4394         }
4395      push @revpolish, pop @parsestack;
4396      }
4397
4398   # # # # # # #
4399   #
4400   # Execute it
4401   #
4402
4403   # Operand values are hashes with {value} and {type}
4404   # Type can have these values (many are type and sub-type as two or more letters):
4405   #    "tw", "th", "t", "n", "nt", "coord", "range", "start", "eErrorType", "b" (blank)
4406   # The value of a coord is in the form A57 or A57!sheetname
4407   # The value of a range is coord|coord|number where number starts at 0 and is
4408   # the offset of the next item to fetch if you are going through the range one by one
4409   # The number starts as a null string ("A1|B3|")
4410   #
4411
4412   my @operand;
4413
4414   my ($value1, $value2, $tostype, $tostype2, $resulttype);
4415
4416   for (my $i=0; $i<scalar @revpolish; $i++) {
4417      if ($revpolish[$i] == $function_start) { # Remember the start of a function argument list
4418         push @operand, {type => "start"};
4419         next;
4420         }
4421
4422      $ttype = $parsed_token_type->[$revpolish[$i]];
4423      $ttext = $parsed_token_text->[$revpolish[$i]];
4424
4425      if ($ttype == $token_num) {
4426         push @operand, {type => "n", value => 0+$ttext};
4427         }
4428
4429      elsif ($ttype == $token_coord) {
4430         $ttext =~ s/[^0-9A-Z]//g;
4431         push @operand, {type => "coord", value => $ttext};
4432         }
4433
4434      elsif ($ttype == $token_string) {
4435         push @operand, {type => "t", value => $ttext};
4436         }
4437
4438      elsif ($ttype == $token_op) {
4439         if (@operand <= 0) { # Nothing on the stack...
4440            $errortext = $WKCStrings{"parseerrmissingoperand"}; # remember error
4441            push @operand, {type => "n", value => 0}; # put something there
4442            }
4443
4444         # Unary minus
4445
4446         if ($ttext eq 'M') {
4447            $value1 = operand_as_number($sheetdata, \@operand, \$errortext, \$tostype);
4448            $resulttype = lookup_result_type($tostype, $tostype, $typelookup{unaryminus});
4449            push @operand, {type => $resulttype, value => -$value1};
4450            }
4451
4452         # Unary plus
4453
4454         elsif ($ttext eq 'P') {
4455            $value1 = operand_as_number($sheetdata, \@operand, \$errortext, \$tostype);
4456            $resulttype = lookup_result_type($tostype, $tostype, $typelookup{unaryplus});
4457            push @operand, {type => $resulttype, value => $value1};
4458            }
4459
4460         # Unary % - percent, left associative
4461
4462         elsif ($ttext eq '%') {
4463            $value1 = operand_as_number($sheetdata, \@operand, \$errortext, \$tostype);
4464            $resulttype = lookup_result_type($tostype, $tostype, $typelookup{unarypercent});
4465            push @operand, {type => $resulttype, value => 0.01*$value1};
4466            }
4467
4468         # & - string concatenate
4469
4470         elsif ($ttext eq '&') {
4471            if (@operand == 1) { # Need at least two things on the stack...
4472               $errortext = $WKCStrings{"parseerrmissingoperand"}; # remember error
4473               push @operand, {type => "t", value => ""}; # put something there as second operand
4474               }
4475            $value2 = operand_as_text($sheetdata, \@operand, \$errortext, \$tostype2);
4476            $value1 = operand_as_text($sheetdata, \@operand, \$errortext, \$tostype);
4477            $resulttype = lookup_result_type($tostype, $tostype2, $typelookup{concat});
4478            push @operand, {type => $resulttype, value => ($value1 . $value2)};
4479            }
4480
4481         # : - Range constructor
4482
4483         elsif ($ttext eq ':') {
4484            if (@operand == 1) { # Need at least two things on the stack...
4485               $errortext = $WKCStrings{"parseerrmissingoperand"}; # remember error
4486               push @operand, {type => "n", value => 0}; # put something there as second operand
4487               }
4488            $value2 = operand_as_coord($sheetdata, \@operand, \$errortext);
4489            $value1 = operand_as_coord($sheetdata, \@operand, \$errortext);
4490            push @operand, {type => "range", value => "$value1|$value2|"}; # make a range value, null sequence number
4491            }
4492
4493         # ! - sheetname!coord
4494
4495         elsif ($ttext eq '!') {
4496            if (@operand == 1) { # Need at least two things on the stack...
4497               $errortext = $WKCStrings{"parseerrmissingoperand"}; # remember error
4498               push @operand, {type => "e#REF!", value => 0}; # put something there as second operand
4499               }
4500            $value2 = operand_as_coord($sheetdata, \@operand, \$errortext);
4501            $value1 = operand_as_sheetname($sheetdata, \@operand, \$errortext);
4502            push @operand, {type => "coord", value => "$value2!$value1"}; # add sheetname to coord
4503            }
4504
4505         # Comparison operators: < L = G > N (< <= = >= > <>)
4506
4507         elsif ($ttext =~ m/[<L=G>N]/) {
4508            if (@operand == 1) { # Need at least two things on the stack...
4509               $errortext = $WKCStrings{"parseerrmissingoperand"}; # remember error
4510               push @operand, {type => "n", value => 0}; # put something there as second operand
4511               }
4512            $value2 = operand_value_and_type($sheetdata, \@operand, \$errortext, \$tostype2);
4513            $value1 = operand_value_and_type($sheetdata, \@operand, \$errortext, \$tostype);
4514            if (substr($tostype,0,1) eq "n" && substr($tostype2,0,1) eq "n") { # compare two numbers
4515               my $cond = 0;
4516               if ($ttext eq "<") { $cond = $value1 < $value2 ? 1 : 0; }
4517               elsif ($ttext eq "L") { $cond = $value1 <= $value2 ? 1 : 0; }
4518               elsif ($ttext eq "=") { $cond = $value1 == $value2 ? 1 : 0; }
4519               elsif ($ttext eq "G") { $cond = $value1 >= $value2 ? 1 : 0; }
4520               elsif ($ttext eq ">") { $cond = $value1 > $value2 ? 1 : 0; }
4521               elsif ($ttext eq "N") { $cond = $value1 != $value2 ? 1 : 0; }
4522               push @operand, {type => "nl", value => $cond};
4523               }
4524            elsif (substr($tostype,0,1) eq "e") { # error on left
4525               push @operand, {type => $tostype, value => 0};
4526               }
4527            elsif (substr($tostype2,0,1) eq "e") { # error on right
4528               push @operand, {type => $tostype2, value => 0};
4529               }
4530            else { # text maybe mixed with numbers or blank
4531               if (substr($tostype,0,1) eq "n") {
4532                  $value1 = format_number_for_display($value1, "n", "");
4533                  }
4534               if (substr($tostype2,0,1) eq "n") {
4535                  $value2 = format_number_for_display($value2, "n", "");
4536                  }
4537               my $cond = 0;
4538               my $value1u8 = $value1;
4539               my $value2u8 = $value2;
4540               utf8::decode($value1u8); # handle UTF-8
4541               utf8::decode($value2u8);
4542               $value1u8 = lc $value1u8; # ignore case
4543               $value2u8 = lc $value2u8;
4544               if ($ttext eq "<") { $cond = $value1u8 lt $value2u8 ? 1 : 0; }
4545               elsif ($ttext eq "L") { $cond = $value1u8 le $value2u8 ? 1 : 0; }
4546               elsif ($ttext eq "=") { $cond = $value1u8 eq $value2u8 ? 1 : 0; }
4547               elsif ($ttext eq "G") { $cond = $value1u8 ge $value2u8 ? 1 : 0; }
4548               elsif ($ttext eq ">") { $cond = $value1u8 gt $value2u8 ? 1 : 0; }
4549               elsif ($ttext eq "N") { $cond = $value1u8 ne $value2u8 ? 1 : 0; }
4550               push @operand, {type => "nl", value => $cond};
4551               }
4552            }
4553
4554         # Normal infix arithmethic operators: +, -. *, /, ^
4555
4556         else { # what's left are the normal infix arithmetic operators
4557            if (@operand == 1) { # Need at least two things on the stack...
4558               $errortext = $WKCStrings{"parseerrmissingoperand"}; # remember error
4559               push @operand, {type => "n", value => 0}; # put something there as second operand
4560               }
4561            $value2 = operand_as_number($sheetdata, \@operand, \$errortext, \$tostype2);
4562            $value1 = operand_as_number($sheetdata, \@operand, \$errortext, \$tostype);
4563            if ($ttext eq '+') {
4564               $resulttype = lookup_result_type($tostype, $tostype2, $typelookup{plus});
4565               push @operand, {type => $resulttype, value => $value1 + $value2};
4566               }
4567            elsif ($ttext eq '-') {
4568               $resulttype = lookup_result_type($tostype, $tostype2, $typelookup{plus});
4569               push @operand, {type => $resulttype, value => $value1 - $value2};
4570               }
4571            elsif ($ttext eq '*') {
4572               $resulttype = lookup_result_type($tostype, $tostype2, $typelookup{plus});
4573               push @operand, {type => $resulttype, value => $value1 * $value2};
4574               }
4575            elsif ($ttext eq '/') {
4576               if ($value2 != 0) {
4577                  push @operand, {type => "n", value => $value1 / $value2}; # gives plain numeric result type
4578                  }
4579               else {
4580                  push @operand, {type => "e#DIV/0!", value => 0};
4581                  }
4582               }
4583            elsif ($ttext eq '^') {
4584               push @operand, {type => "n", value => $value1 ** $value2}; # gives plain numeric result type
4585               }
4586            }
4587         }
4588
4589      # function or name (names aren't implemented yet)
4590
4591      elsif ($ttype == $token_name) {
4592         WKCSheetFunctions::calculate_function($ttext, \@operand, \$errortext, \%typelookup, $sheetdata);
4593         }
4594
4595      else {
4596         $errortext = "Unknown token $ttype ($ttext). ";
4597         }
4598      }
4599
4600   # look at final value and handle special cases
4601
4602   my $value = $operand[0]->{value};
4603   my $valuetype;
4604   $tostype = $operand[0]->{type};
4605
4606   if ($tostype eq "name") { # name - expand it
4607      $value = lc $value;
4608      $value = lookup_name($sheetdata, $value, \$tostype, \$errortext);
4609      }
4610
4611   if ($tostype eq "coord") { # the value is a coord reference, get its value and type
4612      $value = operand_value_and_type($sheetdata, \@operand, \$errortext, \$tostype);
4613      $tostype = "n" if ($tostype eq "b");
4614      }
4615
4616   if (scalar @operand > 1) { # something left - error
4617      $errortext .= $WKCStrings{"parseerrerrorinformula"};
4618      }
4619
4620   # set return type
4621
4622   $valuetype = $tostype;
4623
4624   if (substr($tostype,0,1) eq "e") { # error value
4625      $errortext ||= substr($tostype,1) || $WKCStrings{"calcerrerrorvalueinformula"};
4626      }
4627   elsif ($tostype eq "range") {
4628      $errortext = $WKCStrings{"parseerrerrorinformulabadval"};
4629      }
4630
4631   if ($errortext && substr($valuetype,0,1) ne "e") {
4632      $value = $errortext;
4633      $valuetype = "e";
4634     }
4635
4636   # look for overflow
4637
4638   if (substr($tostype,0,1) eq "n" && $value =~ m/1\.#INF/) {
4639      $value = 0;
4640      $valuetype = "e#NUM!";
4641      $errortext = $WKCStrings{"calcerrnumericoverflow"};
4642      }
4643   return ($value, $valuetype, $errortext);
4644}
4645
4646
4647#
4648# test_criteria($value, $type, $criteria)
4649#
4650# Determines whether a value/type meets the criteria.
4651# A criteria can be a numeric value, text beginning with <, <=, =, >=, >, <>, text by itself is start of text to match.
4652#
4653# Returns 1 or 0 for true or false
4654#
4655
4656sub test_criteria {
4657
4658   my ($value, $type, $criteria) = @_;
4659
4660   my ($comparitor, $basevalue, $basetype);
4661
4662   return 0 unless defined $criteria; # undefined (e.g., error value) is always false
4663
4664   if ($criteria =~ m/^(<=|<>|<|=|>=|>)(.+?)$/) { # has comparitor
4665      $comparitor = $1;
4666      $basevalue = $2;
4667      }
4668   else {
4669      $comparitor = "none";
4670      $basevalue = $criteria;
4671      }
4672
4673   my $basevaluenum = determine_value_type($basevalue, \$basetype);
4674   if (!$basetype) { # no criteria base value given
4675      return 0 if $comparitor eq "none"; # blank criteria matches nothing
4676      if (substr($type,0,1) eq "b") { # empty cell
4677         return 1 if $comparitor eq "="; # empty equals empty
4678         }
4679      else {
4680         return 1 if $comparitor eq "<>"; # something does not equal empty
4681         }
4682      return 0; # otherwise false
4683      }
4684
4685   my $cond = 0;
4686
4687   if (substr($basetype,0,1) eq "n" && substr($type,0,1) eq "t") { # criteria is number, but value is text
4688      my $testtype;
4689      my $testvalue = determine_value_type($value, \$testtype);
4690      if (substr($testtype,0,1) eq "n") { # could be number - make it one
4691         $value = $testvalue;
4692         $type = $testtype;
4693         }
4694      }
4695
4696   if (substr($type,0,1) eq "n" && substr($basetype,0,1) eq "n") { # compare two numbers
4697      if ($comparitor eq "<") { $cond = $value < $basevaluenum ? 1 : 0; }
4698      elsif ($comparitor eq "<=") { $cond = $value <= $basevaluenum ? 1 : 0; }
4699      elsif ($comparitor eq "=" || $comparitor eq "none") { $cond = $value == $basevaluenum ? 1 : 0; }
4700      elsif ($comparitor eq ">=") { $cond = $value >= $basevaluenum ? 1 : 0; }
4701      elsif ($comparitor eq ">") { $cond = $value > $basevaluenum ? 1 : 0;}
4702      elsif ($comparitor eq "<>") { $cond = $value != $basevaluenum ? 1 : 0; }
4703      }
4704   elsif (substr($value,0,1) eq "e") { # error on left
4705      $cond = 0;
4706      }
4707   elsif (substr($basetype,0,1) eq "e") { # error on right
4708      $cond = 0;
4709      }
4710   else { # text maybe mixed with numbers or blank
4711      if (substr($type,0,1) eq "n") {
4712         $value = format_number_for_display($value, "n", "");
4713         }
4714      if (substr($basetype,0,1) eq "n") {
4715         return 0; # if number and didn't match already, isn't a match
4716         }
4717
4718      utf8::decode($value); # ignore case and use UTF-8 as chars not bytes
4719      $value = lc $value; # ignore case
4720      utf8::decode($basevalue);
4721      $basevalue = lc $basevalue;
4722
4723      if ($comparitor eq "<") { $cond = $value lt $basevalue ? 1 : 0; }
4724      elsif ($comparitor eq "<=") { $cond = $value le $basevalue ? 1 : 0; }
4725      elsif ($comparitor eq "=") { $cond = $value eq $basevalue ? 1 : 0; }
4726      elsif ($comparitor eq "none") { $cond = $value =~ m/^$basevalue/ ? 1 : 0; }
4727      elsif ($comparitor eq ">=") { $cond = $value ge $basevalue ? 1 : 0; }
4728      elsif ($comparitor eq ">") { $cond = $value gt $basevalue ? 1 : 0; }
4729      elsif ($comparitor eq "<>") { $cond = $value ne $basevalue ? 1 : 0; }
4730      }
4731
4732   return $cond;
4733
4734}
4735
4736
4737#
4738# $resulttype = lookup_result_type($type1, $type2, \%typelookup);
4739#
4740# %typelookup has values of the following form:
4741#
4742#    $typelookup{"typespec1"} = "|typespec2A:resultA|typespec2B:resultB|..."
4743#
4744# First $type1 is looked up. If no match, then the first letter (major type) of $type1 plus "*" is looked up
4745# $resulttype is $type1 if result is "1", $type2 if result is "2", otherwise the value of result.
4746#
4747
4748sub lookup_result_type {
4749
4750   my ($type1, $type2, $typelookup) = @_;
4751
4752   my $t2 = $type2;
4753
4754   my $table1 = $typelookup->{$type1};
4755   if (!$table1) {
4756      $table1 = $typelookup->{substr($type1,0,1).'*'};
4757      return "e#VALUE! (missing)" unless $table1; # missing from table -- please add it
4758      }
4759   if ($table1 =~ m/\Q|$type2:\E(.*?)\|/) {
4760      return $type1 if $1 eq '1';
4761      return $type2 if $1 eq '2';
4762      return $1;
4763      }
4764   $t2 = substr($t2,0,1).'*';
4765   if ($table1 =~ m/\Q|$t2:\E(.*?)\|/) {
4766      return $type1 if $1 eq '1';
4767      return $type2 if $1 eq '2';
4768      return $1;
4769      }
4770   return "e#VALUE!";
4771
4772}
4773
4774
4775#
4776# copy_function_args(\@operand, \@foperand)
4777#
4778# Pops operands from @operand and pushes on @foperand up to function start
4779# reversing order in the process.
4780#
4781
4782sub copy_function_args {
4783
4784   my ($operand, $foperand) = @_;
4785
4786   while (@$operand && $operand->[@$operand-1]->{type} ne "start") { # get each arg
4787      push @$foperand, $operand->[@$operand-1]; # copy it
4788      pop @$operand;
4789      }
4790   pop @$operand; # get rid of "start"
4791
4792   return;
4793}
4794
4795
4796#
4797# function_args_error($fname, \@operand, $$errortext)
4798#
4799# Pushes appropriate error on operand stack and sets errortext, including $fname
4800#
4801
4802sub function_args_error {
4803
4804   my ($fname, $operand, $errortext) = @_;
4805
4806   $$errortext = qq!$WKCStrings{calcerrincorrectargstofunction} "$fname". !;
4807   push @$operand, {type => "e#VALUE!", value => $$errortext};
4808
4809   return;
4810}
4811
4812
4813#
4814# function_specific_error($fname, \@operand, $errortext, $errortype, $text)
4815#
4816# Pushes specified error and text on operand stack
4817#
4818
4819sub function_specific_error {
4820
4821   my ($fname, $operand, $errortext, $errortype, $text) = @_;
4822
4823   $$errortext = $text;
4824   push @$operand, {type => $errortype, value => $$errortext};
4825
4826   return;
4827}
4828
4829
4830#
4831# ($value, $type) = top_of_stack_value_and_type(\@operand)
4832#
4833# Returns top of stack value and type and then pops the stack
4834#
4835
4836sub top_of_stack_value_and_type {
4837
4838   my $operand = shift @_;
4839
4840   if (@$operand) {
4841      my ($value, $type) = ($operand->[@$operand-1]->{value}, $operand->[@$operand-1]->{type});
4842      pop @$operand;
4843      return ($value, $type);
4844      }
4845   else {
4846      return ();
4847      }
4848}
4849
4850
4851#
4852# $value = operand_as_number(\%sheetdata, \@operand, \$errortext, \$tostype)
4853#
4854# Uses operand_value_and_type to get top of stack and pops it.
4855# Returns numeric value and type.
4856# Text values are treated as 0 if they can't be converted somehow.
4857#
4858
4859sub operand_as_number {
4860
4861   my ($sheetdata, $operand, $errortext, $tostype) = @_;
4862
4863   my $value = operand_value_and_type($sheetdata, $operand, $errortext, $tostype);
4864
4865   if (substr($$tostype,0,1) eq "n") {
4866      return 0+$value;
4867      }
4868   elsif (substr($$tostype,0,1) eq "b") { # blank cell
4869      $$tostype = "n";
4870      return 0;
4871      }
4872   elsif (substr($$tostype,0,1) eq "e") { # error
4873      return 0;
4874      }
4875   else {
4876      $value = determine_value_type($value, $tostype);
4877      if (substr($$tostype,0,1) eq "n") {
4878         return 0+$value;
4879         }
4880      else {
4881         return 0;
4882         }
4883      }
4884}
4885
4886
4887#
4888# $value = operand_as_text(\%sheetdata, \@operand, \$errortext, \$tostype)
4889#
4890# Uses operand_value_and_type to get top of stack and pops it.
4891# Returns text value, preserving sub-type.
4892#
4893
4894sub operand_as_text {
4895
4896   my ($sheetdata, $operand, $errortext, $tostype) = @_;
4897
4898   my $value = operand_value_and_type($sheetdata, $operand, $errortext, $tostype);
4899
4900   if (substr($$tostype,0,1) eq "t") {
4901      return $value;
4902      }
4903   elsif (substr($$tostype,0,1) eq "n") {
4904#      $value = format_number_for_display($value, $$tostype, "");
4905      $value = "$value";
4906      $$tostype = "t";
4907      return $value;
4908      }
4909   elsif (substr($$tostype,0,1) eq "b") { # blank
4910      $$tostype = "t";
4911      return "";
4912      }
4913   elsif (substr($$tostype,0,1) eq "e") { # error
4914      return "";
4915      }
4916   else {
4917      $$tostype = "t";
4918      return "$value";
4919      }
4920}
4921
4922
4923#
4924# $value = operand_value_and_type(\%sheetdata, \@operand, \$errortext, \$operandtype)
4925#
4926# Pops the top of stack and returns it, following a coord reference if necessary.
4927# Ranges are returned as if they were pushed onto the stack first coord first
4928# Also sets $operandtype with "t", "n", "th", etc., as appropriate
4929# Errortext is set if there is a reference to a cell with error
4930#
4931
4932sub operand_value_and_type {
4933
4934   my ($sheetdata, $operand, $errortext, $operandtype) = @_;
4935
4936   my $stacklen = scalar @$operand;
4937   if (!$stacklen) { # make sure something is there
4938      $$operandtype = "";
4939      return "";
4940      }
4941   my $value = $operand->[$stacklen-1]->{value}; # get top of stack
4942   my $tostype = $operand->[$stacklen-1]->{type};
4943   pop @$operand; # we have data - pop stack
4944
4945   if ($tostype eq "name") {
4946      $value = lc $value;
4947      $value = lookup_name($sheetdata, $value, \$tostype, $errortext);
4948      }
4949
4950   if ($tostype eq "range") {
4951      $value = step_through_range_down($operand, $value, \$tostype);
4952      }
4953
4954   if ($tostype eq "coord") { # value is a coord reference
4955      my $coordsheetdata = $sheetdata;
4956      if ($value =~ m/^([^!]+)!(.+)$/) { # sheet reference
4957         $value = $1;
4958         my $othersheet = $2;
4959         $coordsheetdata = WKC::find_in_sheet_cache($sheetdata, $othersheet);
4960         if ($coordsheetdata->{loaderror}) { # this sheet is unavailable
4961            $$operandtype = "e#REF!";
4962            return 0;
4963            }
4964         }
4965      my $cellvtype = $coordsheetdata->{valuetypes}->{$value}; # get type of value in the cell it points to
4966      $value = $coordsheetdata->{datavalues}->{$value};
4967      $tostype = $cellvtype || "b";
4968      if ($tostype eq "b") { # blank
4969         $value = 0;
4970         }
4971      }
4972
4973   $$operandtype = $tostype; # return information
4974   return $value;
4975
4976}
4977
4978
4979#
4980# $value = operand_as_coord(\%sheetdata, \@operand, \$errortext)
4981#
4982# Gets top of stack and pops it.
4983# Returns coord value. All others are treated as an error.
4984#
4985
4986sub operand_as_coord {
4987
4988   my ($sheetdata, $operand, $errortext) = @_;
4989
4990   my $stacklen = scalar @$operand;
4991   my $value = $operand->[$stacklen-1]->{value}; # get top of stack
4992   my $tostype = $operand->[$stacklen-1]->{type};
4993   pop @$operand; # we have data - pop stack
4994   if ($tostype eq "coord") { # value is a coord reference
4995      return $value;
4996      }
4997   else {
4998      $$errortext = $WKCStrings{"calcerrcellrefmissing"};
4999      return 0;
5000      }
5001}
5002
5003
5004#
5005# $value = operand_as_sheetname(\%sheetdata, \@operand, \$errortext)
5006#
5007# Gets top of stack and pops it.
5008# Returns sheetname value. All others are treated as an error.
5009#
5010
5011sub operand_as_sheetname {
5012
5013   my ($sheetdata, $operand, $errortext) = @_;
5014
5015   my $stacklen = scalar @$operand;
5016   my $value = $operand->[$stacklen-1]->{value}; # get top of stack
5017   my $tostype = $operand->[$stacklen-1]->{type};
5018   pop @$operand; # we have data - pop stack
5019   if ($tostype eq "name") { # could be a sheet name
5020      return $value;
5021      }
5022   elsif ($tostype eq "coord") { # value is a coord reference, follow it to find sheet name
5023      my $cellvtype = $sheetdata->{valuetypes}->{$value}; # get type of value in the cell it points to
5024      $value = $sheetdata->{datavalues}->{$value};
5025      $tostype = $cellvtype || "b";
5026      }
5027   if (substr($tostype,0,1) eq "t") { # value is a string which could be a sheet name
5028      return $value;
5029      }
5030   else {
5031      $$errortext = $WKCStrings{"calcerrsheetnamemissing"};
5032      return "";
5033      }
5034}
5035
5036
5037#
5038# $value = lookup_name(\%sheetdata, $name, \$valuetype, \$errortext)
5039#
5040# Returns value and type of a named value
5041#
5042
5043sub lookup_name {
5044
5045my %namelist = ();
5046
5047   my ($sheetdata, $name, $valuetype, $errortext) = @_;
5048
5049   if (defined $namelist{$name}) {
5050      $$valuetype = "number";
5051      return $namelist{$name};
5052      }
5053   else {
5054      $$valuetype = "e#NAME?";
5055      $$errortext = qq!$WKCStrings{calcerrunknownname} "$name".!;
5056      return "";
5057      }
5058}
5059
5060
5061#
5062# $value = step_through_range_up(\@operand, $rangevalue, \$operandtype)
5063#
5064# Returns next coord in a range, keeping track on the operand stack
5065# Goes from bottom right across and up to upper left.
5066#
5067
5068sub step_through_range_up {
5069
5070   my ($operand, $value, $operandtype) = @_;
5071
5072   my ($value1, $value2, $sequence) = split(/\|/, $value);
5073   my ($sheet1, $sheet2);
5074   ($value1, $sheet1) = split(/!/, $value1);
5075   $sheet1 = "!$sheet1" if $sheet1;
5076   ($value2, $sheet2) = split(/!/, $value2);
5077   my ($c1, $r1) = coord_to_cr($value1);
5078   my ($c2, $r2) = coord_to_cr($value2);
5079   ($c2, $c1) = ($c1, $c2) if ($c1 > $c2);
5080   ($r2, $r1) = ($r1, $r2) if ($r1 > $r2);
5081   my $count;
5082   $sequence = ($r2-$r1+1)*($c2-$c1+1)-1 if length($sequence) == 0; # start at the end
5083   for (my $r=$r1;$r<=$r2;$r++) {
5084      for (my $c=$c1;$c<=$c2;$c++) {
5085         $count++;
5086         if ($count > $sequence) {
5087            $sequence--;
5088            push @$operand, {type => "range", value => "$value1$sheet1|$value2|$sequence"} unless $sequence < 0;
5089            $$operandtype = "coord";
5090            return cr_to_coord($c, $r) . $sheet1;
5091            }
5092         }
5093      }
5094   }
5095
5096
5097#
5098# $value = step_through_range_down(\@operand, $rangevalue, \$operandtype)
5099#
5100# Returns next coord in a range, keeping track on the operand stack
5101# Goes from upper left across and down to bottom right.
5102#
5103
5104sub step_through_range_down {
5105
5106   my ($operand, $value, $operandtype) = @_;
5107
5108   my ($value1, $value2, $sequence) = split(/\|/, $value);
5109   my ($sheet1, $sheet2);
5110   ($value1, $sheet1) = split(/!/, $value1);
5111   $sheet1 = "!$sheet1" if $sheet1;
5112   ($value2, $sheet2) = split(/!/, $value2);
5113   my ($c1, $r1) = coord_to_cr($value1);
5114   my ($c2, $r2) = coord_to_cr($value2);
5115   ($c2, $c1) = ($c1, $c2) if ($c1 > $c2);
5116   ($r2, $r1) = ($r1, $r2) if ($r1 > $r2);
5117   my $count;
5118   for (my $r=$r1;$r<=$r2;$r++) {
5119      for (my $c=$c1;$c<=$c2;$c++) {
5120         $count++;
5121         if ($count > $sequence) {
5122            push @$operand, {type => "range", value => "$value1$sheet1|$value2|$count"} unless ($r==$r2 && $c==$c2);
5123            $$operandtype = "coord";
5124            return cr_to_coord($c, $r) . $sheet1;
5125            }
5126         }
5127      }
5128   }
5129
5130
5131#
5132# ($sheetdata, $col1num, $ncols, $row1num, $nrows) = decode_range_parts(\@sheetdata, $rangevalue, $rangetype)
5133#
5134# Returns \@sheetdata for the sheet where the range is, as well as
5135# the number of the first column in the range, the number of columns,
5136# and equivalent row information.
5137#
5138# If any errors, $sheetdata is returned as null.
5139#
5140
5141sub decode_range_parts {
5142
5143   my ($sheetdata, $rangevalue, $rangetype) = @_;
5144
5145   my ($value1, $value2, $sequence) = split(/\|/, $rangevalue);
5146   my ($sheet1, $sheet2);
5147   ($value1, $sheet1) = split(/!/, $value1);
5148   ($value2, $sheet2) = split(/!/, $value2);
5149   my $coordsheetdata = $sheetdata;
5150   if ($sheet1) { # sheet reference
5151      $coordsheetdata = WKC::find_in_sheet_cache($sheetdata, $sheet1);
5152      if ($coordsheetdata->{loaderror}) { # this sheet is unavailable
5153         $coordsheetdata = undef;
5154         }
5155      }
5156
5157   my ($c1, $r1) = coord_to_cr($value1);
5158   my ($c2, $r2) = coord_to_cr($value2);
5159   ($c2, $c1) = ($c1, $c2) if ($c1 > $c2);
5160   ($r2, $r1) = ($r1, $r2) if ($r1 > $r2);
5161   return ($coordsheetdata, $c1, $c2-$c1+1, $r1, $r2-$r1+1);
5162   }
5163
5164
5165#
5166# ($col, $row) = coord_to_cr($coord)
5167#
5168# Turns B3 into (2, 3). The default for both is 1.
5169# If range, only do this to first coord
5170#
5171
5172sub coord_to_cr {
5173
5174   my $coord = shift @_;
5175
5176   $coord = lc($coord);
5177   $coord =~ s/\$//g;
5178   $coord =~ m/([a-z])([a-z])?(\d+)/;
5179   my $col = ord($1) - ord('a') + 1 ;
5180   $col = 26 * $col + ord($2) - ord('a') + 1 if $2;
5181
5182   return ($col, $3);
5183
5184}
5185
5186
5187#
5188# $coord = cr_to_coord($col, $row)
5189#
5190# Turns (2, 3) into B3. The default for both is 1.
5191#
5192
5193sub cr_to_coord {
5194
5195   my ($col, $row) = @_;
5196
5197   $row = 1 unless $row > 1;
5198   $col = 1 unless $col > 1;
5199
5200   my $col_high = int(($col - 1) / 26);
5201   my $col_low = ($col - 1) % 26;
5202
5203   my $coord = chr(ord('A') + $col_low);
5204   $coord = chr(ord('A') + $col_high - 1) . $coord if $col_high;
5205   $coord .= $row;
5206
5207   return $coord;
5208
5209}
5210
5211
5212#
5213# $col = col_to_number($colname)
5214#
5215# Turns B into 2. The default is 1.
5216#
5217
5218sub col_to_number {
5219
5220   my $coord = shift @_;
5221
5222   $coord = lc($coord);
5223   $coord =~ m/([a-z])([a-z])?/;
5224   return 1 unless $1;
5225   my $col = ord($1) - ord('a') + 1 ;
5226   $col = 26 * $col + ord($2) - ord('a') + 1 if $2;
5227
5228   return $col;
5229
5230}
5231
5232
5233#
5234# $coord = number_to_col($col)
5235#
5236# Turns 2 into B. The default is 1.
5237#
5238
5239sub number_to_col {
5240
5241   my $col = shift @_;
5242
5243   $col = $col > 1 ? $col : 1;
5244
5245   my $col_high = int(($col - 1) / 26);
5246   my $col_low = ($col - 1) % 26;
5247
5248   my $coord = chr(ord('A') + $col_low);
5249   $coord = chr(ord('A') + $col_high - 1) . $coord if $col_high;
5250
5251   return $coord;
5252
5253}
5254
5255
5256# # # # # # # # # #
5257# encode_for_save($string)
5258#
5259# Returns $estring where :, \n, and \ are escaped
5260#
5261
5262sub encode_for_save {
5263   my $string = shift @_;
5264
5265   $string =~ s/\\/\\b/g; # \ to \b
5266   $string =~ s/:/\\c/g; # : to \c
5267   $string =~ s/\n/\\n/g; # line end to \n
5268
5269   return $string;
5270}
5271
5272
5273# # # # # # # # # #
5274# decode_from_save($string)
5275#
5276# Returns $estring with \c, \n, \b and \\ un-escaped
5277#
5278
5279sub decode_from_save {
5280   my $string = shift @_;
5281
5282   $string =~ s/\\\\/\\/g; # Old -- shouldn't get this, replace with \b
5283   $string =~ s/\\c/:/g;
5284   $string =~ s/\\n/\n/g;
5285   $string =~ s/\\b/\\/g;
5286
5287   return $string;
5288}
5289
5290
5291# # # # # # # # # #
5292# special_chars($string)
5293#
5294# Returns $estring where &, <, >, " are HTML escaped
5295#
5296
5297sub special_chars {
5298   my $string = shift @_;
5299
5300   $string =~ s/&/&amp;/g;
5301   $string =~ s/</&lt;/g;
5302   $string =~ s/>/&gt;/g;
5303   $string =~ s/"/&quot;/g;
5304
5305   return $string;
5306}
5307
5308
5309# # # # # # # # # #
5310# special_chars_nl($string)
5311#
5312# Returns $estring where &, <, >, ", and LF are HTML escaped, CR's are removed
5313#
5314
5315sub special_chars_nl {
5316   my $string = shift @_;
5317
5318   $string =~ s/&/&amp;/g;
5319   $string =~ s/</&lt;/g;
5320   $string =~ s/>/&gt;/g;
5321   $string =~ s/"/&quot;/g;
5322   $string =~ s/\r//gs;
5323   $string =~ s/\n/&#10;/gs;
5324
5325   return $string;
5326}
5327
5328
5329# # # # # # # # # #
5330# special_chars_markup($string)
5331#
5332# Returns $estring where &, <, >, " are HTML escaped ready for expand markup
5333#
5334
5335sub special_chars_markup {
5336   my $string = shift @_;
5337
5338   $string =~ s/&/{{amp}}amp;/g;
5339   $string =~ s/</{{amp}}lt;/g;
5340   $string =~ s/>/{{amp}}gt;/g;
5341   $string =~ s/"/{{amp}}quot;/g;
5342
5343   return $string;
5344}
5345
5346
5347# # # # # # # # # #
5348# expand_markup($string, \%sheetdata, $linkstyle)
5349#
5350# Returns $estring with wiki-style formatting performed
5351# $linkstyle is used by wiki_page_command for links to other pages
5352#
5353
5354sub expand_markup {
5355   my ($string, $sheetdata, $linkstyle) = @_;
5356
5357   # Process forms that use URL encoding first
5358
5359   $string =~ s!\[(http:.+?)\s+(.+?)\]!'{{lt}}a href={{quot}}' . url_encode("$1") . "{{quot}}{{gt}}$2\{{lt}}/a{{gt}}"!egs; # Wiki-style links
5360   $string =~ s!\[link:(.+?)\s+(.+?)\:link]!'{{lt}}a href={{quot}}' . url_encode("$1") . "{{quot}}{{gt}}$2\{{lt}}/a{{gt}}"!egs; # [link:url text:link] to link
5361   $string =~ s!\[popup:(.+?)\s+(.+?)\:popup]!'{{lt}}a href={{quot}}' . url_encode("$1") . "{{quot}} target={{quot}}_blank{{quot}}{{gt}}$2\{{lt}}/a{{gt}}"!egs; # [popup:url text:popup] to link with popup result
5362   $string =~ s!\[image:(.+?)\s+(.+?)\:image]!'{{lt}}img src={{quot}}' . url_encode("$1") . '{{quot}} alt={{quot}}' . special_chars_markup("$2") . '{{quot}}{{gt}}'!egs; # [image:url alt-text:image] for images
5363   $string =~ s!\[page:(.+?)(\s+(.+?))?]!wiki_page_command($1,$3, $linkstyle)!egs; # [page:pagename text] to link to other pages on this site
5364
5365   # Convert &, <, >, "
5366
5367   $string = special_chars($string);
5368
5369   # Multi-line text has additional formatting options ignored for single line
5370
5371   if ($string =~ m/\n/) {
5372      my ($str, @closingtag);
5373      foreach my $line (split /\n/, $string) { # do things on a line-by-line basis
5374         $line =~ s/\r//g;
5375         if ($line =~ m/^([\*|#|;]{1,5})\s{0,1}(.+)$/) { # do list items
5376            my $lnest = length($1);
5377            my $lchr = substr($1,-1);
5378            my $ltype;
5379            if ($lnest > @closingtag) {
5380               for (my $i=@closingtag; $i<$lnest; $i++) {
5381                  if ($lchr eq '*') {
5382                     $ltype = "ul";
5383                     }
5384                  elsif ($lchr eq '#') {
5385                     $ltype = 'ol';
5386                     }
5387                  else {
5388                     $ltype = 'dl';
5389                     }
5390                  $str .= "<$ltype>";
5391                  push @closingtag, "</$ltype>";
5392                  }
5393               }
5394            elsif ($lnest < @closingtag) {
5395               for (my $i=@closingtag; $i>$lnest; $i--) {
5396                  $str .= pop @closingtag;
5397                  }
5398               }
5399            if ($lchr eq ';') {
5400               my $rest = $2;
5401               if ($rest =~ m/\s*(.*?):(.*)$/) {
5402                  $str .= "<dt>$1</dt><dd>$2</dd>";
5403                  }
5404               else {
5405                  $str .= "<dt>$rest</dt>";
5406                  }
5407               }
5408            else {
5409               $str .= "<li>$2</li>";
5410               }
5411            next;
5412            }
5413         while (@closingtag) {
5414            $str .= pop @closingtag;
5415            }
5416         if ($line =~ m/^(={1,5})\s(.+)\s\1$/) { # = heading =, with equal number of equals on both sides
5417            my $neq = length($1);
5418            $str .= "<h$neq>$2</h$neq>";
5419            next;
5420            }
5421         if ($line =~ m/^(:{1,5})\s{0,1}(.+)$/) { # indent 20pts for each :
5422            my $nindent = length($1) * 20;
5423            $str .= "<div style=\"padding-left:${nindent}pt;\">$2</div>";
5424            next;
5425            }
5426
5427         $str .= "$line\n";
5428         }
5429      while (@closingtag) { # just in case any left at the end
5430         $str .= pop @closingtag;
5431         }
5432      $string = $str;
5433      }
5434
5435   $string =~ s/\n/<br>/g;  # Line breaks are preserved
5436   $string =~ s/('*)'''(.*?)'''/$1<b>$2<\/b>/gs; # Wiki-style bold/italics
5437   $string =~ s/''(.*?)''/<i>$1<\/i>/gs;
5438   $string =~ s/\[b:(.+?)\:b]/<b>$1<\/b>/gs; # [b:text:b] for bold
5439   $string =~ s/\[i:(.+?)\:i]/<i>$1<\/i>/gs; # [i:text:i] for italic
5440   $string =~ s/\[quote:(.+?)\:quote]/<blockquote>$1<\/blockquote>/gs; # [quote:text:quote] to indent
5441   $string =~ s/\{\{amp}}/&/gs; # {{amp}} for ampersand
5442   $string =~ s/\{\{lt}}/</gs; # {{lt}} for less than
5443   $string =~ s/\{\{gt}}/>/gs; # {{gt}} for greater than
5444   $string =~ s/\{\{quot}}/"/gs; # {{quot}} for quote
5445   $string =~ s/\{\{lbracket}}/[/gs; # {{lbracket}} for left bracket
5446   $string =~ s/\{\{rbracket}}/]/gs; # {{rbracket}} for right bracket
5447   $string =~ s/\{\{lbrace}}/{/gs; # {{lbrace}} for brace
5448
5449   $string =~ s!\[cell:(.+?)]!wiki_cell_command($1, $sheetdata)!egs; # [cell:coord] to display cell data formatted like cell
5450
5451   return $string;
5452}
5453
5454
5455# # # # # # # # # #
5456# wiki_page_command($pagename, $text, $linkstyle)
5457#
5458# Returns link to local page with $text as the link text
5459# If $linkstyle is non-null, it is a string that will have
5460# the characters "[[pagename]]" replaced by $pagename,
5461# e.g., "http://www.domain.com/cgi-bin/wikicalc.pl?view=[[pagename]]"
5462#
5463
5464sub wiki_page_command {
5465   my ($pagename, $text, $linkstyle) = @_;
5466
5467   if (!length($text)) {
5468      $text = $pagename;
5469      }
5470   my $url = lc $pagename;
5471   if ($linkstyle) {
5472      $linkstyle =~ s/\[\[pagename\]\]/$url/ge;
5473      $url = $linkstyle;
5474      }
5475   else {
5476      $url .= ".html";
5477      }
5478
5479   return "{{lt}}a href={{quot}}" . url_encode($url) . "{{quot}}{{gt}}$text\{{lt}}/a{{gt}}";
5480
5481}
5482
5483
5484# # # # # # # # # #
5485# wiki_cell_command($coord, $sheetdata)
5486#
5487# Returns display value of cell formatted as in cell
5488#
5489
5490sub wiki_cell_command {
5491   my ($coord, $sheetdata) = @_;
5492
5493   my $cr = $coord;
5494
5495   if ($cr =~ m/^([^!]+)!(.+)$/) { # does it have an explicit worksheet?
5496      my $othersheet = $1;
5497      $cr = $2;
5498      if ($othersheet =~ m/^[a-zA-Z][a-zA-Z]?(\d+)$/) {
5499         $othersheet = $sheetdata->{datavalues}->{uc $othersheet};
5500         }
5501      $sheetdata = WKC::find_in_sheet_cache($sheetdata, $othersheet);
5502      }
5503
5504   my $displayvalue;
5505
5506   if ($cr =~ m/^[a-zA-Z][a-zA-Z]?(\d+)$/) {
5507      $cr = uc $cr;
5508      $displayvalue = format_value_for_display($sheetdata, $sheetdata->{datavalues}->{$cr}, $cr, "");
5509#!! note: does not use $linkstyle which can lead to strange behavior with wiki [page:]
5510#!! commands because we can't always get to sheet
5511      }
5512   else {
5513      $displayvalue = $coord;
5514      }
5515
5516   return $displayvalue;
5517
5518}
5519
5520
5521# # # # # # # # # #
5522# url_encode($string)
5523#
5524# Returns $estring with special chars URL encoded
5525#
5526# Based on Mastering Regular Expressions, Jeffrey E. F. Friedl, additional legal characters added
5527#
5528
5529sub url_encode {
5530   my $string = shift @_;
5531
5532   $string =~ s!([^a-zA-Z0-9_\-;/?:@=#.])!sprintf('%%%02X', ord($1))!ge;
5533   $string =~ s/%26/{{amp}}/gs; # let ampersands in URLs through -- convert to {{amp}}
5534
5535   return $string;
5536}
5537
5538
5539# # # # # # # # # #
5540# url_encode_plain($string)
5541#
5542# Returns $estring with special chars URL encoded for sending to others by HTTP, not publishing
5543#
5544# Based on Mastering Regular Expressions, Jeffrey E. F. Friedl, additional legal characters added
5545#
5546
5547sub url_encode_plain {
5548   my $string = shift @_;
5549
5550   $string =~ s!([^a-zA-Z0-9_\-/?:@=#.])!sprintf('%%%02X', ord($1))!ge;
5551
5552   return $string;
5553}
5554
5555
5556# # # # # # # # # #
5557#
5558# encode_for_javascript($string)
5559#
5560# Returns a string with CR, LF, ', and \ escaped to \r, \n, \', \\ for use in Javascript strings
5561#
5562
5563sub encode_for_javascript {
5564   my $string = shift @_;
5565
5566   $string =~ s/\\/\\\\/g;
5567   $string =~ s/\n/\\n/g;
5568   $string =~ s/\r/\\r/g;
5569   $string =~ s/'/\\'/g;
5570
5571   return $string;
5572}
5573
5574
5575# # # # # # #
5576#
5577# $error = parse_header_save(\@lines, \%headerdata)
5578#
5579# Returns "" if OK, otherwise error string.
5580# Fills in %headerdata.
5581#
5582# Headerdata is:
5583#
5584#    %headerdata
5585#       $headerdata{version} - version number, currently 1.1
5586#       $headerdata{fullname} - title of page
5587#       $headerdata{templatetext} - template HTML
5588#       $headerdata{templatefile} - where to get template (location:name), see get_template
5589#       $headerdata{lastmodified} - date/time last modified
5590#       $headerdata{lastauthor} - author when last modified
5591#       $headerdata{basefiledt} - date/time of backup file before this set of edits or blank if new file first edits (survives rename)
5592#       $headerdata{backupfiledt} - date/time of backup file holding this data (blank during edits, yyyy-mm-... in published/backup/archive)
5593#       $headerdata{reverted} - if non-blank, name of backup file this came from (only during initial editing)
5594#       $headerdata{editcomments} - comment text about this series of edits, used when listing backups and RSS
5595#       $headerdata{publishhtml} - publish the HTML for this page - sometimes you only want access-controlled live view (yes/no - default yes)
5596#       $headerdata{publishsource} - put a copy of the published .txt file along with HTML and allow live view of source (yes/no - default no)
5597#       $headerdata{publishjs} - put an embeddable copy of the published HTML as a .js file along with HTML (yes/no - default no)
5598#       $headerdata{publishlive} - (ignored and removed after 0.91) make the HTML be a redirect to the recalc code (yes/no - default no)
5599#       $headerdata{viewwithoutlogin} - allow live view without being logged in (ignore login for this page)
5600#       $headerdata{editlog} - array of entries about edits made since editing started (cleared on new open for edit)
5601#          [0] - log entry: command string to execute_sheet_command or comment (starts with "# ")
5602#
5603
5604sub parse_header_save {
5605
5606   my ($lines, $headerdata) = @_;
5607
5608   my ($rest, $linetype, $name, $type, $type2, $rest, $value);
5609
5610   foreach my $line (@$lines) {
5611      chomp $line;
5612      $line =~ s/\r//g;
5613# assume already done #      $line =~ s/^\x{EF}\x{BB}\x{BF}//; # remove UTF-8 Byte Order Mark if present
5614      ($linetype, $rest) = split(/:/, $line, 2);
5615      if ($linetype eq "edit") {
5616         $headerdata->{editlog} ||= ();
5617         push @{$headerdata->{editlog}}, decode_from_save($rest);
5618         }
5619      else {
5620         $headerdata->{$linetype} = decode_from_save($rest) if ($linetype && $linetype !~ m/^#/);
5621         }
5622      }
5623
5624   return "";
5625
5626   }
5627
5628
5629# # # # # # #
5630#
5631# $outstr = create_header_save(\%headerdata)
5632#
5633# Header output routine
5634#
5635
5636sub create_header_save {
5637
5638   my $headerdata = shift @_;
5639
5640   my $outstr;
5641
5642   $headerdata->{version} = "1.1"; # this is the current version
5643
5644   foreach my $val (@headerfieldnames) {
5645      my $valstr = encode_for_save($headerdata->{$val});
5646      $outstr .= "$val:$valstr\n";
5647      }
5648
5649   foreach my $logentry (@{$headerdata->{editlog}}) {
5650      my $valstr = encode_for_save($logentry);
5651      $outstr .= "edit:$valstr\n";
5652      }
5653
5654   return $outstr;
5655
5656}
5657
5658
5659# # # # # # #
5660#
5661# add_to_editlog(\%headerdata, $str)
5662#
5663# Adds $str to the header editlog
5664# This should be either a string acceptable to execute_sheet_command or start with "# "
5665#
5666
5667sub add_to_editlog {
5668
5669   my ($headerdata, $str) = @_;
5670
5671   $headerdata->{editlog} ||= (); # make sure array exists
5672   push @{$headerdata->{editlog}}, $str;
5673   return;
5674}
5675
5676
5677# # # # # # #
5678#
5679# load_special_strings()
5680#
5681# Reads the WCKdefinitions.txt file and fills in %WKCStrings
5682#
5683
5684sub load_special_strings {
5685
5686   my ($line, $lineno, $dname, $categories, $sindex, $ftext, $sname, $sbname, $stext);
5687
5688   open FDFILE, "$WKCdirectory/$definitionsfile";
5689   my @deflines = <FDFILE>;
5690   close FDFILE;
5691
5692   $lineno = 0;
5693   while ($lineno < scalar @deflines) {
5694      $line = $deflines[$lineno]; # get next line
5695      $lineno++;
5696
5697      chomp $line;
5698      $line =~ s/\r//g;
5699      $line =~ s/^\x{EF}\x{BB}\x{BF}//; # remove UTF-8 Byte Order Mark if present
5700
5701      if ($sbname) { # accumulating string block
5702         if ($line eq ".") { # just . on a line -- end of block
5703            $WKCStrings{$sbname} = $stext;
5704            $sbname = "";
5705            next;
5706            }
5707         $stext .= $line . "\n";
5708         next;
5709         }
5710
5711      my ($fdtype, $rest) = split(/:/, $line, 2);
5712      next if ($fdtype eq "sample");
5713      if ($fdtype eq "number") { # number:displayname|category1:category2:...|sampleindex|format-text
5714         ($dname, $categories, $sindex, $ftext) = split(/\|/, $rest, 5);
5715         }
5716      elsif ($fdtype eq "text") { # text:displayname|sampleindex|format-text
5717         ($dname, $sindex, $ftext) = split(/\|/, $rest, 3);
5718         }
5719      elsif ($fdtype eq "string") { # string:name:replacement text for a WKCStrings entry
5720         ($sname, $stext) = split(/:/, $rest, 2);
5721         $WKCStrings{$sname} = $stext;
5722         next;
5723         }
5724      elsif ($fdtype eq "stringblock") { # stringblock:name
5725         $sbname = $rest; # remember name
5726         $stext = ""; # start accumulating lines of text until line with just "."
5727         next;
5728         }
5729      elsif ($fdtype eq "include") { # include:name - load "$WKCdirectory/name.txt";
5730         $rest =~ s/[^A-Za-z-_]//g;
5731         open FDFILE, "$WKCdirectory/$rest.txt"; # insert those lines here
5732         splice @deflines, $lineno-1, 1, <FDFILE>;
5733         close FDFILE;
5734         $lineno -= 1; # start with first new line that replaced this line
5735         next;
5736         }
5737      else {
5738         next; # ignore other lines
5739         }
5740      }
5741   return;
5742   }
5743
5744