lib/Spreadsheet/Engine/Sheet.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 1186 | 2643 | 44.8 |
branch | 666 | 1680 | 39.6 |
condition | 169 | 431 | 39.2 |
subroutine | 35 | 53 | 66.0 |
pod | 50 | 50 | 100.0 |
total | 2106 | 4857 | 43.3 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package Spreadsheet::Engine::Sheet; | ||||||
2 | |||||||
3 | =head1 NAME | ||||||
4 | |||||||
5 | Spreadsheet::Engine::Sheet - Spreadsheet basics | ||||||
6 | |||||||
7 | =head1 SYNOPSIS | ||||||
8 | |||||||
9 | parse_sheet_save(\@lines, \my %sheetdata); | ||||||
10 | my $outstr = create_sheet_save(\%sheetdata); | ||||||
11 | |||||||
12 | add_to_editlog(\%headerdata, $str); | ||||||
13 | |||||||
14 | parse_header_save(\@lines, my \%headerdata); | ||||||
15 | my $outstr = create_header_save(\%headerdata); | ||||||
16 | |||||||
17 | execute_sheet_command($sheetdata, $command); | ||||||
18 | |||||||
19 | recalc_sheet(\%sheetdata); | ||||||
20 | |||||||
21 | =head1 DESCRIPTION | ||||||
22 | |||||||
23 | This is a motley bunch of functions for dealing with a spreadsheet file | ||||||
24 | and/or data structure. If you plan to use any of these directly, be | ||||||
25 | aware that they may move, vanish, or have significant interface changes | ||||||
26 | in future releases. | ||||||
27 | |||||||
28 | =cut | ||||||
29 | |||||||
30 | 34 | 34 | 79370 | use strict; | |||
34 | 59 | ||||||
34 | 1524 | ||||||
31 | 34 | 34 | 50313 | use utf8; | |||
34 | 415 | ||||||
34 | 187 | ||||||
32 | |||||||
33 | require Exporter; | ||||||
34 | our @ISA = qw(Exporter); | ||||||
35 | our @EXPORT = qw( | ||||||
36 | parse_sheet_save | ||||||
37 | create_sheet_save | ||||||
38 | execute_sheet_command | ||||||
39 | recalc_sheet | ||||||
40 | parse_header_save | ||||||
41 | create_header_save | ||||||
42 | add_to_editlog | ||||||
43 | |||||||
44 | convert_date_gregorian_to_julian | ||||||
45 | convert_date_julian_to_gregorian | ||||||
46 | determine_value_type | ||||||
47 | test_criteria | ||||||
48 | lookup_result_type | ||||||
49 | copy_function_args | ||||||
50 | function_args_error | ||||||
51 | function_specific_error | ||||||
52 | top_of_stack_value_and_type | ||||||
53 | operand_as_number | ||||||
54 | operand_as_text | ||||||
55 | operand_value_and_type | ||||||
56 | decode_range_parts | ||||||
57 | coord_to_cr | ||||||
58 | cr_to_coord | ||||||
59 | encode_for_save | ||||||
60 | decode_from_save | ||||||
61 | special_chars | ||||||
62 | special_chars_nl | ||||||
63 | |||||||
64 | %sheetfields | ||||||
65 | %formathints | ||||||
66 | $julian_offset | ||||||
67 | $seconds_in_a_day | ||||||
68 | $seconds_in_an_hour | ||||||
69 | ); | ||||||
70 | |||||||
71 | # Were exporte, but no longer used from outside: | ||||||
72 | # format_number_for_display url_encode_plain | ||||||
73 | |||||||
74 | # | ||||||
75 | # Locals and Globals | ||||||
76 | # | ||||||
77 | |||||||
78 | our %sheetfields = ( | ||||||
79 | lastcol => "c", | ||||||
80 | lastrow => "r", | ||||||
81 | defaultcolwidth => "w", | ||||||
82 | defaultrowheight => "h", | ||||||
83 | defaulttextformat => "tf", | ||||||
84 | defaultnontextformat => "ntf", | ||||||
85 | defaulttextvalueformat => "tvf", | ||||||
86 | defaultnontextvalueformat => "ntvf", | ||||||
87 | defaultlayout => "layout", | ||||||
88 | defaultfont => "font", | ||||||
89 | defaultcolor => "color", | ||||||
90 | defaultbgcolor => "bgcolor", | ||||||
91 | circularreferencecell => "circularreferencecell", | ||||||
92 | recalc => "recalc", | ||||||
93 | needsrecalc => "needsrecalc" | ||||||
94 | ); | ||||||
95 | |||||||
96 | my @headerfieldnames = qw( | ||||||
97 | version fullname templatetext templatefile lastmodified | ||||||
98 | lastauthor basefiledt backupfiledt reverted editcomments | ||||||
99 | publishhtml publishsource publishjs viewwithoutlogin | ||||||
100 | ); | ||||||
101 | |||||||
102 | # Date/time constants | ||||||
103 | |||||||
104 | our $julian_offset = 2415019; | ||||||
105 | our $seconds_in_a_day = 24 * 60 * 60; | ||||||
106 | our $seconds_in_an_hour = 60 * 60; | ||||||
107 | |||||||
108 | # Input values that have special values, e.g., "TRUE", "FALSE", etc. | ||||||
109 | # Form is: uppercasevalue => "value,type" | ||||||
110 | |||||||
111 | my %input_constants = ( | ||||||
112 | 'TRUE' => '1,nl', | ||||||
113 | 'FALSE' => '0,nl', | ||||||
114 | '#N/A' => '0,e#N/A', | ||||||
115 | '#NULL!' => '0,e#NULL!', | ||||||
116 | '#NUM!' => '0,e#NUM!', | ||||||
117 | '#DIV/0!' => '0,e#DIV/0!', | ||||||
118 | '#VALUE!' => '0,e#VALUE!', | ||||||
119 | '#REF!' => '0,e#REF!', | ||||||
120 | '#NAME?' => '0,e#NAME?', | ||||||
121 | ); | ||||||
122 | |||||||
123 | # Formula constants for parsing: | ||||||
124 | |||||||
125 | my $token_num = 1; | ||||||
126 | my $token_coord = 2; | ||||||
127 | my $token_op = 3; | ||||||
128 | my $token_name = 4; | ||||||
129 | my $token_error = 5; | ||||||
130 | my $token_string = 6; | ||||||
131 | my $token_space = 7; | ||||||
132 | |||||||
133 | my $char_class_num = 1; | ||||||
134 | my $char_class_numstart = 2; | ||||||
135 | my $char_class_op = 3; | ||||||
136 | my $char_class_eof = 4; | ||||||
137 | my $char_class_alpha = 5; | ||||||
138 | my $char_class_incoord = 6; | ||||||
139 | my $char_class_error = 7; | ||||||
140 | my $char_class_quote = 8; | ||||||
141 | my $char_class_space = 9; | ||||||
142 | |||||||
143 | my @char_class = ( | ||||||
144 | |||||||
145 | # 0 1 2 3 4 5 6 7 8 9 A B C D E F | ||||||
146 | # sp ! " # $ % & ' ( ) * + , - . / | ||||||
147 | 9, 3, 8, 4, 6, 3, 3, 0, 3, 3, 3, 3, 3, 3, 2, 3, | ||||||
148 | |||||||
149 | # 0 1 2 3 4 5 6 7 8 9 : ; < = > ? | ||||||
150 | 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 0, 3, 3, 3, 0, | ||||||
151 | |||||||
152 | # @ A B C D E F G H I J K L M N O | ||||||
153 | 0, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, | ||||||
154 | |||||||
155 | # P Q R S T U V W X Y Z [ \ ] ^ _ | ||||||
156 | 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 0, 0, 0, 3, 0, | ||||||
157 | |||||||
158 | # ` a b c d e f g h i j k l m n o | ||||||
159 | 0, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, | ||||||
160 | |||||||
161 | # p q r s t u v w x y z { | } ~ DEL | ||||||
162 | 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 0, 0, 0, 0, 0 | ||||||
163 | ); | ||||||
164 | |||||||
165 | # Convert one char token text to input text | ||||||
166 | |||||||
167 | my %token_op_expansion = | ||||||
168 | ('G' => '>=', 'L' => '<=', 'M' => '-', 'N' => '<>', 'P' => '+'); | ||||||
169 | |||||||
170 | # Operator Precedence: | ||||||
171 | # 1 ! | ||||||
172 | # 2 : , | ||||||
173 | # 3 M P | ||||||
174 | # 4 % | ||||||
175 | # 5 ^ | ||||||
176 | # 6 * / | ||||||
177 | # 7 + - | ||||||
178 | # 8 & | ||||||
179 | # 9 < > = G(>=) L(<=) N(<>) | ||||||
180 | # Negative value means Right Associative | ||||||
181 | |||||||
182 | my @token_precedence = ( | ||||||
183 | |||||||
184 | # 0 1 2 3 4 5 6 7 8 9 A B C D E F | ||||||
185 | # sp ! " # $ % & ' ( ) * + , - . / | ||||||
186 | 0, 1, 0, 0, 0, 4, 8, 0, 0, 0, 6, 7, 2, 7, 0, 6, | ||||||
187 | |||||||
188 | # 0 1 2 3 4 5 6 7 8 9 : ; < = > ? | ||||||
189 | 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 9, 9, 9, 0, | ||||||
190 | |||||||
191 | # @ A B C D E F G H I J K L M N O | ||||||
192 | 0, 0, 0, 0, 0, 0, 0, 9, 0, 0, 0, 0, 9, -3, 9, 0, | ||||||
193 | |||||||
194 | # P Q R S T U V W X Y Z [ \ ] ^ _ | ||||||
195 | -3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5, 0 | ||||||
196 | ); | ||||||
197 | |||||||
198 | # | ||||||
199 | # Information about the resulting value types when doing operations on values | ||||||
200 | # | ||||||
201 | # Each hash entry is a hash with specific types with result type info as follows: | ||||||
202 | # | ||||||
203 | # 'type1a' => '|type2a:resulta|type2b:resultb|... | ||||||
204 | # Type of t* or n* matches any of those types not listed | ||||||
205 | # Results may be a type or the numbers 1 or 2 specifying to return type1 or type2 | ||||||
206 | # | ||||||
207 | |||||||
208 | my %typelookup = ( | ||||||
209 | unaryminus => { | ||||||
210 | 'n*' => '|n*:1|', | ||||||
211 | 'e*' => '|e*:1|', | ||||||
212 | 't*' => '|t*:e#VALUE!|', | ||||||
213 | 'b' => '|b:n|' | ||||||
214 | }, | ||||||
215 | unaryplus => { | ||||||
216 | 'n*' => '|n*:1|', | ||||||
217 | 'e*' => '|e*:1|', | ||||||
218 | 't*' => '|t*:e#VALUE!|', | ||||||
219 | 'b' => '|b:n|' | ||||||
220 | }, | ||||||
221 | unarypercent => { | ||||||
222 | 'n*' => '|n:n%|n*:n|', | ||||||
223 | 'e*' => '|e*:1|', | ||||||
224 | 't*' => '|t*:e#VALUE!|', | ||||||
225 | 'b' => '|b:n|' | ||||||
226 | }, | ||||||
227 | plus => { | ||||||
228 | 'n%' => '|n%:n%|nd:n|nt:n|ndt:n|n$:n|n:n|n*:n|b:n|e*:2|t*:e#VALUE!|', | ||||||
229 | 'nd' => '|n%:n|nd:nd|nt:ndt|ndt:ndt|n$:n|n:nd|n*:n|b:n|e*:2|t*:e#VALUE!|', | ||||||
230 | 'nt' => '|n%:n|nd:ndt|nt:nt|ndt:ndt|n$:n|n:nt|n*:n|b:n|e*:2|t*:e#VALUE!|', | ||||||
231 | 'ndt' => | ||||||
232 | '|n%:n|nd:ndt|nt:ndt|ndt:ndt|n$:n|n:ndt|n*:n|b:n|e*:2|t*:e#VALUE!|', | ||||||
233 | 'n$' => '|n%:n|nd:n|nt:n|ndt:n|n$:n$|n:n$|n*:n|b:n|e*:2|t*:e#VALUE!|', | ||||||
234 | 'n' => '|n%:n|nd:nd|nt:nt|ndt:ndt|n$:n$|n:n|n*:n|b:n|e*:2|t*:e#VALUE!|', | ||||||
235 | 'b' => '|n%:n%|nd:nd|nt:nt|ndt:ndt|n$:n$|n:n|n*:n|b:n|e*:2|t*:e#VALUE!|', | ||||||
236 | 't*' => '|n*:e#VALUE!|t*:e#VALUE!|b:e#VALUE!|e*:2|', | ||||||
237 | 'e*' => '|e*:1|n*:1|t*:1|b:1|', | ||||||
238 | }, | ||||||
239 | concat => { | ||||||
240 | 't' => '|t:t|th:th|tw:tw|t*:2|e*:2|', | ||||||
241 | 'th' => '|t:th|th:th|tw:t|t*:t|e*:2|', | ||||||
242 | 'tw' => '|t:tw|th:t|tw:tw|t*:t|e*:2|', | ||||||
243 | 'e*' => '|e*:1|n*:1|t*:1|', | ||||||
244 | }, | ||||||
245 | oneargnumeric => { | ||||||
246 | 'n*' => '|n*:n|', | ||||||
247 | 'e*' => '|e*:1|', | ||||||
248 | 't*' => '|t*:e#VALUE!|', | ||||||
249 | 'b' => '|b:n|' | ||||||
250 | }, | ||||||
251 | twoargnumeric => { | ||||||
252 | 'n*' => '|n*:n|t*:e#VALUE!|e*:2|', | ||||||
253 | 'e*' => '|e*:1|n*:1|t*:1|', | ||||||
254 | 't*' => '|t*:e#VALUE!|n*:e#VALUE!|e*:2|' | ||||||
255 | }, | ||||||
256 | propagateerror => { | ||||||
257 | 'n*' => '|n*:2|e*:2|', | ||||||
258 | 'e*' => '|e*:2|', | ||||||
259 | 't*' => '|t*:2|e*:2|', | ||||||
260 | 'b' => '|b:2|e*:2|' | ||||||
261 | }, | ||||||
262 | ); | ||||||
263 | |||||||
264 | my %old_formats_map = ( | ||||||
265 | 'default' => "default" | ||||||
266 | , # obsolete: converts from early beta versions, used only one place | ||||||
267 | 'none' => 'General', | ||||||
268 | '%1.0f' => "0", | ||||||
269 | ',' => '[,]General', | ||||||
270 | ',%1.0f' => '#,##0', | ||||||
271 | ',%1.1f' => '#,##0.0', | ||||||
272 | ',%1.2f' => '#,##0.00', | ||||||
273 | ',%1.3f' => '#,##0.000', | ||||||
274 | ',%1.4f' => '#,##0.0000', | ||||||
275 | '$,%1.0f' => '$#,##0', | ||||||
276 | '$,%1.1f' => '$#,##0.0', | ||||||
277 | '$,%1.2f' => '$#,##0.00', | ||||||
278 | '(,%1.0f' => '#,##0_);(#,##0)', | ||||||
279 | '(,%1.1f' => '#,##0.0_);(#,##0.0)', | ||||||
280 | '(,%1.2f' => '#,##0.00_);(#,##0.00)', | ||||||
281 | '($,%1.0f' => '$#,##0_);($#,##0)', | ||||||
282 | '($,%1.1f' => '$#,##0.0_);($#,##0.0)', | ||||||
283 | '($,%1.2f' => '$#,##0.00_);($#,##0.00)', | ||||||
284 | ',%1.0f%%' => '0%', | ||||||
285 | ',%1.1f%%' => '0.0%', | ||||||
286 | '(,%1.0f%%' => '0%_);(0%)', | ||||||
287 | '(,%1.1f%%' => '0.0%_);(0.0%)', | ||||||
288 | '%02.0f' => '00', | ||||||
289 | '%03.0f' => '000', | ||||||
290 | '%04.0f' => '0000', | ||||||
291 | ); | ||||||
292 | |||||||
293 | =head1 EXPORTS | ||||||
294 | |||||||
295 | =head2 parse_sheet_save | ||||||
296 | |||||||
297 | parse_sheet_save(\@lines, \my %sheetdata); | ||||||
298 | |||||||
299 | Sheet input routine. Fills %sheetdata given lines of text @lines. | ||||||
300 | |||||||
301 | Currently always returns nothing. | ||||||
302 | |||||||
303 | Sheet save format: | ||||||
304 | |||||||
305 | linetype:param1:param2:... | ||||||
306 | |||||||
307 | Linetypes are: | ||||||
308 | |||||||
309 | version:versionname - version of this format. Currently 1.3. | ||||||
310 | |||||||
311 | cell:coord:type:value...:type:value... - Types are as follows: | ||||||
312 | |||||||
313 | v:value - straight numeric value | ||||||
314 | t:value - straight text/wiki-text in cell, encoded to handle \, :, newlines | ||||||
315 | vt:fulltype:value - value with value type/subtype | ||||||
316 | vtf:fulltype:value:formulatext - formula resulting in value with value type/subtype, value and text encoded | ||||||
317 | vtc:fulltype:value:valuetext - formatted text constant resulting in value with value type/subtype, value and text encoded | ||||||
318 | vf:fvalue:formulatext - formula resulting in value, value and text encoded (obsolete: only pre format version 1.1) | ||||||
319 | fvalue - first char is "N" for numeric value, "T" for text value, "H" for HTML value, rest is the value | ||||||
320 | e:errortext - Error text. Non-blank means formula parsing/calculation results in error. | ||||||
321 | b:topborder#:rightborder#:bottomborder#:leftborder# - border# in sheet border list or blank if none | ||||||
322 | l:layout# - number in cell layout list | ||||||
323 | f:font# - number in sheet fonts list | ||||||
324 | c:color# - sheet color list index for text | ||||||
325 | bg:color# - sheet color list index for background color | ||||||
326 | cf:format# - sheet cell format number for explicit format (align:left, etc.) | ||||||
327 | cvf:valueformat# - sheet cell value format number (obsolete: only pre format v1.2) | ||||||
328 | tvf:valueformat# - sheet cell text value format number | ||||||
329 | ntvf:valueformat# - sheet cell non-text value format number | ||||||
330 | colspan:numcols - number of columns spanned in merged cell | ||||||
331 | rowspan:numrows - number of rows spanned in merged cell | ||||||
332 | cssc:classname - name of CSS class to be used for cell when published instead of one calculated here | ||||||
333 | csss:styletext - explicit CSS style information, encoded to handle :, etc. | ||||||
334 | mod:allow - if "y" allow modification of cell for live "view" recalc | ||||||
335 | |||||||
336 | col: | ||||||
337 | w:widthval - number, "auto" (no width in |
||||||
338 | hide: - yes/no, no is assumed if missing | ||||||
339 | row: | ||||||
340 | hide - yes/no, no is assumed if missing | ||||||
341 | |||||||
342 | sheet: | ||||||
343 | c:lastcol - number | ||||||
344 | r:lastrow - number | ||||||
345 | w:defaultcolwidth - number, "auto", number%, or blank (default->80) | ||||||
346 | h:defaultrowheight - not used | ||||||
347 | tf:format# - cell format number for sheet default for text values | ||||||
348 | ntf:format# - cell format number for sheet default for non-text values (i.e., numbers) | ||||||
349 | layout:layout# - default cell layout number in cell layout list | ||||||
350 | font:font# - default font number in sheet font list | ||||||
351 | vf:valueformat# - default number value format number in sheet valueformat list (obsolete: only pre format version 1.2) | ||||||
352 | ntvf:valueformat# - default non-text (number) value format number in sheet valueformat list | ||||||
353 | tvf:valueformat# - default text value format number in sheet valueformat list | ||||||
354 | color:color# - default number for text color in sheet color list | ||||||
355 | bgcolor:color# - default number for background color in sheet color list | ||||||
356 | circularreferencecell:coord - cell coord with a circular reference | ||||||
357 | recalc:value - on/off (on is default). If "on", appropriate changes to the sheet cause a recalc | ||||||
358 | needsrecalc:value - yes/no (no is default). If "yes", formula values are not up to date | ||||||
359 | |||||||
360 | name:name:description:value - name definition, name in uppercase, with value being "B5", "A1:B7", or "=formula" | ||||||
361 | font:fontnum:value - text of font definition (style weight size family) for font fontnum | ||||||
362 | "*" for "style weight", size, or family, means use default (first look to sheet, then builtin) | ||||||
363 | color:colornum:rgbvalue - text of color definition (e.g., rgb(255,255,255)) for color colornum | ||||||
364 | border:bordernum:value - text of border definition (thickness style color) for border bordernum | ||||||
365 | layout:layoutnum:value - text of vertical alignment and padding style for cell layout layoutnum: | ||||||
366 | vertical-alignment:vavalue;padding topval rightval bottomval leftval; | ||||||
367 | cellformat:cformatnum:value - text of cell alignment (left/center/right) for cellformat cformatnum | ||||||
368 | valueformat:vformatnum:value - text of number format (see format_value_for_display) for valueformat vformatnum (changed in v1.2) | ||||||
369 | clipboardrange:upperleftcoord:bottomrightcoord - origin of clipboard data. Not present if clipboard empty. | ||||||
370 | There must be a clipboardrange before any clipboard lines | ||||||
371 | clipboard:coord:type:value:... - clipboard data, in same format as cell data | ||||||
372 | |||||||
373 | The resulting $sheetdata data structure is as follows: | ||||||
374 | |||||||
375 | $sheetdata{version} - version of save file read in | ||||||
376 | $sheetdata{datatypes}->{$coord} - Origin of {datavalues} value: | ||||||
377 | v - typed in numeric value of some sort, constant, no formula | ||||||
378 | t - typed in text, constant, no formula | ||||||
379 | f - result of formula calculation ({formulas} has formula to calculate) | ||||||
380 | c - constant of some sort with typed in text in {formulas} and value in {datavalues} | ||||||
381 | $sheetdata{formulas}->{$coord} - Text of formula if {datatypes} is "f", no leading "=", or text of constant if "c" | ||||||
382 | $sheetdata{datavalues}->{$coord} - a text or numeric value ready to be formatted for display or used in calculation | ||||||
383 | $sheetdata{valuetypes}->{$coord} - the value type of the datavalue as 1 or more characters | ||||||
384 | First char is "n" for numeric or "t" for text | ||||||
385 | Second chars, if present, are sub-type, like "l" for logical (0=false, 1=true) | ||||||
386 | $sheetdata{cellerrors}->{$coord} - If non-blank, error text for error in formula calculation | ||||||
387 | $sheetdata{cellattribs}->{$coord}-> | ||||||
388 | {coord} - coord of cell - existence means non-blank cell | ||||||
389 | {bt}, {br}, {bb}, {bl} - border number or null if no border | ||||||
390 | {layout} - cell layout number or blank for default | ||||||
391 | {font} - font number or blank for default | ||||||
392 | {color} - color number for text or blank for default | ||||||
393 | {bgcolor} - color number for the cell background or blank for default | ||||||
394 | {cellformat} - cell format number if not default - controls horizontal alignment | ||||||
395 | {textvalueformat} - value format number if not default - controls how the cell's text values are formatted into text for display | ||||||
396 | {nontextvalueformat} - value format number if not default - controls how the cell's non-text values are turned into text for display | ||||||
397 | {colspan}, {rowspan} - column span and row span for merged cells or blank for 1 | ||||||
398 | {cssc}, {csss} - explicit CSS class and CSS style for cell | ||||||
399 | {mod} - if "y" allow modification in live view | ||||||
400 | $sheetdata{colattribs}->{$colcoord}-> | ||||||
401 | {width} - column width if not default | ||||||
402 | {hide} - hide column if yes | ||||||
403 | $sheetdata{rowattribs}->{$rowcoord}-> | ||||||
404 | {height} - ignored | ||||||
405 | {hide} - hide row if yes | ||||||
406 | $sheetdata{sheetattribs}->{$attrib}-> | ||||||
407 | {lastcol} - number of columns in sheet | ||||||
408 | {lastrow} - number of rows in sheet (more may be displayed when editing) | ||||||
409 | {defaultcolwidth} - number, "auto", number%, or blank (default->80) | ||||||
410 | {defaultrowheight} - not used | ||||||
411 | {defaulttextformat} - cell format number for sheet default for text values | ||||||
412 | {defaultnontextformat} - cell format number for sheet default for non-text values (i.e., numbers) | ||||||
413 | {defaultlayout} - default cell layout number in sheet cell layout list | ||||||
414 | {defaultfont} - default font number in sheet font list | ||||||
415 | {defaulttextvalueformat} - default text value format number in sheet valueformat list | ||||||
416 | {defaultnontextvalueformat} - default number value format number in sheet valueformat list | ||||||
417 | {defaultcolor} - default number for text color in sheet color list | ||||||
418 | {defaultbgcolor} - default number for background color in sheet color list | ||||||
419 | {circularreferencecell} - cell coord with a circular reference | ||||||
420 | {recalc} - on/off (on is default). If "on", appropriate changes to the sheet cause a recalc | ||||||
421 | {needsrecalc} - yes/no (no is default). If "yes", formula values are not up to date | ||||||
422 | $sheetdata{names}->{$name}-> - name is uppercase | ||||||
423 | {desc} - description (optional) | ||||||
424 | {definiton} - in the form of B5, A1:B7, or =formula | ||||||
425 | $sheetdata{fonts}->[$index] - font specifications addressable by array position | ||||||
426 | $sheetdata{fonthash}->{$value} - hash with font specification as keys and {fonts}->[] index position as values | ||||||
427 | $sheetdata{colors}->[$index] - color specifications addressable by array position | ||||||
428 | $sheetdata{colorhash}->{$value} - hash with color specification as keys and {colors}->[] index position as values | ||||||
429 | $sheetdata{borderstyles}->[$index] - border style specifications addressable by array position | ||||||
430 | $sheetdata{borderstylehash}->{$value} - hash with border style specification as keys and {borderstyles}->[] index position as values | ||||||
431 | $sheetdata{layoutstyles}->[$index] - cell layout specifications addressable by array position | ||||||
432 | $sheetdata{layoutstylehash}->{$value} - hash with cell layout specification as keys and {layoutstyle}->[] index position as values | ||||||
433 | $sheetdata{cellformats}->[$index] - cell format specifications addressable by array position | ||||||
434 | $sheetdata{cellformathash}->{$value} - hash with cell format specification as keys and {cellformats}->[] index position as values | ||||||
435 | $sheetdata{valueformats}->[$index] - value format specifications addressable by array position | ||||||
436 | $sheetdata{valueformathash}->{$value} - hash with value format specification as keys and {valueformats}->[] index position as values | ||||||
437 | $sheetdata{clipboard}-> - the sheet's clipboard | ||||||
438 | {range} - coord:coord range of where the clipboard contents came from or null if empty | ||||||
439 | {datavalues} - like $sheetdata{datavalues} but for clipboard copy of cells | ||||||
440 | {datatypes} - like $sheetdata{datatypes} but for clipboard copy of cells | ||||||
441 | {valuetypes} - like $sheetdata{valuetypes} but for clipboard copy of cells | ||||||
442 | {formulas} - like $sheetdata{formulas} but for clipboard copy of cells | ||||||
443 | {cellerrors} - like $sheetdata{cellerrors} but for clipboard copy of cells | ||||||
444 | {cellattribs} - like $sheetdata{cellattribs} but for clipboard copy of cells | ||||||
445 | $sheetdata{loaderror} - if non-blank, there was an error loading this sheet and this is the text of that error | ||||||
446 | |||||||
447 | =cut | ||||||
448 | |||||||
449 | sub parse_sheet_save { | ||||||
450 | |||||||
451 | 114 | 114 | 1 | 237 | my ($lines, $sheetdata) = @_; | ||
452 | |||||||
453 | # Initialize sheetdata structure | ||||||
454 | 114 | 313 | $sheetdata->{datavalues} = {}; | ||||
455 | 114 | 284 | $sheetdata->{datatypes} = {}; | ||||
456 | 114 | 277 | $sheetdata->{valuetypes} = {}; | ||||
457 | 114 | 317 | $sheetdata->{formulas} = {}; | ||||
458 | 114 | 267 | $sheetdata->{cellerrors} = {}; | ||||
459 | 114 | 280 | $sheetdata->{cellattribs} = {}; | ||||
460 | 114 | 307 | $sheetdata->{colattribs} = {}; | ||||
461 | 114 | 344 | $sheetdata->{rowattribs} = {}; | ||||
462 | 114 | 283 | $sheetdata->{sheetattribs} = {}; | ||||
463 | 114 | 311 | $sheetdata->{layoutstyles} = []; | ||||
464 | 114 | 360 | $sheetdata->{layoutstylehash} = {}; | ||||
465 | 114 | 340 | $sheetdata->{names} = {}; | ||||
466 | 114 | 383 | $sheetdata->{fonts} = []; | ||||
467 | 114 | 438 | $sheetdata->{fonthash} = {}; | ||||
468 | 114 | 308 | $sheetdata->{colors} = []; | ||||
469 | 114 | 409 | $sheetdata->{colorhash} = {}; | ||||
470 | 114 | 303 | $sheetdata->{borderstyles} = []; | ||||
471 | 114 | 319 | $sheetdata->{borderstylehash} = {}; | ||||
472 | 114 | 324 | $sheetdata->{cellformats} = []; | ||||
473 | 114 | 287 | $sheetdata->{cellformathash} = {}; | ||||
474 | 114 | 287 | $sheetdata->{valueformats} = []; | ||||
475 | 114 | 250 | $sheetdata->{valueformathash} = {}; | ||||
476 | |||||||
477 | # Get references to the parts | ||||||
478 | |||||||
479 | 114 | 204 | my $datavalues = $sheetdata->{datavalues}; | ||||
480 | 114 | 236 | my $datatypes = $sheetdata->{datatypes}; | ||||
481 | 114 | 210 | my $valuetypes = $sheetdata->{valuetypes}; | ||||
482 | 114 | 247 | my $dataformulas = $sheetdata->{formulas}; | ||||
483 | 114 | 215 | my $cellerrors = $sheetdata->{cellerrors}; | ||||
484 | 114 | 242 | my $cellattribs = $sheetdata->{cellattribs}; | ||||
485 | 114 | 239 | my $colattribs = $sheetdata->{colattribs}; | ||||
486 | 114 | 230 | my $rowattribs = $sheetdata->{rowattribs}; | ||||
487 | 114 | 209 | my $sheetattribs = $sheetdata->{sheetattribs}; | ||||
488 | 114 | 250 | my $layoutstyles = $sheetdata->{layoutstyles}; | ||||
489 | 114 | 217 | my $layoutstylehash = $sheetdata->{layoutstylehash}; | ||||
490 | 114 | 211 | my $names = $sheetdata->{names}; | ||||
491 | 114 | 531 | my $fonts = $sheetdata->{fonts}; | ||||
492 | 114 | 232 | my $fonthash = $sheetdata->{fonthash}; | ||||
493 | 114 | 207 | my $colors = $sheetdata->{colors}; | ||||
494 | 114 | 187 | my $colorhash = $sheetdata->{colorhash}; | ||||
495 | 114 | 404 | my $borderstyles = $sheetdata->{borderstyles}; | ||||
496 | 114 | 213 | my $borderstylehash = $sheetdata->{borderstylehash}; | ||||
497 | 114 | 203 | my $cellformats = $sheetdata->{cellformats}; | ||||
498 | 114 | 195 | my $cellformathash = $sheetdata->{cellformathash}; | ||||
499 | 114 | 207 | my $valueformats = $sheetdata->{valueformats}; | ||||
500 | 114 | 300 | my $valueformathash = $sheetdata->{valueformathash}; | ||||
501 | |||||||
502 | 114 | 198 | my ($coord, $type, $rest); | ||||
503 | 0 | 0 | my ($linetype, $value, $valuetype, $formula, $style, $namename, $namedesc); | ||||
504 | 0 | 0 | my ($fontnum, $layoutnum, $colornum, $check, $row, $col); | ||||
505 | 0 | 0 | my $errortext; | ||||
506 | my ( | ||||||
507 | 0 | 0 | $clipdatavalues, $clipdatatypes, $clipvaluetypes, | ||||
508 | $clipdataformulas, $clipcellerrors, $clipcellattribs | ||||||
509 | ); | ||||||
510 | 114 | 246 | my ($maxcol, $maxrow) = (0, 0); | ||||
511 | |||||||
512 | 114 | 299 | foreach my $line (@$lines) { | ||||
513 | 5170 | 6022 | chomp $line; | ||||
514 | 5170 | 6098 | $line =~ s/\r//g; | ||||
515 | |||||||
516 | # assumed already done in read. # $line =~ s/^\x{EF}\x{BB}\x{BF}//; # remove UTF-8 Byte Order Mark if present | ||||||
517 | 5170 | 12402 | my ($linetype, $rest) = split (/:/, $line, 2); | ||||
518 | 5170 | 100 | 9687 | next unless $linetype; | |||
519 | |||||||
520 | 5150 | 100 | 8807 | if ($linetype eq "cell") { | |||
50 | |||||||
50 | |||||||
100 | |||||||
100 | |||||||
50 | |||||||
50 | |||||||
50 | |||||||
50 | |||||||
50 | |||||||
50 | |||||||
50 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
521 | 5067 | 17179 | ($coord, $type, $rest) = split (/:/, $rest, 3); | ||||
522 | 5067 | 16866 | $coord = uc($coord); | ||||
523 | 5067 | 50 | 21384 | $cellattribs->{$coord} = { 'coord' => $coord } | |||
524 | if $type; # Must have this if cell has anything | ||||||
525 | 5067 | 9699 | ($col, $row) = coord_to_cr($coord); | ||||
526 | 5067 | 100 | 10973 | $maxcol = $col if $col > $maxcol; | |||
527 | 5067 | 100 | 10507 | $maxrow = $row if $row > $maxrow; | |||
528 | 5067 | 9431 | while ($type) { | ||||
529 | 5087 | 100 | 11624 | if ($type eq "v") { | |||
100 | |||||||
50 | |||||||
100 | |||||||
100 | |||||||
50 | |||||||
50 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
530 | 2423 | 5672 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
531 | 2423 | 4284 | $datavalues->{$coord} = decode_from_save($value); | ||||
532 | 2423 | 3774 | $datatypes->{$coord} = "v"; | ||||
533 | 2423 | 8004 | $valuetypes->{$coord} = "n"; | ||||
534 | } elsif ($type eq "t") { | ||||||
535 | 1352 | 3228 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
536 | 1352 | 2718 | $datavalues->{$coord} = decode_from_save($value); | ||||
537 | 1352 | 2393 | $datatypes->{$coord} = "t"; | ||||
538 | 1352 | 4536 | $valuetypes->{$coord} = | ||||
539 | "tw"; # Typed in text is treated as wiki text by default | ||||||
540 | } elsif ($type eq "vt") { | ||||||
541 | 0 | 0 | ($valuetype, $value, $type, $rest) = split (/:/, $rest, 4); | ||||
542 | 0 | 0 | $datavalues->{$coord} = decode_from_save($value); | ||||
543 | 0 | 0 | 0 | if (substr($valuetype, 0, 1) eq "n") { | |||
544 | 0 | 0 | $datatypes->{$coord} = "v"; | ||||
545 | } else { | ||||||
546 | 0 | 0 | $datatypes->{$coord} = "t"; | ||||
547 | } | ||||||
548 | 0 | 0 | $valuetypes->{$coord} = $valuetype; | ||||
549 | } elsif ($type eq "vtf") { | ||||||
550 | 632 | 2184 | ($valuetype, $value, $formula, $type, $rest) = | ||||
551 | split (/:/, $rest, 5); | ||||||
552 | 632 | 1323 | $datavalues->{$coord} = decode_from_save($value); | ||||
553 | 632 | 1025 | $dataformulas->{$coord} = decode_from_save($formula); | ||||
554 | 632 | 1021 | $datatypes->{$coord} = "f"; | ||||
555 | 632 | 2204 | $valuetypes->{$coord} = $valuetype; | ||||
556 | } elsif ($type eq "vtc") { | ||||||
557 | 660 | 2324 | ($valuetype, $value, $formula, $type, $rest) = | ||||
558 | split (/:/, $rest, 5); | ||||||
559 | 660 | 1328 | $datavalues->{$coord} = decode_from_save($value); | ||||
560 | 660 | 1133 | $dataformulas->{$coord} = decode_from_save($formula); | ||||
561 | 660 | 1015 | $datatypes->{$coord} = "c"; | ||||
562 | 660 | 2203 | $valuetypes->{$coord} = $valuetype; | ||||
563 | } elsif ($type eq "vf") { # old format | ||||||
564 | 0 | 0 | ($value, $formula, $type, $rest) = split (/:/, $rest, 4); | ||||
565 | 0 | 0 | $datavalues->{$coord} = decode_from_save($value); | ||||
566 | 0 | 0 | $dataformulas->{$coord} = decode_from_save($formula); | ||||
567 | 0 | 0 | $datatypes->{$coord} = "f"; | ||||
568 | 0 | 0 | 0 | if (substr($value, 0, 1) eq "N") { | |||
0 | |||||||
0 | |||||||
569 | 0 | 0 | $valuetypes->{$coord} = "n"; | ||||
570 | 0 | 0 | $datavalues->{$coord} = | ||||
571 | substr($datavalues->{$coord}, 1); # remove initial type code | ||||||
572 | } elsif (substr($value, 0, 1) eq "T") { | ||||||
573 | 0 | 0 | $valuetypes->{$coord} = "t"; | ||||
574 | 0 | 0 | $datavalues->{$coord} = | ||||
575 | substr($datavalues->{$coord}, 1); # remove initial type code | ||||||
576 | } elsif (substr($value, 0, 1) eq "H") { | ||||||
577 | 0 | 0 | $valuetypes->{$coord} = "th"; | ||||
578 | 0 | 0 | $datavalues->{$coord} = | ||||
579 | substr($datavalues->{$coord}, 1); # remove initial type code | ||||||
580 | } else { | ||||||
581 | 0 | 0 | 0 | $valuetypes->{$coord} = | |||
582 | $valuetypes->{$coord} =~ m/[^0-9+\-\.]/ ? "t" : "n"; | ||||||
583 | } | ||||||
584 | } elsif ($type eq "e") { | ||||||
585 | 20 | 83 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
586 | 20 | 65 | $cellerrors->{$coord} = decode_from_save($value); | ||||
587 | } elsif ($type eq "b") { | ||||||
588 | 0 | 0 | my ($t, $r, $b, $l); | ||||
589 | 0 | 0 | ($t, $r, $b, $l, $type, $rest) = split (/:/, $rest, 6); | ||||
590 | 0 | 0 | $cellattribs->{$coord}->{bt} = $t; | ||||
591 | 0 | 0 | $cellattribs->{$coord}->{br} = $r; | ||||
592 | 0 | 0 | $cellattribs->{$coord}->{bb} = $b; | ||||
593 | 0 | 0 | $cellattribs->{$coord}->{bl} = $l; | ||||
594 | } elsif ($type eq "l") { | ||||||
595 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
596 | 0 | 0 | $cellattribs->{$coord}->{layout} = $value; | ||||
597 | } elsif ($type eq "f") { | ||||||
598 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
599 | 0 | 0 | $cellattribs->{$coord}->{font} = $value; | ||||
600 | } elsif ($type eq "c") { | ||||||
601 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
602 | 0 | 0 | $cellattribs->{$coord}->{color} = $value; | ||||
603 | } elsif ($type eq "bg") { | ||||||
604 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
605 | 0 | 0 | $cellattribs->{$coord}->{bgcolor} = $value; | ||||
606 | } elsif ($type eq "cf") { | ||||||
607 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
608 | 0 | 0 | $cellattribs->{$coord}->{cellformat} = $value; | ||||
609 | } elsif ($type eq "cvf") { # obsolete - only pre 1.2 format | ||||||
610 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
611 | 0 | 0 | $cellattribs->{$coord}->{nontextvalueformat} = $value; | ||||
612 | } elsif ($type eq "ntvf") { | ||||||
613 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
614 | 0 | 0 | $cellattribs->{$coord}->{nontextvalueformat} = $value; | ||||
615 | } elsif ($type eq "tvf") { | ||||||
616 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
617 | 0 | 0 | $cellattribs->{$coord}->{textvalueformat} = $value; | ||||
618 | } elsif ($type eq "colspan") { | ||||||
619 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
620 | 0 | 0 | $cellattribs->{$coord}->{colspan} = $value; | ||||
621 | } elsif ($type eq "rowspan") { | ||||||
622 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
623 | 0 | 0 | $cellattribs->{$coord}->{rowspan} = $value; | ||||
624 | } elsif ($type eq "cssc") { | ||||||
625 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
626 | 0 | 0 | $cellattribs->{$coord}->{cssc} = $value; | ||||
627 | } elsif ($type eq "csss") { | ||||||
628 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
629 | 0 | 0 | $cellattribs->{$coord}->{csss} = decode_from_save($value); | ||||
630 | } elsif ($type eq "mod") { | ||||||
631 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
632 | 0 | 0 | $cellattribs->{$coord}->{mod} = $value; | ||||
633 | } else { | ||||||
634 | 0 | 0 | $errortext = "Unknown type '$type' in line:\n$_\n"; | ||||
635 | 0 | 0 | last; | ||||
636 | } | ||||||
637 | } | ||||||
638 | } elsif ($linetype eq "col") { | ||||||
639 | 0 | 0 | ($coord, $type, $rest) = split (/:/, $rest, 3); | ||||
640 | 0 | 0 | $coord = uc($coord); # normalize to upper case | ||||
641 | 0 | 0 | $colattribs->{$coord} = { 'coord' => $coord }; | ||||
642 | 0 | 0 | while ($type) { | ||||
643 | 0 | 0 | 0 | if ($type eq "w") { | |||
644 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
645 | 0 | 0 | $colattribs->{$coord}->{width} = $value; | ||||
646 | } | ||||||
647 | 0 | 0 | 0 | if ($type eq "hide") { | |||
648 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
649 | 0 | 0 | $colattribs->{$coord}->{hide} = $value; | ||||
650 | } else { | ||||||
651 | 0 | 0 | $errortext = "Unknown type '$type' in line:\n$_\n"; | ||||
652 | 0 | 0 | last; | ||||
653 | } | ||||||
654 | } | ||||||
655 | } elsif ($linetype eq "row") { | ||||||
656 | 0 | 0 | ($coord, $type, $rest) = split (/:/, $rest, 3); | ||||
657 | 0 | 0 | $rowattribs->{$coord} = { 'coord' => $coord }; | ||||
658 | 0 | 0 | while ($type) { | ||||
659 | 0 | 0 | 0 | if ($type eq "h") { | |||
660 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
661 | 0 | 0 | $rowattribs->{$coord}->{height} = $value; | ||||
662 | } | ||||||
663 | 0 | 0 | 0 | if ($type eq "hide") { | |||
664 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
665 | 0 | 0 | $rowattribs->{$coord}->{hide} = $value; | ||||
666 | } else { | ||||||
667 | 0 | 0 | $errortext = "Unknown type '$type' in line:\n$_\n"; | ||||
668 | 0 | 0 | last; | ||||
669 | } | ||||||
670 | } | ||||||
671 | } elsif ($linetype eq "sheet") { | ||||||
672 | 21 | 89 | ($type, $rest) = split (/:/, $rest, 2); | ||||
673 | 21 | 99 | while ($type) { | ||||
674 | 42 | 100 | 242 | if ($type eq "c") { # number of columns | |||
50 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
675 | 21 | 73 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
676 | 21 | 101 | $sheetattribs->{lastcol} = $value; | ||||
677 | } elsif ($type eq "r") { # number of rows | ||||||
678 | 21 | 97 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
679 | 21 | 111 | $sheetattribs->{lastrow} = $value; | ||||
680 | } elsif ($type eq "w") { # default col width | ||||||
681 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
682 | 0 | 0 | $sheetattribs->{defaultcolwidth} = $value; | ||||
683 | } elsif ($type eq "h") { #default row height | ||||||
684 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
685 | 0 | 0 | $sheetattribs->{defaultrowheight} = $value; | ||||
686 | } elsif ($type eq "tf") { #default text format | ||||||
687 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
688 | 0 | 0 | $sheetattribs->{defaulttextformat} = $value; | ||||
689 | } elsif ($type eq "ntf") { #default not text format | ||||||
690 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
691 | 0 | 0 | $sheetattribs->{defaultnontextformat} = $value; | ||||
692 | } elsif ($type eq "layout") { #default layout number | ||||||
693 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
694 | 0 | 0 | $sheetattribs->{defaultlayout} = $value; | ||||
695 | } elsif ($type eq "font") { #default font number | ||||||
696 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
697 | 0 | 0 | $sheetattribs->{defaultfont} = $value; | ||||
698 | } elsif ($type eq "vf") { #default value format number (old) | ||||||
699 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
700 | 0 | 0 | $sheetattribs->{defaultnontextvalueformat} = $value; | ||||
701 | 0 | 0 | $sheetattribs->{defaulttextvalueformat} = ""; | ||||
702 | } elsif ($type eq "tvf") { #default text value format number | ||||||
703 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
704 | 0 | 0 | $sheetattribs->{defaulttextvalueformat} = $value; | ||||
705 | } elsif ($type eq "ntvf") | ||||||
706 | { #default non-text (number) value format number | ||||||
707 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
708 | 0 | 0 | $sheetattribs->{defaultnontextvalueformat} = $value; | ||||
709 | } elsif ($type eq "color") { #default text color | ||||||
710 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
711 | 0 | 0 | $sheetattribs->{defaultcolor} = $value; | ||||
712 | } elsif ($type eq "bgcolor") { #default cell background color | ||||||
713 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
714 | 0 | 0 | $sheetattribs->{defaultbgcolor} = $value; | ||||
715 | } elsif ($type eq "circularreferencecell") | ||||||
716 | { #cell with a circular reference | ||||||
717 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
718 | 0 | 0 | $sheetattribs->{circularreferencecell} = $value; | ||||
719 | } elsif ($type eq "recalc") { #recalc on or off | ||||||
720 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
721 | 0 | 0 | $sheetattribs->{recalc} = $value; | ||||
722 | } elsif ($type eq "needsrecalc") | ||||||
723 | { #recalculation needed, computed values may not be correct | ||||||
724 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
725 | 0 | 0 | $sheetattribs->{needsrecalc} = $value; | ||||
726 | } else { | ||||||
727 | 0 | 0 | $errortext = "Unknown type '$type' in line:\n$_\n"; | ||||
728 | 0 | 0 | last; | ||||
729 | } | ||||||
730 | } | ||||||
731 | } elsif ($linetype eq "name") { | ||||||
732 | 41 | 137 | ($namename, $namedesc, $value) = split (/:/, $rest, 3); | ||||
733 | 41 | 102 | $namename = uc(decode_from_save($namename)); | ||||
734 | 41 | 94 | $names->{$namename}->{desc} = decode_from_save($namedesc); | ||||
735 | 41 | 133 | $names->{$namename}->{definition} = decode_from_save($value); | ||||
736 | } elsif ($linetype eq "layout") { | ||||||
737 | 0 | 0 | ($layoutnum, $value) = split (/:/, $rest, 2); | ||||
738 | 0 | 0 | $layoutstyles->[$layoutnum] = $value; | ||||
739 | 0 | 0 | $layoutstylehash->{$value} = $layoutnum; | ||||
740 | } elsif ($linetype eq "font") { | ||||||
741 | 0 | 0 | ($fontnum, $value) = split (/:/, $rest, 2); | ||||
742 | 0 | 0 | $fonts->[$fontnum] = $value; | ||||
743 | 0 | 0 | $fonthash->{$value} = $fontnum; | ||||
744 | } elsif ($linetype eq "color") { | ||||||
745 | 0 | 0 | ($colornum, $value) = split (/:/, $rest, 2); | ||||
746 | 0 | 0 | $colors->[$colornum] = $value; | ||||
747 | 0 | 0 | $colorhash->{$value} = $colornum; | ||||
748 | } elsif ($linetype eq "border") { | ||||||
749 | 0 | 0 | ($style, $value) = split (/:/, $rest, 2); | ||||
750 | 0 | 0 | $borderstyles->[$style] = $value; | ||||
751 | 0 | 0 | $borderstylehash->{$value} = $style; | ||||
752 | } elsif ($linetype eq "cellformat") { | ||||||
753 | 0 | 0 | ($style, $value) = split (/:/, $rest, 2); | ||||
754 | 0 | 0 | $cellformats->[$style] = decode_from_save($value); | ||||
755 | 0 | 0 | $cellformathash->{$value} = $style; | ||||
756 | } elsif ($linetype eq "valueformat") { | ||||||
757 | 0 | 0 | ($style, $value) = split (/:/, $rest, 2); | ||||
758 | 0 | 0 | $value = decode_from_save($value); | ||||
759 | 0 | 0 | 0 | if ($sheetdata->{version} < 1.2) { # old format definitions - convert | |||
760 | 0 | 0 | 0 | $value = | |||
761 | length($old_formats_map{$value}) >= 1 | ||||||
762 | ? $old_formats_map{$value} | ||||||
763 | : $value; | ||||||
764 | } | ||||||
765 | 0 | 0 | 0 | if ($value eq "General-separator") { # convert from 0.91 | |||
766 | 0 | 0 | $value = "[,]General"; | ||||
767 | } | ||||||
768 | 0 | 0 | $valueformats->[$style] = $value; | ||||
769 | 0 | 0 | $valueformathash->{$value} = $style; | ||||
770 | } elsif ($linetype eq "version") { | ||||||
771 | 21 | 70 | $sheetdata->{version} = $rest; | ||||
772 | } elsif ($linetype eq "") { | ||||||
773 | } elsif ($linetype eq "clipboardrange") { | ||||||
774 | 0 | 0 | $sheetdata->{clipboard} = {}; # clear and create clipboard | ||||
775 | 0 | 0 | $sheetdata->{clipboard}->{datavalues} = {}; | ||||
776 | 0 | 0 | $clipdatavalues = $sheetdata->{clipboard}->{datavalues}; | ||||
777 | 0 | 0 | $sheetdata->{clipboard}->{datatypes} = {}; | ||||
778 | 0 | 0 | $clipdatatypes = $sheetdata->{clipboard}->{datatypes}; | ||||
779 | 0 | 0 | $sheetdata->{clipboard}->{valuetypes} = {}; | ||||
780 | 0 | 0 | $clipvaluetypes = $sheetdata->{clipboard}->{valuetypes}; | ||||
781 | 0 | 0 | $sheetdata->{clipboard}->{formulas} = {}; | ||||
782 | 0 | 0 | $clipdataformulas = $sheetdata->{clipboard}->{formulas}; | ||||
783 | 0 | 0 | $sheetdata->{clipboard}->{cellerrors} = {}; | ||||
784 | 0 | 0 | $clipcellerrors = $sheetdata->{clipboard}->{cellerrors}; | ||||
785 | 0 | 0 | $sheetdata->{clipboard}->{cellattribs} = {}; | ||||
786 | 0 | 0 | $clipcellattribs = $sheetdata->{clipboard}->{cellattribs}; | ||||
787 | |||||||
788 | 0 | 0 | $coord = uc($rest); | ||||
789 | 0 | 0 | $sheetdata->{clipboard}->{range} = $coord; | ||||
790 | } elsif ($linetype eq "clipboard") | ||||||
791 | { # must have a clipboardrange command somewhere before it | ||||||
792 | 0 | 0 | ($coord, $type, $rest) = split (/:/, $rest, 3); | ||||
793 | 0 | 0 | $coord = uc($coord); | ||||
794 | 0 | 0 | 0 | if (!$sheetdata->{clipboard}->{range}) { | |||
795 | 0 | 0 | $errortext = "Missing clipboardrange before clipboard data in file\n"; | ||||
796 | 0 | 0 | $type = "norange"; | ||||
797 | } | ||||||
798 | 0 | 0 | $clipcellattribs->{$coord} = { 'coord', $coord }; | ||||
799 | 0 | 0 | while ($type) { | ||||
800 | 0 | 0 | 0 | if ($type eq "v") { | |||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
801 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
802 | 0 | 0 | $clipdatavalues->{$coord} = decode_from_save($value); | ||||
803 | 0 | 0 | $clipdatatypes->{$coord} = "v"; | ||||
804 | 0 | 0 | $clipvaluetypes->{$coord} = "n"; | ||||
805 | } elsif ($type eq "t") { | ||||||
806 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
807 | 0 | 0 | $clipdatavalues->{$coord} = decode_from_save($value); | ||||
808 | 0 | 0 | $clipdatatypes->{$coord} = "t"; | ||||
809 | 0 | 0 | $clipvaluetypes->{$coord} = | ||||
810 | "tw"; # Typed in text is treated as wiki text by default | ||||||
811 | } elsif ($type eq "vt") { | ||||||
812 | 0 | 0 | ($valuetype, $value, $type, $rest) = split (/:/, $rest, 4); | ||||
813 | 0 | 0 | $clipdatavalues->{$coord} = decode_from_save($value); | ||||
814 | 0 | 0 | 0 | if (substr($valuetype, 0, 1) eq "n") { | |||
815 | 0 | 0 | $clipdatatypes->{$coord} = "v"; | ||||
816 | } else { | ||||||
817 | 0 | 0 | $clipdatatypes->{$coord} = "t"; | ||||
818 | } | ||||||
819 | 0 | 0 | $clipvaluetypes->{$coord} = $valuetype; | ||||
820 | } elsif ($type eq "vtf") { | ||||||
821 | 0 | 0 | ($valuetype, $value, $formula, $type, $rest) = | ||||
822 | split (/:/, $rest, 5); | ||||||
823 | 0 | 0 | $clipdatavalues->{$coord} = decode_from_save($value); | ||||
824 | 0 | 0 | $clipdataformulas->{$coord} = decode_from_save($formula); | ||||
825 | 0 | 0 | $clipdatatypes->{$coord} = "f"; | ||||
826 | 0 | 0 | $clipvaluetypes->{$coord} = $valuetype; | ||||
827 | } elsif ($type eq "vtc") { | ||||||
828 | 0 | 0 | ($valuetype, $value, $formula, $type, $rest) = | ||||
829 | split (/:/, $rest, 5); | ||||||
830 | 0 | 0 | $clipdatavalues->{$coord} = decode_from_save($value); | ||||
831 | 0 | 0 | $clipdataformulas->{$coord} = decode_from_save($formula); | ||||
832 | 0 | 0 | $clipdatatypes->{$coord} = "c"; | ||||
833 | 0 | 0 | $clipvaluetypes->{$coord} = $valuetype; | ||||
834 | } elsif ($type eq "vf") { # old format | ||||||
835 | 0 | 0 | ($value, $formula, $type, $rest) = split (/:/, $rest, 4); | ||||
836 | 0 | 0 | $clipdatavalues->{$coord} = decode_from_save($value); | ||||
837 | 0 | 0 | $clipdataformulas->{$coord} = decode_from_save($formula); | ||||
838 | 0 | 0 | $clipdatatypes->{$coord} = "f"; | ||||
839 | 0 | 0 | 0 | if (substr($value, 0, 1) eq "N") { | |||
0 | |||||||
0 | |||||||
840 | 0 | 0 | $clipvaluetypes->{$coord} = "n"; | ||||
841 | 0 | 0 | $clipdatavalues->{$coord} = | ||||
842 | substr($clipdatavalues->{$coord}, 1); # remove initial type code | ||||||
843 | } elsif (substr($value, 0, 1) eq "T") { | ||||||
844 | 0 | 0 | $clipvaluetypes->{$coord} = "t"; | ||||
845 | 0 | 0 | $clipdatavalues->{$coord} = | ||||
846 | substr($clipdatavalues->{$coord}, 1); # remove initial type code | ||||||
847 | } elsif (substr($value, 0, 1) eq "H") { | ||||||
848 | 0 | 0 | $clipvaluetypes->{$coord} = "th"; | ||||
849 | 0 | 0 | $clipdatavalues->{$coord} = | ||||
850 | substr($clipdatavalues->{$coord}, 1); # remove initial type code | ||||||
851 | } else { | ||||||
852 | 0 | 0 | 0 | $clipvaluetypes->{$coord} = | |||
853 | $clipvaluetypes->{$coord} =~ m/[^0-9+\-\.]/ ? "t" : "n"; | ||||||
854 | } | ||||||
855 | } elsif ($type eq "e") { | ||||||
856 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
857 | 0 | 0 | $clipcellerrors->{$coord} = decode_from_save($value); | ||||
858 | } elsif ($type eq "b") { | ||||||
859 | 0 | 0 | my ($t, $r, $b, $l); | ||||
860 | 0 | 0 | ($t, $r, $b, $l, $type, $rest) = split (/:/, $rest, 6); | ||||
861 | 0 | 0 | $clipcellattribs->{$coord}->{bt} = $t; | ||||
862 | 0 | 0 | $clipcellattribs->{$coord}->{br} = $r; | ||||
863 | 0 | 0 | $clipcellattribs->{$coord}->{bb} = $b; | ||||
864 | 0 | 0 | $clipcellattribs->{$coord}->{bl} = $l; | ||||
865 | } elsif ($type eq "l") { | ||||||
866 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
867 | 0 | 0 | $clipcellattribs->{$coord}->{layout} = $value; | ||||
868 | } elsif ($type eq "f") { | ||||||
869 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
870 | 0 | 0 | $clipcellattribs->{$coord}->{font} = $value; | ||||
871 | } elsif ($type eq "c") { | ||||||
872 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
873 | 0 | 0 | $clipcellattribs->{$coord}->{color} = $value; | ||||
874 | } elsif ($type eq "bg") { | ||||||
875 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
876 | 0 | 0 | $clipcellattribs->{$coord}->{bgcolor} = $value; | ||||
877 | } elsif ($type eq "cf") { | ||||||
878 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
879 | 0 | 0 | $clipcellattribs->{$coord}->{cellformat} = $value; | ||||
880 | } elsif ($type eq "cvf") { # old | ||||||
881 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
882 | 0 | 0 | $clipcellattribs->{$coord}->{nontextvalueformat} = $value; | ||||
883 | } elsif ($type eq "ntvf") { | ||||||
884 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
885 | 0 | 0 | $clipcellattribs->{$coord}->{nontextvalueformat} = $value; | ||||
886 | } elsif ($type eq "tvf") { | ||||||
887 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
888 | 0 | 0 | $clipcellattribs->{$coord}->{textvalueformat} = $value; | ||||
889 | } elsif ($type eq "colspan") { | ||||||
890 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
891 | 0 | 0 | $clipcellattribs->{$coord}->{colspan} = $value; | ||||
892 | } elsif ($type eq "rowspan") { | ||||||
893 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
894 | 0 | 0 | $clipcellattribs->{$coord}->{rowspan} = $value; | ||||
895 | } elsif ($type eq "cssc") { | ||||||
896 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
897 | 0 | 0 | $clipcellattribs->{$coord}->{cssc} = $value; | ||||
898 | } elsif ($type eq "csss") { | ||||||
899 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
900 | 0 | 0 | $clipcellattribs->{$coord}->{csss} = decode_from_save($value); | ||||
901 | } elsif ($type eq "mod") { | ||||||
902 | 0 | 0 | ($value, $type, $rest) = split (/:/, $rest, 3); | ||||
903 | 0 | 0 | $clipcellattribs->{$coord}->{mod} = $value; | ||||
904 | } elsif ($type eq "norange") { | ||||||
905 | 0 | 0 | last; | ||||
906 | } else { | ||||||
907 | 0 | 0 | $errortext = "Unknown type '$type' in line:\n$_\n"; | ||||
908 | 0 | 0 | last; | ||||
909 | } | ||||||
910 | } | ||||||
911 | } else { | ||||||
912 | |||||||
913 | #!!!!!! | ||||||
914 | 0 | 0 | 0 | $errortext = "Unknown linetype: $linetype\n" | |||
915 | unless $linetype =~ m/^\s*#/; | ||||||
916 | } | ||||||
917 | } | ||||||
918 | |||||||
919 | 114 | 50 | 1095 | $sheetattribs->{lastcol} ||= $maxcol || 1; | |||
66 | |||||||
920 | 114 | 50 | 1158 | $sheetattribs->{lastrow} ||= $maxrow || 1; | |||
66 | |||||||
921 | } | ||||||
922 | |||||||
923 | =head2 create_sheet_save | ||||||
924 | |||||||
925 | my $outstr = create_sheet_save(\%sheetdata) | ||||||
926 | |||||||
927 | Sheet output routine. Returns a string ready to be saved in a file. | ||||||
928 | |||||||
929 | =cut | ||||||
930 | |||||||
931 | sub create_sheet_save { | ||||||
932 | |||||||
933 | my ( | ||||||
934 | 0 | 0 | 1 | 0 | $rest, $linetype, $coord, $type, $value, $formula, $style, | ||
935 | $colornum, $check, $maxrow, $maxcol, $row, $col | ||||||
936 | ); | ||||||
937 | |||||||
938 | 0 | 0 | my $sheetdata = shift @_; | ||||
939 | 0 | 0 | my $outstr; | ||||
940 | |||||||
941 | # Get references to the parts | ||||||
942 | |||||||
943 | 0 | 0 | my $datavalues = $sheetdata->{datavalues}; | ||||
944 | 0 | 0 | my $datatypes = $sheetdata->{datatypes}; | ||||
945 | 0 | 0 | my $valuetypes = $sheetdata->{valuetypes}; | ||||
946 | 0 | 0 | my $dataformulas = $sheetdata->{formulas}; | ||||
947 | 0 | 0 | my $cellerrors = $sheetdata->{cellerrors}; | ||||
948 | 0 | 0 | my $cellattribs = $sheetdata->{cellattribs}; | ||||
949 | 0 | 0 | my $colattribs = $sheetdata->{colattribs}; | ||||
950 | 0 | 0 | my $rowattribs = $sheetdata->{rowattribs}; | ||||
951 | 0 | 0 | my $sheetattribs = $sheetdata->{sheetattribs}; | ||||
952 | 0 | 0 | my $layoutstyles = $sheetdata->{layoutstyles}; | ||||
953 | 0 | 0 | my $layoutstylehash = $sheetdata->{layoutstylehash}; | ||||
954 | 0 | 0 | my $names = $sheetdata->{names}; | ||||
955 | 0 | 0 | my $fonts = $sheetdata->{fonts}; | ||||
956 | 0 | 0 | my $fonthash = $sheetdata->{fonthash}; | ||||
957 | 0 | 0 | my $colors = $sheetdata->{colors}; | ||||
958 | 0 | 0 | my $colorhash = $sheetdata->{colorhash}; | ||||
959 | 0 | 0 | my $borderstyles = $sheetdata->{borderstyles}; | ||||
960 | 0 | 0 | my $borderstylehash = $sheetdata->{borderstylehash}; | ||||
961 | 0 | 0 | my $cellformats = $sheetdata->{cellformats}; | ||||
962 | 0 | 0 | my $cellformathash = $sheetdata->{cellformathash}; | ||||
963 | 0 | 0 | my $valueformats = $sheetdata->{valueformats}; | ||||
964 | 0 | 0 | my $valueformathash = $sheetdata->{valueformathash}; | ||||
965 | |||||||
966 | 0 | 0 | $outstr .= "version:1.3\n"; # sheet save version | ||||
967 | |||||||
968 | 0 | 0 | for (my $row = 1 ; $row <= $sheetattribs->{lastrow} ; $row++) { | ||||
969 | 0 | 0 | for (my $col = 1 ; $col <= $sheetattribs->{lastcol} ; $col++) { | ||||
970 | 0 | 0 | $coord = cr_to_coord($col, $row); | ||||
971 | next | ||||||
972 | 0 | 0 | 0 | unless $cellattribs->{$coord} | |||
973 | ->{coord}; # skip if nothing set for this one | ||||||
974 | 0 | 0 | $outstr .= "cell:$coord"; | ||||
975 | 0 | 0 | 0 | if ($datatypes->{$coord} eq "v") { | |||
0 | |||||||
0 | |||||||
0 | |||||||
976 | 0 | 0 | $value = encode_for_save($datavalues->{$coord}); | ||||
977 | 0 | 0 | 0 | 0 | if (!$valuetypes->{$coord} || $valuetypes->{$coord} eq "n") | ||
978 | { # use simpler version | ||||||
979 | 0 | 0 | $outstr .= ":v:$value"; | ||||
980 | } else { # if we do fancy parsing to determine a type | ||||||
981 | 0 | 0 | $outstr .= ":vt:$valuetypes->{$coord}:$value"; | ||||
982 | } | ||||||
983 | } elsif ($datatypes->{$coord} eq "t") { | ||||||
984 | 0 | 0 | $value = encode_for_save($datavalues->{$coord}); | ||||
985 | 0 | 0 | 0 | 0 | if (!$valuetypes->{$coord} || $valuetypes->{$coord} eq "tw") | ||
986 | { # use simpler version | ||||||
987 | 0 | 0 | $outstr .= ":t:$value"; | ||||
988 | } else { # if we do fancy parsing to determine a type | ||||||
989 | 0 | 0 | $outstr .= ":vt:$valuetypes->{$coord}:$value"; | ||||
990 | } | ||||||
991 | } elsif ($datatypes->{$coord} eq "f") { | ||||||
992 | 0 | 0 | $value = encode_for_save($datavalues->{$coord}); | ||||
993 | 0 | 0 | $formula = encode_for_save($dataformulas->{$coord}); | ||||
994 | 0 | 0 | $outstr .= ":vtf:$valuetypes->{$coord}:$value:$formula"; | ||||
995 | } elsif ($datatypes->{$coord} eq "c") { | ||||||
996 | 0 | 0 | $value = encode_for_save($datavalues->{$coord}); | ||||
997 | 0 | 0 | $formula = encode_for_save($dataformulas->{$coord}); | ||||
998 | 0 | 0 | $outstr .= ":vtc:$valuetypes->{$coord}:$value:$formula"; | ||||
999 | } | ||||||
1000 | |||||||
1001 | 0 | 0 | 0 | if ($cellerrors->{$coord}) { | |||
1002 | 0 | 0 | $value = encode_for_save($cellerrors->{$coord}); | ||||
1003 | 0 | 0 | $outstr .= ":e:$value"; | ||||
1004 | } | ||||||
1005 | |||||||
1006 | 0 | 0 | my ($t, $r, $b, $l); | ||||
1007 | 0 | 0 | $t = $cellattribs->{$coord}->{bt}; | ||||
1008 | 0 | 0 | $r = $cellattribs->{$coord}->{br}; | ||||
1009 | 0 | 0 | $b = $cellattribs->{$coord}->{bb}; | ||||
1010 | 0 | 0 | $l = $cellattribs->{$coord}->{bl}; | ||||
1011 | 0 | 0 | 0 | 0 | $outstr .= ":b:$t:$r:$b:$l" if ($t || $r || $b || $l); | ||
0 | |||||||
0 | |||||||
1012 | |||||||
1013 | 0 | 0 | 0 | $outstr .= ":l:$cellattribs->{$coord}->{layout}" | |||
1014 | if $cellattribs->{$coord}->{layout}; | ||||||
1015 | 0 | 0 | 0 | $outstr .= ":f:$cellattribs->{$coord}->{font}" | |||
1016 | if $cellattribs->{$coord}->{font}; | ||||||
1017 | 0 | 0 | 0 | $outstr .= ":c:$cellattribs->{$coord}->{color}" | |||
1018 | if $cellattribs->{$coord}->{color}; | ||||||
1019 | 0 | 0 | 0 | $outstr .= ":bg:$cellattribs->{$coord}->{bgcolor}" | |||
1020 | if $cellattribs->{$coord}->{bgcolor}; | ||||||
1021 | 0 | 0 | 0 | $outstr .= ":cf:$cellattribs->{$coord}->{cellformat}" | |||
1022 | if $cellattribs->{$coord}->{cellformat}; | ||||||
1023 | 0 | 0 | 0 | $outstr .= ":tvf:$cellattribs->{$coord}->{textvalueformat}" | |||
1024 | if $cellattribs->{$coord}->{textvalueformat}; | ||||||
1025 | 0 | 0 | 0 | $outstr .= ":ntvf:$cellattribs->{$coord}->{nontextvalueformat}" | |||
1026 | if $cellattribs->{$coord}->{nontextvalueformat}; | ||||||
1027 | 0 | 0 | 0 | $outstr .= ":colspan:$cellattribs->{$coord}->{colspan}" | |||
1028 | if $cellattribs->{$coord}->{colspan}; | ||||||
1029 | 0 | 0 | 0 | $outstr .= ":rowspan:$cellattribs->{$coord}->{rowspan}" | |||
1030 | if $cellattribs->{$coord}->{rowspan}; | ||||||
1031 | 0 | 0 | 0 | $outstr .= ":cssc:$cellattribs->{$coord}->{cssc}" | |||
1032 | if $cellattribs->{$coord}->{cssc}; | ||||||
1033 | 0 | 0 | 0 | $outstr .= ":csss:" . encode_for_save($cellattribs->{$coord}->{csss}) | |||
1034 | if $cellattribs->{$coord}->{csss}; | ||||||
1035 | 0 | 0 | 0 | $outstr .= ":mod:$cellattribs->{$coord}->{mod}" | |||
1036 | if $cellattribs->{$coord}->{mod}; | ||||||
1037 | |||||||
1038 | 0 | 0 | $outstr .= "\n"; | ||||
1039 | } | ||||||
1040 | } | ||||||
1041 | |||||||
1042 | 0 | 0 | for (my $col = 1 ; $col <= $sheetattribs->{lastcol} ; $col++) { | ||||
1043 | 0 | 0 | $coord = cr_to_coord($col, 1); | ||||
1044 | 0 | 0 | $coord =~ s/\d+//; | ||||
1045 | 0 | 0 | 0 | $outstr .= "col:$coord:w:$colattribs->{$coord}->{width}\n" | |||
1046 | if $colattribs->{$coord}->{width}; | ||||||
1047 | 0 | 0 | 0 | $outstr .= "col:$coord:hide:$colattribs->{$coord}->{hide}\n" | |||
1048 | if $colattribs->{$coord}->{hide}; | ||||||
1049 | } | ||||||
1050 | |||||||
1051 | 0 | 0 | for (my $row = 1 ; $row <= $sheetattribs->{lastrow} ; $row++) { | ||||
1052 | 0 | 0 | 0 | $outstr .= "row:$row:w:$rowattribs->{$row}->{height}\n" | |||
1053 | if $rowattribs->{$row}->{height}; | ||||||
1054 | 0 | 0 | 0 | $outstr .= "row:$row:hide:$rowattribs->{$row}->{hide}\n" | |||
1055 | if $rowattribs->{$row}->{hide}; | ||||||
1056 | } | ||||||
1057 | |||||||
1058 | 0 | 0 | $outstr .= "sheet"; | ||||
1059 | 0 | 0 | foreach my $field (keys %sheetfields) { | ||||
1060 | 0 | 0 | my $value = encode_for_save($sheetattribs->{$field}); | ||||
1061 | 0 | 0 | 0 | $outstr .= ":$sheetfields{$field}:$value" if $value; | |||
1062 | } | ||||||
1063 | 0 | 0 | $outstr .= "\n"; | ||||
1064 | |||||||
1065 | 0 | 0 | foreach my $namename (sort keys %$names) { | ||||
1066 | 0 | 0 | my $namesc = encode_for_save(uc $namename); | ||||
1067 | 0 | 0 | my $namedescsc = encode_for_save($names->{$namename}->{desc}); | ||||
1068 | 0 | 0 | my $namedefinitionsc = encode_for_save($names->{$namename}->{definition}); | ||||
1069 | 0 | 0 | $outstr .= "name:$namesc:$namedescsc:$namedefinitionsc\n"; | ||||
1070 | } | ||||||
1071 | |||||||
1072 | 0 | 0 | for (my $i = 1 ; $i < @$layoutstyles ; $i++) { | ||||
1073 | 0 | 0 | $outstr .= "layout:$i:$layoutstyles->[$i]\n"; | ||||
1074 | } | ||||||
1075 | |||||||
1076 | 0 | 0 | for (my $i = 1 ; $i < @$fonts ; $i++) { | ||||
1077 | 0 | 0 | $outstr .= "font:$i:$fonts->[$i]\n"; | ||||
1078 | } | ||||||
1079 | |||||||
1080 | 0 | 0 | for (my $i = 1 ; $i < @$colors ; $i++) { | ||||
1081 | 0 | 0 | $outstr .= "color:$i:$colors->[$i]\n"; | ||||
1082 | } | ||||||
1083 | |||||||
1084 | 0 | 0 | for (my $i = 1 ; $i < @$borderstyles ; $i++) { | ||||
1085 | 0 | 0 | $outstr .= "border:$i:$borderstyles->[$i]\n"; | ||||
1086 | } | ||||||
1087 | |||||||
1088 | 0 | 0 | for (my $i = 1 ; $i < @$cellformats ; $i++) { | ||||
1089 | 0 | 0 | $style = encode_for_save($cellformats->[$i]); | ||||
1090 | 0 | 0 | $outstr .= "cellformat:$i:$style\n"; | ||||
1091 | } | ||||||
1092 | |||||||
1093 | 0 | 0 | for (my $i = 1 ; $i < @$valueformats ; $i++) { | ||||
1094 | 0 | 0 | $style = encode_for_save($valueformats->[$i]); | ||||
1095 | 0 | 0 | $outstr .= "valueformat:$i:$style\n"; | ||||
1096 | } | ||||||
1097 | |||||||
1098 | 0 | 0 | 0 | if ($sheetdata->{clipboard}) { | |||
1099 | 0 | 0 | my $clipdatavalues = $sheetdata->{clipboard}->{datavalues}; | ||||
1100 | 0 | 0 | my $clipdatatypes = $sheetdata->{clipboard}->{datatypes}; | ||||
1101 | 0 | 0 | my $clipvaluetypes = $sheetdata->{clipboard}->{valuetypes}; | ||||
1102 | 0 | 0 | my $clipdataformulas = $sheetdata->{clipboard}->{formulas}; | ||||
1103 | 0 | 0 | my $clipcellerrors = $sheetdata->{clipboard}->{cellerrors}; | ||||
1104 | 0 | 0 | my $clipcellattribs = $sheetdata->{clipboard}->{cellattribs}; | ||||
1105 | |||||||
1106 | 0 | 0 | $outstr .= "clipboardrange:$sheetdata->{clipboard}->{range}\n"; | ||||
1107 | |||||||
1108 | 0 | 0 | foreach my $coord (sort keys %$clipcellattribs) { | ||||
1109 | 0 | 0 | $outstr .= "clipboard:$coord"; | ||||
1110 | 0 | 0 | 0 | if ($clipdatatypes->{$coord} eq "v") { | |||
0 | |||||||
0 | |||||||
0 | |||||||
1111 | 0 | 0 | $value = encode_for_save($clipdatavalues->{$coord}); | ||||
1112 | 0 | 0 | 0 | 0 | if (!$clipvaluetypes->{$coord} || $clipvaluetypes->{$coord} eq "n") | ||
1113 | { # use simpler version | ||||||
1114 | 0 | 0 | $outstr .= ":v:$value"; | ||||
1115 | } else { # if we do fancy parsing to determine a type | ||||||
1116 | 0 | 0 | $outstr .= ":vt:$clipvaluetypes->{$coord}:$value"; | ||||
1117 | } | ||||||
1118 | } elsif ($clipdatatypes->{$coord} eq "t") { | ||||||
1119 | 0 | 0 | $value = encode_for_save($clipdatavalues->{$coord}); | ||||
1120 | 0 | 0 | 0 | 0 | if (!$clipvaluetypes->{$coord} || $clipvaluetypes->{$coord} eq "tw") | ||
1121 | { # use simpler version | ||||||
1122 | 0 | 0 | $outstr .= ":t:$value"; | ||||
1123 | } else { # if we do fancy parsing to determine a type | ||||||
1124 | 0 | 0 | $outstr .= ":vt:$clipvaluetypes->{$coord}:$value"; | ||||
1125 | } | ||||||
1126 | } elsif ($clipdatatypes->{$coord} eq "f") { | ||||||
1127 | 0 | 0 | $value = encode_for_save($clipdatavalues->{$coord}); | ||||
1128 | 0 | 0 | $formula = encode_for_save($clipdataformulas->{$coord}); | ||||
1129 | 0 | 0 | $outstr .= ":vtf:$clipvaluetypes->{$coord}:$value:$formula"; | ||||
1130 | } elsif ($clipdatatypes->{$coord} eq "c") { | ||||||
1131 | 0 | 0 | $value = encode_for_save($clipdatavalues->{$coord}); | ||||
1132 | 0 | 0 | $formula = encode_for_save($clipdataformulas->{$coord}); | ||||
1133 | 0 | 0 | $outstr .= ":vtc:$clipvaluetypes->{$coord}:$value:$formula"; | ||||
1134 | } | ||||||
1135 | |||||||
1136 | 0 | 0 | 0 | if ($clipcellerrors->{$coord}) { | |||
1137 | 0 | 0 | $value = encode_for_save($clipcellerrors->{$coord}); | ||||
1138 | 0 | 0 | $outstr .= ":e:$value"; | ||||
1139 | } | ||||||
1140 | |||||||
1141 | 0 | 0 | my ($t, $r, $b, $l); | ||||
1142 | 0 | 0 | $t = $clipcellattribs->{$coord}->{bt}; | ||||
1143 | 0 | 0 | $r = $clipcellattribs->{$coord}->{br}; | ||||
1144 | 0 | 0 | $b = $clipcellattribs->{$coord}->{bb}; | ||||
1145 | 0 | 0 | $l = $clipcellattribs->{$coord}->{bl}; | ||||
1146 | 0 | 0 | 0 | 0 | $outstr .= ":b:$t:$r:$b:$l" if ($t || $r || $b || $l); | ||
0 | |||||||
0 | |||||||
1147 | |||||||
1148 | 0 | 0 | 0 | $outstr .= ":l:$clipcellattribs->{$coord}->{layout}" | |||
1149 | if $clipcellattribs->{$coord}->{layout}; | ||||||
1150 | 0 | 0 | 0 | $outstr .= ":f:$clipcellattribs->{$coord}->{font}" | |||
1151 | if $clipcellattribs->{$coord}->{font}; | ||||||
1152 | 0 | 0 | 0 | $outstr .= ":c:$clipcellattribs->{$coord}->{color}" | |||
1153 | if $clipcellattribs->{$coord}->{color}; | ||||||
1154 | 0 | 0 | 0 | $outstr .= ":bg:$clipcellattribs->{$coord}->{bgcolor}" | |||
1155 | if $clipcellattribs->{$coord}->{bgcolor}; | ||||||
1156 | 0 | 0 | 0 | $outstr .= ":cf:$clipcellattribs->{$coord}->{cellformat}" | |||
1157 | if $clipcellattribs->{$coord}->{cellformat}; | ||||||
1158 | 0 | 0 | 0 | $outstr .= ":tvf:$clipcellattribs->{$coord}->{textvalueformat}" | |||
1159 | if $clipcellattribs->{$coord}->{textvalueformat}; | ||||||
1160 | 0 | 0 | 0 | $outstr .= ":ntvf:$clipcellattribs->{$coord}->{nontextvalueformat}" | |||
1161 | if $clipcellattribs->{$coord}->{nontextvalueformat}; | ||||||
1162 | 0 | 0 | 0 | $outstr .= ":colspan:$clipcellattribs->{$coord}->{colspan}" | |||
1163 | if $clipcellattribs->{$coord}->{colspan}; | ||||||
1164 | 0 | 0 | 0 | $outstr .= ":rowspan:$clipcellattribs->{$coord}->{rowspan}" | |||
1165 | if $clipcellattribs->{$coord}->{rowspan}; | ||||||
1166 | 0 | 0 | 0 | $outstr .= ":cssc:$clipcellattribs->{$coord}->{cssc}" | |||
1167 | if $clipcellattribs->{$coord}->{cssc}; | ||||||
1168 | 0 | 0 | 0 | $outstr .= | |||
1169 | ":csss:" . encode_for_save($clipcellattribs->{$coord}->{csss}) | ||||||
1170 | if $clipcellattribs->{$coord}->{csss}; | ||||||
1171 | 0 | 0 | 0 | $outstr .= ":mod:$clipcellattribs->{$coord}->{mod}" | |||
1172 | if $clipcellattribs->{$coord}->{mod}; | ||||||
1173 | |||||||
1174 | 0 | 0 | $outstr .= "\n"; | ||||
1175 | } | ||||||
1176 | |||||||
1177 | } | ||||||
1178 | |||||||
1179 | 0 | 0 | return $outstr; | ||||
1180 | } | ||||||
1181 | |||||||
1182 | =head2 execute_sheet_command | ||||||
1183 | |||||||
1184 | $ok = execute_sheet_command($sheetdata, $command); | ||||||
1185 | |||||||
1186 | Executes commands that modify the sheet data. Sets sheet "needsrecalc" as needed. | ||||||
1187 | |||||||
1188 | The commands are in the forms: | ||||||
1189 | |||||||
1190 | set sheet attributename value (plus lastcol and lastrow) | ||||||
1191 | set 22 attributename value | ||||||
1192 | set B attributename value | ||||||
1193 | set A1 attributename value1 value2... (see each attribute below for details) | ||||||
1194 | set A1:B5 attributename value1 value2... | ||||||
1195 | erase/copy/cut/paste/fillright/filldown A1:B5 all/formulas/format | ||||||
1196 | clearclipboard | ||||||
1197 | merge C3:F3 | ||||||
1198 | unmerge C3 | ||||||
1199 | insertcol/insertrow C5 | ||||||
1200 | deletecol/deleterow C5:E7 | ||||||
1201 | name define NAME definition | ||||||
1202 | name desc NAME description | ||||||
1203 | name delete NAME | ||||||
1204 | |||||||
1205 | =cut | ||||||
1206 | |||||||
1207 | sub execute_sheet_command { | ||||||
1208 | |||||||
1209 | 679 | 679 | 1 | 1546 | my ($sheetdata, $command) = @_; | ||
1210 | |||||||
1211 | # Get references to the parts | ||||||
1212 | |||||||
1213 | 679 | 1609 | my $datavalues = $sheetdata->{datavalues}; | ||||
1214 | 679 | 1657 | my $datatypes = $sheetdata->{datatypes}; | ||||
1215 | 679 | 1294 | my $valuetypes = $sheetdata->{valuetypes}; | ||||
1216 | 679 | 1349 | my $dataformulas = $sheetdata->{formulas}; | ||||
1217 | 679 | 1280 | my $cellerrors = $sheetdata->{cellerrors}; | ||||
1218 | 679 | 1338 | my $cellattribs = $sheetdata->{cellattribs}; | ||||
1219 | 679 | 1239 | my $colattribs = $sheetdata->{colattribs}; | ||||
1220 | 679 | 1432 | my $rowattribs = $sheetdata->{rowattribs}; | ||||
1221 | 679 | 1165 | my $sheetattribs = $sheetdata->{sheetattribs}; | ||||
1222 | 679 | 1298 | my $layoutstyles = $sheetdata->{layoutstyles}; | ||||
1223 | 679 | 1357 | my $layoutstylehash = $sheetdata->{layoutstylehash}; | ||||
1224 | 679 | 1283 | my $names = $sheetdata->{names}; | ||||
1225 | 679 | 1240 | my $fonts = $sheetdata->{fonts}; | ||||
1226 | 679 | 1314 | my $fonthash = $sheetdata->{fonthash}; | ||||
1227 | 679 | 1161 | my $colors = $sheetdata->{colors}; | ||||
1228 | 679 | 1141 | my $colorhash = $sheetdata->{colorhash}; | ||||
1229 | 679 | 1557 | my $borderstyles = $sheetdata->{borderstyles}; | ||||
1230 | 679 | 1084 | my $borderstylehash = $sheetdata->{borderstylehash}; | ||||
1231 | 679 | 1154 | my $cellformats = $sheetdata->{cellformats}; | ||||
1232 | 679 | 3096 | my $cellformathash = $sheetdata->{cellformathash}; | ||||
1233 | 679 | 1235 | my $valueformats = $sheetdata->{valueformats}; | ||||
1234 | 679 | 1118 | my $valueformathash = $sheetdata->{valueformathash}; | ||||
1235 | |||||||
1236 | my ( | ||||||
1237 | 679 | 1092 | $what, $coord1, $coord2, $attrib, $name, | ||||
1238 | $value, $v1, $v2, $v3, $errortext | ||||||
1239 | ); | ||||||
1240 | |||||||
1241 | 679 | 3150 | my ($cmd1, $rest) = split (/ /, $command, 2); | ||||
1242 | 679 | 50 | 2014 | return unless $cmd1; | |||
1243 | |||||||
1244 | 679 | 100 | 33 | 2008 | if ($cmd1 eq "set") { | ||
100 | 33 | ||||||
50 | |||||||
50 | |||||||
50 | |||||||
50 | |||||||
50 | |||||||
100 | |||||||
1245 | 673 | 3129 | ($what, $attrib, $rest) = split (/ /, $rest, 3); | ||||
1246 | 673 | 50 | 10511 | if ($what eq "sheet") { # sheet attributes | |||
50 | |||||||
50 | |||||||
50 | |||||||
1247 | 0 | 0 | 0 | 0 | if ($attrib eq "defaultcolwidth") { | ||
0 | 0 | ||||||
0 | 0 | ||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
1248 | 0 | 0 | $sheetattribs->{defaultcolwidth} = $rest; | ||||
1249 | } elsif ($attrib eq "defaultcolor" || $attrib eq "defaultbgcolor") { | ||||||
1250 | 0 | 0 | my $colordef = 0; | ||||
1251 | 0 | 0 | 0 | $colordef = $colorhash->{$rest} if $rest; | |||
1252 | 0 | 0 | 0 | if (!$colordef) { | |||
1253 | 0 | 0 | 0 | if ($rest) { | |||
1254 | 0 | 0 | 0 | push @$colors, "" unless scalar @$colors; | |||
1255 | 0 | 0 | $colordef = (push @$colors, $rest) - 1; | ||||
1256 | 0 | 0 | $colorhash->{$rest} = $colordef; | ||||
1257 | } | ||||||
1258 | } | ||||||
1259 | 0 | 0 | $sheetattribs->{$attrib} = $colordef; | ||||
1260 | } elsif ($attrib eq "defaultlayout") { | ||||||
1261 | 0 | 0 | my $layoutdef = 0; | ||||
1262 | 0 | 0 | 0 | $layoutdef = $layoutstylehash->{$rest} if $rest; | |||
1263 | 0 | 0 | 0 | if (!$layoutdef) { | |||
1264 | 0 | 0 | 0 | if ($rest) { | |||
1265 | 0 | 0 | 0 | push @$layoutstyles, "" unless scalar @$layoutstyles; | |||
1266 | 0 | 0 | $layoutdef = (push @$layoutstyles, $rest) - 1; | ||||
1267 | 0 | 0 | $layoutstylehash->{$rest} = $layoutdef; | ||||
1268 | } | ||||||
1269 | } | ||||||
1270 | 0 | 0 | $sheetattribs->{$attrib} = $layoutdef; | ||||
1271 | } elsif ($attrib eq "defaultfont") { | ||||||
1272 | 0 | 0 | my $fontdef = 0; | ||||
1273 | 0 | 0 | 0 | $rest = "" if $rest eq "* * *"; | |||
1274 | 0 | 0 | 0 | $fontdef = $fonthash->{$rest} if $rest; | |||
1275 | 0 | 0 | 0 | if (!$fontdef) { | |||
1276 | 0 | 0 | 0 | if ($rest) { | |||
1277 | 0 | 0 | 0 | push @$fonts, "" unless scalar @$fonts; | |||
1278 | 0 | 0 | $fontdef = (push @$fonts, $rest) - 1; | ||||
1279 | 0 | 0 | $fonthash->{$rest} = $fontdef; | ||||
1280 | } | ||||||
1281 | } | ||||||
1282 | 0 | 0 | $sheetattribs->{$attrib} = $fontdef; | ||||
1283 | } elsif ($attrib eq "defaulttextformat" | ||||||
1284 | || $attrib eq "defaultnontextformat") { | ||||||
1285 | 0 | 0 | my $formatdef = 0; | ||||
1286 | 0 | 0 | 0 | $formatdef = $cellformathash->{$rest} if $rest; | |||
1287 | 0 | 0 | 0 | if (!$formatdef) { | |||
1288 | 0 | 0 | 0 | if ($rest) { | |||
1289 | 0 | 0 | 0 | push @$cellformats, "" unless scalar @$cellformats; | |||
1290 | 0 | 0 | $formatdef = (push @$cellformats, $rest) - 1; | ||||
1291 | 0 | 0 | $cellformathash->{$rest} = $formatdef; | ||||
1292 | } | ||||||
1293 | } | ||||||
1294 | 0 | 0 | $sheetattribs->{$attrib} = $formatdef; | ||||
1295 | } elsif ($attrib eq "defaulttextvalueformat" | ||||||
1296 | || $attrib eq "defaultnontextvalueformat") { | ||||||
1297 | 0 | 0 | my $formatdef = 0; | ||||
1298 | 0 | 0 | 0 | $formatdef = $valueformathash->{$rest} if length($rest); | |||
1299 | 0 | 0 | 0 | if (!$formatdef) { | |||
1300 | 0 | 0 | 0 | if (length($rest)) { | |||
1301 | 0 | 0 | 0 | push @$valueformats, "" unless scalar @$valueformats; | |||
1302 | 0 | 0 | $formatdef = (push @$valueformats, $rest) - 1; | ||||
1303 | 0 | 0 | $valueformathash->{$rest} = $formatdef; | ||||
1304 | } | ||||||
1305 | } | ||||||
1306 | 0 | 0 | $sheetattribs->{$attrib} = $formatdef; | ||||
1307 | } elsif ($attrib eq "lastcol") { | ||||||
1308 | 0 | 0 | $sheetattribs->{lastcol} = $rest + 0; | ||||
1309 | 0 | 0 | 0 | $sheetattribs->{lastcol} = 1 if ($sheetattribs->{lastcol} <= 0); | |||
1310 | } elsif ($attrib eq "lastrow") { | ||||||
1311 | 0 | 0 | $sheetattribs->{lastrow} = $rest + 0; | ||||
1312 | 0 | 0 | 0 | $sheetattribs->{lastrow} = 1 if ($sheetattribs->{lastrow} <= 0); | |||
1313 | } | ||||||
1314 | } elsif ($what =~ m/^(\d+)(\:(\d+)){0,1}$/) { # row attributes | ||||||
1315 | 0 | 0 | my ($row1, $row2); | ||||
1316 | 0 | 0 | 0 | if ($what =~ m/^(.+?):(.+?)$/) { | |||
1317 | 0 | 0 | $row1 = $1; | ||||
1318 | 0 | 0 | $row2 = $2; | ||||
1319 | } else { | ||||||
1320 | 0 | 0 | $row1 = $what; | ||||
1321 | 0 | 0 | $row2 = $row1; | ||||
1322 | } | ||||||
1323 | 0 | 0 | 0 | if ($attrib eq "hide") { | |||
1324 | 0 | 0 | for (my $r = $row1 ; $r <= $row2 ; $r++) { | ||||
1325 | 0 | 0 | 0 | $rowattribs->{$r} = { 'coord' => $r } unless $rowattribs->{$r}; | |||
1326 | 0 | 0 | $rowattribs->{$r}->{hide} = $rest; | ||||
1327 | } | ||||||
1328 | } else { | ||||||
1329 | 0 | 0 | $errortext = "Unknown attributename '$attrib' in line:\n$command\n"; | ||||
1330 | 0 | 0 | return 0; | ||||
1331 | } | ||||||
1332 | } elsif ($what =~ m/(^[a-zA-Z])([a-zA-Z])?(:[a-zA-Z][a-zA-Z]?){0,1}$/) | ||||||
1333 | { # column attributes | ||||||
1334 | 0 | 0 | my ($col1, $col2); | ||||
1335 | 0 | 0 | 0 | if ($what =~ m/(.+?):(.+?)/) { | |||
1336 | 0 | 0 | $col1 = col_to_number($1); | ||||
1337 | 0 | 0 | $col2 = col_to_number($2); | ||||
1338 | } else { | ||||||
1339 | 0 | 0 | $col1 = col_to_number($what); | ||||
1340 | 0 | 0 | $col2 = $col1; | ||||
1341 | } | ||||||
1342 | 0 | 0 | 0 | if ($attrib eq "width") { | |||
1343 | 0 | 0 | for (my $c = $col1 ; $c <= $col2 ; $c++) { | ||||
1344 | 0 | 0 | my $colname = number_to_col($c); | ||||
1345 | 0 | 0 | 0 | $colattribs->{$colname} = { 'coord' => $colname } | |||
1346 | unless $colattribs->{$colname}; | ||||||
1347 | 0 | 0 | $colattribs->{$colname}->{width} = $rest; | ||||
1348 | } | ||||||
1349 | } | ||||||
1350 | 0 | 0 | 0 | if ($attrib eq "hide") { | |||
1351 | 0 | 0 | for (my $c = $col1 ; $c <= $col2 ; $c++) { | ||||
1352 | 0 | 0 | my $colname = number_to_col($c); | ||||
1353 | 0 | 0 | 0 | $colattribs->{$colname} = { 'coord' => $colname } | |||
1354 | unless $colattribs->{$colname}; | ||||||
1355 | 0 | 0 | $colattribs->{$colname}->{hide} = $rest; | ||||
1356 | } | ||||||
1357 | } else { | ||||||
1358 | 0 | 0 | $errortext = "Unknown attributename '$attrib' in line:\n$command\n"; | ||||
1359 | 0 | 0 | return 0; | ||||
1360 | } | ||||||
1361 | } elsif ($what =~ m/([a-z]|[A-Z])([a-z]|[A-Z])?(\d+)/) { # cell attributes | ||||||
1362 | 673 | 1615 | $what = uc($what); | ||||
1363 | 673 | 2204 | ($coord1, $coord2) = split (/:/, $what); | ||||
1364 | 673 | 2608 | my ($c1, $r1) = coord_to_cr($coord1); | ||||
1365 | 673 | 1285 | my $c2 = $c1; | ||||
1366 | 673 | 1191 | my $r2 = $r1; | ||||
1367 | 673 | 50 | 1601 | ($c2, $r2) = coord_to_cr($coord2) if $coord2; | |||
1368 | 673 | 100 | 2555 | $sheetattribs->{lastcol} = $c2 if $c2 > $sheetattribs->{lastcol}; | |||
1369 | 673 | 100 | 3196 | $sheetattribs->{lastrow} = $r2 if $r2 > $sheetattribs->{lastrow}; | |||
1370 | |||||||
1371 | 673 | 2224 | for (my $r = $r1 ; $r <= $r2 ; $r++) { | ||||
1372 | 673 | 2190 | for (my $c = $c1 ; $c <= $c2 ; $c++) { | ||||
1373 | 673 | 2558 | my $cr = cr_to_coord($c, $r); | ||||
1374 | 673 | 100 | 33 | 3477 | if ($attrib eq "value") { # set coord value type numeric-value | ||
100 | 33 | ||||||
100 | |||||||
100 | |||||||
100 | |||||||
50 | |||||||
50 | |||||||
50 | |||||||
50 | |||||||
50 | |||||||
50 | |||||||
50 | |||||||
50 | |||||||
50 | |||||||
1375 | 14 | 50 | 77 | $cellattribs->{$cr} = { 'coord' => $cr } | |||
1376 | unless $cellattribs->{$cr}->{coord}; | ||||||
1377 | 14 | 42 | ($v1, $v2) = split (/ /, $rest, 2); | ||||
1378 | 14 | 31 | $datavalues->{$cr} = $v2; | ||||
1379 | 14 | 30 | delete $cellerrors->{$cr}; | ||||
1380 | 14 | 24 | $datatypes->{$cr} = "v"; | ||||
1381 | 14 | 26 | $valuetypes->{$cr} = $v1; | ||||
1382 | 14 | 76 | $sheetdata->{sheetattribs}->{needsrecalc} = "yes"; | ||||
1383 | } elsif ($attrib eq "text") { # set coord text type text-value | ||||||
1384 | 8 | 50 | 69 | $cellattribs->{$cr} = { 'coord' => $cr } | |||
1385 | unless $cellattribs->{$cr}->{coord}; | ||||||
1386 | 8 | 37 | ($v1, $v2) = split (/ /, $rest, 2); | ||||
1387 | 8 | 24 | $datavalues->{$cr} = $v2; | ||||
1388 | 8 | 27 | delete $cellerrors->{$cr}; | ||||
1389 | 8 | 31 | $datatypes->{$cr} = "t"; | ||||
1390 | 8 | 25 | $valuetypes->{$cr} = $v1; | ||||
1391 | 8 | 58 | $sheetdata->{sheetattribs}->{needsrecalc} = "yes"; | ||||
1392 | } elsif ($attrib eq "formula") | ||||||
1393 | { # set coord formula formula-body-less-initial-= | ||||||
1394 | 648 | 100 | 5269 | $cellattribs->{$cr} = { 'coord' => $cr } | |||
1395 | unless $cellattribs->{$cr}->{coord}; | ||||||
1396 | 648 | 2294 | $datavalues->{$cr} = 0; | ||||
1397 | 648 | 1380 | delete $cellerrors->{$cr}; | ||||
1398 | 648 | 1999 | $datatypes->{$cr} = "f"; | ||||
1399 | 648 | 1708 | $valuetypes->{$cr} = "n"; # until recalc'ed | ||||
1400 | 648 | 1718 | $dataformulas->{$cr} = $rest; | ||||
1401 | 648 | 3804 | $sheetdata->{sheetattribs}->{needsrecalc} = "yes"; | ||||
1402 | } elsif ($attrib eq "constant") | ||||||
1403 | { # set coord constant type numeric-value source-text | ||||||
1404 | 1 | 50 | 6 | $cellattribs->{$cr} = { 'coord' => $cr } | |||
1405 | unless $cellattribs->{$cr}->{coord}; | ||||||
1406 | 1 | 4 | ($v1, $v2, $v3) = split (/ /, $rest, 3); | ||||
1407 | 1 | 4 | $datavalues->{$cr} = $v2; | ||||
1408 | 1 | 50 | 3 | if (substr($v1, 0, 1) eq "e") { # error | |||
1409 | 0 | 0 | $cellerrors->{$cr} = substr($v1, 1); | ||||
1410 | } else { | ||||||
1411 | 1 | 3 | delete $cellerrors->{$cr}; | ||||
1412 | } | ||||||
1413 | 1 | 3 | $datatypes->{$cr} = "c"; | ||||
1414 | 1 | 2 | $valuetypes->{$cr} = $v1; | ||||
1415 | 1 | 3 | $dataformulas->{$cr} = $v3; | ||||
1416 | 1 | 6 | $sheetdata->{sheetattribs}->{needsrecalc} = "yes"; | ||||
1417 | } elsif ($attrib eq "empty") { # erase value | ||||||
1418 | 1 | 2 | delete $datavalues->{$cr}; | ||||
1419 | 1 | 2 | delete $cellerrors->{$cr}; | ||||
1420 | 1 | 2 | delete $datatypes->{$cr}; | ||||
1421 | 1 | 31 | delete $valuetypes->{$cr}; | ||||
1422 | 1 | 6 | $sheetdata->{sheetattribs}->{needsrecalc} = "yes"; | ||||
1423 | } elsif ($attrib =~ m/^b[trbl]$/) { | ||||||
1424 | 0 | 0 | 0 | $cellattribs->{$cr} = { 'coord' => $cr } | |||
1425 | unless $cellattribs->{$cr}->{coord}; | ||||||
1426 | 0 | 0 | my $borderdef = 0; | ||||
1427 | 0 | 0 | 0 | $borderdef = $borderstylehash->{$rest} if $rest; | |||
1428 | 0 | 0 | 0 | if (!$borderdef) { | |||
1429 | 0 | 0 | 0 | if ($rest) { | |||
1430 | 0 | 0 | 0 | push @$borderstyles, "" unless scalar @$borderstyles; | |||
1431 | 0 | 0 | $borderdef = (push @$borderstyles, $rest) - 1; | ||||
1432 | 0 | 0 | $borderstylehash->{$rest} = $borderdef; | ||||
1433 | } | ||||||
1434 | } | ||||||
1435 | 0 | 0 | $cellattribs->{$cr}->{$attrib} = $borderdef; | ||||
1436 | } elsif ($attrib eq "color" || $attrib eq "bgcolor") { | ||||||
1437 | 0 | 0 | 0 | $cellattribs->{$cr} = { 'coord' => $cr } | |||
1438 | unless $cellattribs->{$cr}->{coord}; | ||||||
1439 | 0 | 0 | my $colordef = 0; | ||||
1440 | 0 | 0 | 0 | $colordef = $colorhash->{$rest} if $rest; | |||
1441 | 0 | 0 | 0 | if (!$colordef) { | |||
1442 | 0 | 0 | 0 | if ($rest) { | |||
1443 | 0 | 0 | 0 | push @$colors, "" unless scalar @$colors; | |||
1444 | 0 | 0 | $colordef = (push @$colors, $rest) - 1; | ||||
1445 | 0 | 0 | $colorhash->{$rest} = $colordef; | ||||
1446 | } | ||||||
1447 | } | ||||||
1448 | 0 | 0 | $cellattribs->{$cr}->{$attrib} = $colordef; | ||||
1449 | } elsif ($attrib eq "layout") { | ||||||
1450 | 0 | 0 | 0 | $cellattribs->{$cr} = { 'coord' => $cr } | |||
1451 | unless $cellattribs->{$cr}->{coord}; | ||||||
1452 | 0 | 0 | my $layoutdef = 0; | ||||
1453 | 0 | 0 | 0 | $layoutdef = $layoutstylehash->{$rest} if $rest; | |||
1454 | 0 | 0 | 0 | if (!$layoutdef) { | |||
1455 | 0 | 0 | 0 | if ($rest) { | |||
1456 | 0 | 0 | 0 | push @$layoutstyles, "" unless scalar @$layoutstyles; | |||
1457 | 0 | 0 | $layoutdef = (push @$layoutstyles, $rest) - 1; | ||||
1458 | 0 | 0 | $layoutstylehash->{$rest} = $layoutdef; | ||||
1459 | } | ||||||
1460 | } | ||||||
1461 | 0 | 0 | $cellattribs->{$cr}->{$attrib} = $layoutdef; | ||||
1462 | } elsif ($attrib eq "font") { | ||||||
1463 | 0 | 0 | 0 | $cellattribs->{$cr} = { 'coord' => $cr } | |||
1464 | unless $cellattribs->{$cr}->{coord}; | ||||||
1465 | 0 | 0 | my $fontdef = 0; | ||||
1466 | 0 | 0 | 0 | $rest = "" if $rest eq "* * *"; | |||
1467 | 0 | 0 | 0 | $fontdef = $fonthash->{$rest} if $rest; | |||
1468 | 0 | 0 | 0 | if (!$fontdef) { | |||
1469 | 0 | 0 | 0 | if ($rest) { | |||
1470 | 0 | 0 | 0 | push @$fonts, "" unless scalar @$fonts; | |||
1471 | 0 | 0 | $fontdef = (push @$fonts, $rest) - 1; | ||||
1472 | 0 | 0 | $fonthash->{$rest} = $fontdef; | ||||
1473 | } | ||||||
1474 | } | ||||||
1475 | 0 | 0 | $cellattribs->{$cr}->{$attrib} = $fontdef; | ||||
1476 | } elsif ($attrib eq "cellformat") { | ||||||
1477 | 0 | 0 | 0 | $cellattribs->{$cr} = { 'coord' => $cr } | |||
1478 | unless $cellattribs->{$cr}->{coord}; | ||||||
1479 | 0 | 0 | my $formatdef = 0; | ||||
1480 | 0 | 0 | 0 | $formatdef = $cellformathash->{$rest} if $rest; | |||
1481 | 0 | 0 | 0 | if (!$formatdef) { | |||
1482 | 0 | 0 | 0 | if ($rest) { | |||
1483 | 0 | 0 | 0 | push @$cellformats, "" unless scalar @$cellformats; | |||
1484 | 0 | 0 | $formatdef = (push @$cellformats, $rest) - 1; | ||||
1485 | 0 | 0 | $cellformathash->{$rest} = $formatdef; | ||||
1486 | } | ||||||
1487 | } | ||||||
1488 | 0 | 0 | $cellattribs->{$cr}->{$attrib} = $formatdef; | ||||
1489 | } elsif ($attrib eq "textvalueformat" | ||||||
1490 | || $attrib eq "nontextvalueformat") { | ||||||
1491 | 0 | 0 | 0 | $cellattribs->{$cr} = { 'coord' => $cr } | |||
1492 | unless $cellattribs->{$cr}->{coord}; | ||||||
1493 | 0 | 0 | my $formatdef = 0; | ||||
1494 | 0 | 0 | 0 | $formatdef = $valueformathash->{$rest} if length($rest); | |||
1495 | 0 | 0 | 0 | if (!$formatdef) { | |||
1496 | 0 | 0 | 0 | if (length($rest)) { | |||
1497 | 0 | 0 | 0 | push @$valueformats, "" unless scalar @$valueformats; | |||
1498 | 0 | 0 | $formatdef = (push @$valueformats, $rest) - 1; | ||||
1499 | 0 | 0 | $valueformathash->{$rest} = $formatdef; | ||||
1500 | } | ||||||
1501 | } | ||||||
1502 | 0 | 0 | $cellattribs->{$cr}->{$attrib} = $formatdef; | ||||
1503 | } elsif ($attrib eq "cssc") { | ||||||
1504 | 0 | 0 | 0 | $cellattribs->{$cr} = { 'coord' => $cr } | |||
1505 | unless $cellattribs->{$cr}->{coord}; | ||||||
1506 | 0 | 0 | $rest =~ s/[^a-zA-Z0-9\-]//g; | ||||
1507 | 0 | 0 | $cellattribs->{$cr}->{$attrib} = $rest; | ||||
1508 | } elsif ($attrib eq "csss") { | ||||||
1509 | 0 | 0 | 0 | $cellattribs->{$cr} = { 'coord' => $cr } | |||
1510 | unless $cellattribs->{$cr}->{coord}; | ||||||
1511 | 0 | 0 | $rest =~ s/\n//g; | ||||
1512 | 0 | 0 | $cellattribs->{$cr}->{$attrib} = $rest; | ||||
1513 | } elsif ($attrib eq "mod") { | ||||||
1514 | 0 | 0 | 0 | $cellattribs->{$cr} = { 'coord' => $cr } | |||
1515 | unless $cellattribs->{$cr}->{coord}; | ||||||
1516 | 0 | 0 | $rest =~ s/[^yY]//g; | ||||
1517 | 0 | 0 | $cellattribs->{$cr}->{$attrib} = lc $rest; | ||||
1518 | } else { | ||||||
1519 | 1 | 4 | $errortext = | ||||
1520 | "Unknown attributename '$attrib' in line:\n$command\n"; | ||||||
1521 | 1 | 5 | return 0; | ||||
1522 | } | ||||||
1523 | } | ||||||
1524 | } | ||||||
1525 | } | ||||||
1526 | } | ||||||
1527 | |||||||
1528 | elsif ($cmd1 =~ m/^(?:erase|copy|cut|paste|fillright|filldown|sort)$/) { | ||||||
1529 | 2 | 17 | ($what, $rest) = split (/ /, $rest, 2); | ||||
1530 | 2 | 6 | $what = uc($what); | ||||
1531 | 2 | 4 | ($coord1, $coord2) = split (/:/, $what); | ||||
1532 | 2 | 21 | my ($c1, $r1) = coord_to_cr($coord1); | ||||
1533 | 2 | 5 | my $c2 = $c1; | ||||
1534 | 2 | 2 | my $r2 = $r1; | ||||
1535 | 2 | 50 | 10 | ($c2, $r2) = coord_to_cr($coord2) if $coord2; | |||
1536 | 2 | 50 | 7 | $sheetattribs->{lastcol} = $c2 if $c2 > $sheetattribs->{lastcol}; | |||
1537 | 2 | 100 | 8 | $sheetattribs->{lastrow} = $r2 if $r2 > $sheetattribs->{lastrow}; | |||
1538 | |||||||
1539 | 2 | 50 | 33 | 28 | if ($cmd1 eq "erase") { | ||
50 | 66 | ||||||
100 | |||||||
50 | |||||||
0 | |||||||
1540 | 0 | 0 | for (my $r = $r1 ; $r <= $r2 ; $r++) { | ||||
1541 | 0 | 0 | for (my $c = $c1 ; $c <= $c2 ; $c++) { | ||||
1542 | 0 | 0 | my $cr = cr_to_coord($c, $r); | ||||
1543 | 0 | 0 | 0 | if ($rest eq "all") { | |||
0 | |||||||
0 | |||||||
1544 | 0 | 0 | delete $cellattribs->{$cr}; | ||||
1545 | 0 | 0 | delete $datavalues->{$cr}; | ||||
1546 | 0 | 0 | delete $dataformulas->{$cr}; | ||||
1547 | 0 | 0 | delete $cellerrors->{$cr}; | ||||
1548 | 0 | 0 | delete $datatypes->{$cr}; | ||||
1549 | 0 | 0 | delete $valuetypes->{$cr}; | ||||
1550 | } elsif ($rest eq "formulas") { | ||||||
1551 | 0 | 0 | delete $datavalues->{$cr}; | ||||
1552 | 0 | 0 | delete $dataformulas->{$cr}; | ||||
1553 | 0 | 0 | delete $cellerrors->{$cr}; | ||||
1554 | 0 | 0 | delete $datatypes->{$cr}; | ||||
1555 | 0 | 0 | delete $valuetypes->{$cr}; | ||||
1556 | } elsif ($rest eq "formats") { | ||||||
1557 | 0 | 0 | $cellattribs->{$cr} = { 'coord' => $cr }; # Leave with minimal set | ||||
1558 | } | ||||||
1559 | } | ||||||
1560 | } | ||||||
1561 | 0 | 0 | $sheetdata->{sheetattribs}->{needsrecalc} = "yes"; | ||||
1562 | } | ||||||
1563 | |||||||
1564 | elsif ($cmd1 eq "fillright" || $cmd1 eq "filldown") { | ||||||
1565 | 0 | 0 | my ($fillright, $rowstart, $colstart); | ||||
1566 | 0 | 0 | 0 | if ($cmd1 eq "fillright") { | |||
1567 | 0 | 0 | $fillright = 1; | ||||
1568 | 0 | 0 | $rowstart = $r1; | ||||
1569 | 0 | 0 | $colstart = $c1 + 1; | ||||
1570 | } else { | ||||||
1571 | 0 | 0 | $rowstart = $r1 + 1; | ||||
1572 | 0 | 0 | $colstart = $c1; | ||||
1573 | } | ||||||
1574 | 0 | 0 | for (my $r = $rowstart ; $r <= $r2 ; $r++) { | ||||
1575 | 0 | 0 | for (my $c = $colstart ; $c <= $c2 ; $c++) { | ||||
1576 | 0 | 0 | my $cr = cr_to_coord($c, $r); | ||||
1577 | 0 | 0 | my ($crbase, $rowoffset, $coloffset); | ||||
1578 | 0 | 0 | 0 | if ($fillright) { | |||
1579 | 0 | 0 | $crbase = cr_to_coord($c1, $r); | ||||
1580 | 0 | 0 | $coloffset = $c - $colstart + 1; | ||||
1581 | 0 | 0 | $rowoffset = 0; | ||||
1582 | } else { | ||||||
1583 | 0 | 0 | $crbase = cr_to_coord($c, $r1); | ||||
1584 | 0 | 0 | $coloffset = 0; | ||||
1585 | 0 | 0 | $rowoffset = $r - $rowstart + 1; | ||||
1586 | } | ||||||
1587 | 0 | 0 | 0 | 0 | if ($rest eq "all" || $rest eq "formats") { | ||
1588 | 0 | 0 | $cellattribs->{$cr} = { 'coord' => $cr }; # Start with minimal set | ||||
1589 | 0 | 0 | foreach my $attribtype (keys %{ $cellattribs->{$crbase} }) { | ||||
0 | 0 | ||||||
1590 | 0 | 0 | 0 | if ($attribtype ne "coord") { | |||
1591 | 0 | 0 | $cellattribs->{$cr}->{$attribtype} = | ||||
1592 | $cellattribs->{$crbase}->{$attribtype}; | ||||||
1593 | } | ||||||
1594 | } | ||||||
1595 | } | ||||||
1596 | 0 | 0 | 0 | 0 | if ($rest eq "all" || $rest eq "formulas") { | ||
1597 | 0 | 0 | 0 | $cellattribs->{$cr} = { 'coord' => $cr } | |||
1598 | unless $cellattribs->{$cr}->{coord}; # Make sure this exists | ||||||
1599 | 0 | 0 | $datavalues->{$cr} = $datavalues->{$crbase}; | ||||
1600 | 0 | 0 | $datatypes->{$cr} = $datatypes->{$crbase}; | ||||
1601 | 0 | 0 | $valuetypes->{$cr} = $valuetypes->{$crbase}; | ||||
1602 | 0 | 0 | 0 | if ($datatypes->{$cr} eq "f") | |||
1603 | { # offset relative coords, even in sheet references | ||||||
1604 | 0 | 0 | $dataformulas->{$cr} = | ||||
1605 | offset_formula_coords($dataformulas->{$crbase}, | ||||||
1606 | $coloffset, $rowoffset); | ||||||
1607 | } else { | ||||||
1608 | 0 | 0 | $dataformulas->{$cr} = $dataformulas->{$crbase}; | ||||
1609 | } | ||||||
1610 | 0 | 0 | $cellerrors->{$cr} = $cellerrors->{$crbase}; | ||||
1611 | } | ||||||
1612 | } | ||||||
1613 | } | ||||||
1614 | 0 | 0 | $sheetdata->{sheetattribs}->{needsrecalc} = "yes"; | ||||
1615 | } | ||||||
1616 | |||||||
1617 | elsif ($cmd1 eq "copy" || $cmd1 eq "cut") { | ||||||
1618 | 1 | 3 | $sheetdata->{clipboard} = {}; # clear and create clipboard | ||||
1619 | 1 | 2 | $sheetdata->{clipboard}->{datavalues} = {}; | ||||
1620 | 1 | 3 | my $clipdatavalues = $sheetdata->{clipboard}->{datavalues}; | ||||
1621 | 1 | 3 | $sheetdata->{clipboard}->{datatypes} = {}; | ||||
1622 | 1 | 2 | my $clipdatatypes = $sheetdata->{clipboard}->{datatypes}; | ||||
1623 | 1 | 2 | $sheetdata->{clipboard}->{valuetypes} = {}; | ||||
1624 | 1 | 3 | my $clipvaluetypes = $sheetdata->{clipboard}->{valuetypes}; | ||||
1625 | 1 | 2 | $sheetdata->{clipboard}->{formulas} = {}; | ||||
1626 | 1 | 3 | my $clipdataformulas = $sheetdata->{clipboard}->{formulas}; | ||||
1627 | 1 | 2 | $sheetdata->{clipboard}->{cellerrors} = {}; | ||||
1628 | 1 | 2 | my $clipcellerrors = $sheetdata->{clipboard}->{cellerrors}; | ||||
1629 | 1 | 2 | $sheetdata->{clipboard}->{cellattribs} = {}; | ||||
1630 | 1 | 2 | my $clipcellattribs = $sheetdata->{clipboard}->{cellattribs}; | ||||
1631 | |||||||
1632 | 1 | 5 | for (my $r = $r1 ; $r <= $r2 ; $r++) { | ||||
1633 | 3 | 16 | for (my $c = $c1 ; $c <= $c2 ; $c++) { | ||||
1634 | 3 | 7 | my $cr = cr_to_coord($c, $r); | ||||
1635 | 3 | 13 | $clipcellattribs->{$cr}->{ 'coord' => $cr } = | ||||
1636 | ''; # make sure something (used for save) | ||||||
1637 | 3 | 50 | 33 | 10 | if ($rest eq "all" || $rest eq "formats") { | ||
1638 | 3 | 7 | foreach my $attribtype (keys %{ $cellattribs->{$cr} }) { | ||||
3 | 9 | ||||||
1639 | 3 | 11 | $clipcellattribs->{$cr}->{$attribtype} = | ||||
1640 | $cellattribs->{$cr}->{$attribtype}; | ||||||
1641 | } | ||||||
1642 | 3 | 50 | 10 | if ($cmd1 eq "cut") { | |||
1643 | 0 | 0 | delete $cellattribs->{$cr}; | ||||
1644 | 0 | 0 | 0 | $cellattribs->{$cr} = { 'coord' => $cr } if $rest eq "formats"; | |||
1645 | } | ||||||
1646 | } | ||||||
1647 | 3 | 50 | 33 | 9 | if ($rest eq "all" || $rest eq "formulas") { | ||
1648 | 3 | 8 | $clipcellattribs->{$cr}->{coord} = | ||||
1649 | $cellattribs->{$cr}->{coord}; # used by save | ||||||
1650 | 3 | 6 | $clipdatavalues->{$cr} = $datavalues->{$cr}; | ||||
1651 | 3 | 6 | $clipdataformulas->{$cr} = $dataformulas->{$cr}; | ||||
1652 | 3 | 18 | $clipcellerrors->{$cr} = $cellerrors->{$cr}; | ||||
1653 | 3 | 7 | $clipdatatypes->{$cr} = $datatypes->{$cr}; | ||||
1654 | 3 | 7 | $clipvaluetypes->{$cr} = $valuetypes->{$cr}; | ||||
1655 | 3 | 50 | 17 | if ($cmd1 eq "cut") { | |||
1656 | 0 | 0 | delete $datavalues->{$cr}; | ||||
1657 | 0 | 0 | delete $dataformulas->{$cr}; | ||||
1658 | 0 | 0 | delete $cellerrors->{$cr}; | ||||
1659 | 0 | 0 | delete $datatypes->{$cr}; | ||||
1660 | 0 | 0 | delete $valuetypes->{$cr}; | ||||
1661 | } | ||||||
1662 | } | ||||||
1663 | } | ||||||
1664 | } | ||||||
1665 | 1 | 50 | 19 | $sheetdata->{clipboard}->{range} = | |||
1666 | $coord2 ? "$coord1:$coord2" : "$coord1:$coord1"; | ||||||
1667 | 1 | 50 | 4 | $sheetdata->{sheetattribs}->{needsrecalc} = "yes" if $cmd1 eq "cut"; | |||
1668 | } | ||||||
1669 | |||||||
1670 | elsif ($cmd1 eq "paste") { | ||||||
1671 | 1 | 2 | my $crbase = $sheetdata->{clipboard}->{range}; | ||||
1672 | 1 | 50 | 3 | if (!$crbase) { | |||
1673 | 0 | 0 | $errortext = "Empty clipboard\n"; | ||||
1674 | 0 | 0 | return 0; | ||||
1675 | } | ||||||
1676 | 1 | 2 | my $clipdatavalues = $sheetdata->{clipboard}->{datavalues}; | ||||
1677 | 1 | 1 | my $clipdatatypes = $sheetdata->{clipboard}->{datatypes}; | ||||
1678 | 1 | 2 | my $clipvaluetypes = $sheetdata->{clipboard}->{valuetypes}; | ||||
1679 | 1 | 2 | my $clipdataformulas = $sheetdata->{clipboard}->{formulas}; | ||||
1680 | 1 | 2 | my $clipcellerrors = $sheetdata->{clipboard}->{cellerrors}; | ||||
1681 | 1 | 2 | my $clipcellattribs = $sheetdata->{clipboard}->{cellattribs}; | ||||
1682 | |||||||
1683 | 1 | 2 | my ($clipcoord1, $clipcoord2) = split (/:/, $crbase); | ||||
1684 | 1 | 50 | 3 | $clipcoord2 = $clipcoord1 unless $clipcoord2; | |||
1685 | 1 | 3 | my ($clipc1, $clipr1) = coord_to_cr($clipcoord1); | ||||
1686 | 1 | 3 | my ($clipc2, $clipr2) = coord_to_cr($clipcoord2); | ||||
1687 | 1 | 2 | my $coloffset = $c1 - $clipc1; | ||||
1688 | 1 | 2 | my $rowoffset = $r1 - $clipr1; | ||||
1689 | 1 | 4 | my $numcols = $clipc2 - $clipc1 + 1; | ||||
1690 | 1 | 1 | my $numrows = $clipr2 - $clipr1 + 1; | ||||
1691 | 1 | 50 | 11 | $sheetattribs->{lastcol} = $c1 + $numcols - 1 | |||
1692 | if $c1 + $numcols - 1 > $sheetattribs->{lastcol}; | ||||||
1693 | 1 | 50 | 5 | $sheetattribs->{lastrow} = $r1 + $numrows - 1 | |||
1694 | if $r1 + $numrows - 1 > $sheetattribs->{lastrow}; | ||||||
1695 | |||||||
1696 | 1 | 3 | for (my $r = 0 ; $r < $numrows ; $r++) { | ||||
1697 | 3 | 8 | for (my $c = 0 ; $c < $numcols ; $c++) { | ||||
1698 | 3 | 7 | my $cr = cr_to_coord($c1 + $c, $r1 + $r); | ||||
1699 | 3 | 11 | my $clipcr = cr_to_coord($clipc1 + $c, $clipr1 + $r); | ||||
1700 | 3 | 50 | 33 | 9 | if ($rest eq "all" || $rest eq "formats") { | ||
1701 | 3 | 8 | $cellattribs->{$cr} = { 'coord' => $cr }; # Start with minimal set | ||||
1702 | 3 | 4 | foreach my $attribtype (keys %{ $clipcellattribs->{$clipcr} }) { | ||||
3 | 9 | ||||||
1703 | 6 | 100 | 20 | if ($attribtype ne "coord") { | |||
1704 | 3 | 9 | $cellattribs->{$cr}->{$attribtype} = | ||||
1705 | $clipcellattribs->{$clipcr}->{$attribtype}; | ||||||
1706 | } | ||||||
1707 | } | ||||||
1708 | } | ||||||
1709 | 3 | 50 | 33 | 10 | if ($rest eq "all" || $rest eq "formulas") { | ||
1710 | 3 | 50 | 7 | $cellattribs->{$cr} = { 'coord' => $cr } | |||
1711 | unless $cellattribs->{$cr}->{coord}; # Make sure this exists | ||||||
1712 | 3 | 4 | $datavalues->{$cr} = $clipdatavalues->{$clipcr}; | ||||
1713 | 3 | 7 | $datatypes->{$cr} = $clipdatatypes->{$clipcr}; | ||||
1714 | 3 | 5 | $valuetypes->{$cr} = $clipvaluetypes->{$clipcr}; | ||||
1715 | 3 | 50 | 8 | if ($datatypes->{$cr} eq "f") | |||
1716 | { # offset coord refs, even to *** relative *** coords in other sheets | ||||||
1717 | 0 | 0 | $dataformulas->{$cr} = | ||||
1718 | offset_formula_coords($clipdataformulas->{$clipcr}, | ||||||
1719 | $coloffset, $rowoffset); | ||||||
1720 | } else { | ||||||
1721 | 3 | 5 | $dataformulas->{$cr} = $clipdataformulas->{$clipcr}; | ||||
1722 | } | ||||||
1723 | 3 | 13 | $cellerrors->{$cr} = $clipcellerrors->{$clipcr}; | ||||
1724 | } | ||||||
1725 | } | ||||||
1726 | } | ||||||
1727 | 1 | 3 | $sheetdata->{sheetattribs}->{needsrecalc} = "yes"; | ||||
1728 | } | ||||||
1729 | |||||||
1730 | elsif ($cmd1 eq "sort") | ||||||
1731 | { # sort cr1:cr2 col1 up/down col2 up/down col3 up/down | ||||||
1732 | 0 | 0 | my @col_dirs = split (/\s+/, $rest); | ||||
1733 | 0 | 0 | my (@cols, @dirs); | ||||
1734 | 0 | 0 | ($cols[1], $dirs[1], $cols[2], $dirs[2], $cols[3], $dirs[3]) = | ||||
1735 | @col_dirs; | ||||||
1736 | 0 | 0 | my $nsortcols = int((scalar @col_dirs) / 2); | ||||
1737 | 0 | 0 | my $sortdata = {}; # make a place to hold data to sort | ||||
1738 | 0 | 0 | $sortdata->{datavalues} = {}; | ||||
1739 | 0 | 0 | my $sortdatavalues = $sortdata->{datavalues}; | ||||
1740 | 0 | 0 | $sortdata->{datatypes} = {}; | ||||
1741 | 0 | 0 | my $sortdatatypes = $sortdata->{datatypes}; | ||||
1742 | 0 | 0 | $sortdata->{valuetypes} = {}; | ||||
1743 | 0 | 0 | my $sortvaluetypes = $sortdata->{valuetypes}; | ||||
1744 | 0 | 0 | $sortdata->{formulas} = {}; | ||||
1745 | 0 | 0 | my $sortdataformulas = $sortdata->{formulas}; | ||||
1746 | 0 | 0 | $sortdata->{cellerrors} = {}; | ||||
1747 | 0 | 0 | my $sortcellerrors = $sortdata->{cellerrors}; | ||||
1748 | 0 | 0 | $sortdata->{cellattribs} = {}; | ||||
1749 | 0 | 0 | my $sortcellattribs = $sortdata->{cellattribs}; | ||||
1750 | |||||||
1751 | 0 | 0 | my (@sortlist, @sortvalues, @sorttypes, @rowvalues, @rowtypes); | ||||
1752 | 0 | 0 | for (my $r = $r1 ; $r <= $r2 ; $r++) | ||||
1753 | { # make a copy to replace over original in new order | ||||||
1754 | 0 | 0 | for (my $c = $c1 ; $c <= $c2 ; $c++) { | ||||
1755 | 0 | 0 | my $cr = cr_to_coord($c, $r); | ||||
1756 | 0 | 0 | 0 | next if !$cellattribs->{$cr}->{coord}; # don't copy blank cells | |||
1757 | 0 | 0 | $sortcellattribs->{$cr}->{ 'coord' => $cr } = ''; | ||||
1758 | 0 | 0 | foreach my $attribtype (keys %{ $cellattribs->{$cr} }) { | ||||
0 | 0 | ||||||
1759 | 0 | 0 | $sortcellattribs->{$cr}->{$attribtype} = | ||||
1760 | $cellattribs->{$cr}->{$attribtype}; | ||||||
1761 | } | ||||||
1762 | 0 | 0 | $sortcellattribs->{$cr}->{coord} = | ||||
1763 | $cellattribs->{$cr}->{coord}; # used by save | ||||||
1764 | 0 | 0 | $sortdatavalues->{$cr} = $datavalues->{$cr}; | ||||
1765 | 0 | 0 | $sortdataformulas->{$cr} = $dataformulas->{$cr}; | ||||
1766 | 0 | 0 | $sortcellerrors->{$cr} = $cellerrors->{$cr}; | ||||
1767 | 0 | 0 | $sortdatatypes->{$cr} = $datatypes->{$cr}; | ||||
1768 | 0 | 0 | $sortvaluetypes->{$cr} = $valuetypes->{$cr}; | ||||
1769 | } | ||||||
1770 | 0 | 0 | push @sortlist, scalar @sortlist; # make list to sort (0..numrows-1) | ||||
1771 | 0 | 0 | @rowvalues = (); | ||||
1772 | 0 | 0 | @rowtypes = (); | ||||
1773 | 0 | 0 | for (my $i = 1 ; $i <= $nsortcols ; $i++) | ||||
1774 | { # save values and types for comparing | ||||||
1775 | 0 | 0 | my $cr = "$cols[$i]$r"; # get from each sorting column | ||||
1776 | 0 | 0 | push @rowvalues, $datavalues->{$cr}; | ||||
1777 | 0 | 0 | 0 | push @rowtypes, | |||
1778 | (substr($valuetypes->{$cr}, 0, 1) || "b"); # just major type | ||||||
1779 | } | ||||||
1780 | 0 | 0 | push @sortvalues, [@rowvalues]; | ||||
1781 | 0 | 0 | push @sorttypes, [@rowtypes]; | ||||
1782 | } | ||||||
1783 | |||||||
1784 | # Do the sort | ||||||
1785 | |||||||
1786 | 0 | 0 | my ($a1, $b1, $ta, $tb, $cresult); | ||||
1787 | @sortlist = sort { | ||||||
1788 | 0 | 0 | for (my $i = 0 ; $i < $nsortcols ; $i++) { | ||||
0 | 0 | ||||||
1789 | 0 | 0 | 0 | if ($dirs[ $i + 1 ] eq "up") { # handle sort direction | |||
1790 | 0 | 0 | $a1 = $a; | ||||
1791 | 0 | 0 | $b1 = $b; | ||||
1792 | } else { | ||||||
1793 | 0 | 0 | $a1 = $b; | ||||
1794 | 0 | 0 | $b1 = $a; | ||||
1795 | } | ||||||
1796 | 0 | 0 | $ta = $sorttypes[$a1][$i]; | ||||
1797 | 0 | 0 | $tb = $sorttypes[$b1][$i]; | ||||
1798 | 0 | 0 | 0 | if ($ta eq "t") | |||
0 | |||||||
0 | |||||||
0 | |||||||
1799 | { # numbers < text < errors, blank always last no matter what dir | ||||||
1800 | 0 | 0 | 0 | if ($tb eq "t") { | |||
0 | |||||||
0 | |||||||
0 | |||||||
1801 | 0 | 0 | $cresult = | ||||
1802 | (lc $sortvalues[$a1][$i]) cmp(lc $sortvalues[$b1][$i]); | ||||||
1803 | } elsif ($tb eq "n") { | ||||||
1804 | 0 | 0 | $cresult = 1; | ||||
1805 | } elsif ($tb eq "b") { | ||||||
1806 | 0 | 0 | 0 | $cresult = $dirs[ $i + 1 ] eq "up" ? -1 : 1; | |||
1807 | } elsif ($tb eq "e") { | ||||||
1808 | 0 | 0 | $cresult = -1; | ||||
1809 | } | ||||||
1810 | } elsif ($ta eq "n") { | ||||||
1811 | 0 | 0 | 0 | if ($tb eq "t") { | |||
0 | |||||||
0 | |||||||
0 | |||||||
1812 | 0 | 0 | $cresult = -1; | ||||
1813 | } elsif ($tb eq "n") { | ||||||
1814 | 0 | 0 | $cresult = $sortvalues[$a1][$i] <=> $sortvalues[$b1][$i]; | ||||
1815 | } elsif ($tb eq "b") { | ||||||
1816 | 0 | 0 | 0 | $cresult = $dirs[ $i + 1 ] eq "up" ? -1 : 1; | |||
1817 | } elsif ($tb eq "e") { | ||||||
1818 | 0 | 0 | $cresult = -1; | ||||
1819 | } | ||||||
1820 | } elsif ($ta eq "e") { | ||||||
1821 | 0 | 0 | 0 | if ($tb eq "e") { | |||
0 | |||||||
1822 | 0 | 0 | $cresult = $sortvalues[$a1][$i] <=> $sortvalues[$b1][$i]; | ||||
1823 | } elsif ($tb eq "b") { | ||||||
1824 | 0 | 0 | 0 | $cresult = $dirs[ $i + 1 ] eq "up" ? -1 : 1; | |||
1825 | } else { | ||||||
1826 | 0 | 0 | $cresult = 1; | ||||
1827 | } | ||||||
1828 | } elsif ($ta eq "b") { | ||||||
1829 | 0 | 0 | 0 | if ($tb eq "b") { | |||
1830 | 0 | 0 | $cresult = 0; | ||||
1831 | } else { | ||||||
1832 | 0 | 0 | 0 | $cresult = $dirs[ $i + 1 ] eq "up" ? 1 : -1; | |||
1833 | } | ||||||
1834 | } | ||||||
1835 | 0 | 0 | 0 | return $cresult if $cresult; | |||
1836 | } | ||||||
1837 | 0 | 0 | return $a cmp $b; | ||||
1838 | } @sortlist; | ||||||
1839 | |||||||
1840 | 0 | 0 | my $originalrow; | ||||
1841 | 0 | 0 | for (my $r = $r1 ; $r <= $r2 ; $r++) | ||||
1842 | { # copy original back over in new rows | ||||||
1843 | 0 | 0 | $originalrow = $sortlist[ $r - $r1 ]; | ||||
1844 | 0 | 0 | for (my $c = $c1 ; $c <= $c2 ; $c++) { | ||||
1845 | 0 | 0 | my $cr = cr_to_coord($c, $r); | ||||
1846 | 0 | 0 | my $sortedcr = cr_to_coord($c, $r1 + $originalrow); | ||||
1847 | 0 | 0 | 0 | if (!$sortcellattribs->{$sortedcr}->{coord}) | |||
1848 | { # copying an empty cell | ||||||
1849 | 0 | 0 | delete $cellattribs->{$cr}; | ||||
1850 | 0 | 0 | delete $datavalues->{$cr}; | ||||
1851 | 0 | 0 | delete $dataformulas->{$cr}; | ||||
1852 | 0 | 0 | delete $cellerrors->{$cr}; | ||||
1853 | 0 | 0 | delete $datatypes->{$cr}; | ||||
1854 | 0 | 0 | delete $valuetypes->{$cr}; | ||||
1855 | 0 | 0 | next; | ||||
1856 | } | ||||||
1857 | 0 | 0 | $cellattribs->{$cr} = { 'coord' => $cr }; | ||||
1858 | 0 | 0 | foreach my $attribtype (keys %{ $sortcellattribs->{$sortedcr} }) { | ||||
0 | 0 | ||||||
1859 | 0 | 0 | 0 | if ($attribtype ne "coord") { | |||
1860 | 0 | 0 | $cellattribs->{$cr}->{$attribtype} = | ||||
1861 | $sortcellattribs->{$sortedcr}->{$attribtype}; | ||||||
1862 | } | ||||||
1863 | } | ||||||
1864 | 0 | 0 | $datavalues->{$cr} = $sortdatavalues->{$sortedcr}; | ||||
1865 | 0 | 0 | $datatypes->{$cr} = $sortdatatypes->{$sortedcr}; | ||||
1866 | 0 | 0 | $valuetypes->{$cr} = $sortvaluetypes->{$sortedcr}; | ||||
1867 | 0 | 0 | 0 | if ($sortdatatypes->{$sortedcr} eq "f") | |||
1868 | { # offset coord refs, even to ***relative*** coords in other sheets | ||||||
1869 | 0 | 0 | $dataformulas->{$cr} = | ||||
1870 | offset_formula_coords($sortdataformulas->{$sortedcr}, | ||||||
1871 | 0, ($r - $r1) - $originalrow); | ||||||
1872 | } else { | ||||||
1873 | 0 | 0 | $dataformulas->{$cr} = $sortdataformulas->{$sortedcr}; | ||||
1874 | } | ||||||
1875 | 0 | 0 | $cellerrors->{$cr} = $sortcellerrors->{$sortedcr}; | ||||
1876 | } | ||||||
1877 | } | ||||||
1878 | 0 | 0 | $sheetdata->{sheetattribs}->{needsrecalc} = "yes"; | ||||
1879 | } | ||||||
1880 | } | ||||||
1881 | |||||||
1882 | elsif ($cmd1 eq "clearclipboard") { | ||||||
1883 | 0 | 0 | delete $sheetdata->{clipboard}; | ||||
1884 | } | ||||||
1885 | |||||||
1886 | elsif ($cmd1 eq "merge") { | ||||||
1887 | 0 | 0 | ($what, $rest) = split (/ /, $rest, 2); | ||||
1888 | 0 | 0 | $what = uc($what); | ||||
1889 | 0 | 0 | ($coord1, $coord2) = split (/:/, $what); | ||||
1890 | 0 | 0 | my ($c1, $r1) = coord_to_cr($coord1); | ||||
1891 | 0 | 0 | my $c2 = $c1; | ||||
1892 | 0 | 0 | my $r2 = $r1; | ||||
1893 | 0 | 0 | 0 | ($c2, $r2) = coord_to_cr($coord2) if $coord2; | |||
1894 | 0 | 0 | 0 | $sheetattribs->{lastcol} = $c2 if $c2 > $sheetattribs->{lastcol}; | |||
1895 | 0 | 0 | 0 | $sheetattribs->{lastrow} = $r2 if $r2 > $sheetattribs->{lastrow}; | |||
1896 | |||||||
1897 | 0 | 0 | 0 | $cellattribs->{$coord1} = { 'coord' => $coord1 } | |||
1898 | unless $cellattribs->{$coord1}->{coord}; | ||||||
1899 | |||||||
1900 | 0 | 0 | delete $cellattribs->{$coord1}->{colspan}; | ||||
1901 | 0 | 0 | 0 | $cellattribs->{$coord1}->{colspan} = $c2 - $c1 + 1 if $c2 > $c1; | |||
1902 | 0 | 0 | delete $cellattribs->{$coord1}->{rowspan}; | ||||
1903 | 0 | 0 | 0 | $cellattribs->{$coord1}->{rowspan} = $r2 - $r1 + 1 if $r2 > $r1; | |||
1904 | } | ||||||
1905 | |||||||
1906 | elsif ($cmd1 eq "unmerge") { | ||||||
1907 | 0 | 0 | ($what, $rest) = split (/ /, $rest, 2); | ||||
1908 | 0 | 0 | $what = uc($what); | ||||
1909 | 0 | 0 | ($coord1, $coord2) = split (/:/, $what); | ||||
1910 | |||||||
1911 | 0 | 0 | 0 | $cellattribs->{$coord1} = { 'coord' => $coord1 } | |||
1912 | unless $cellattribs->{$coord1}->{coord}; | ||||||
1913 | |||||||
1914 | 0 | 0 | delete $cellattribs->{$coord1}->{colspan}; | ||||
1915 | 0 | 0 | delete $cellattribs->{$coord1}->{rowspan}; | ||||
1916 | } | ||||||
1917 | |||||||
1918 | elsif ($cmd1 eq "insertcol" || $cmd1 eq "insertrow") { | ||||||
1919 | 0 | 0 | ($what, $rest) = split (/ /, $rest, 2); | ||||
1920 | 0 | 0 | $what = uc($what); | ||||
1921 | 0 | 0 | ($coord1, $coord2) = split (/:/, $what); | ||||
1922 | 0 | 0 | my ($c1, $r1) = coord_to_cr($coord1); | ||||
1923 | 0 | 0 | my $lastcol = $sheetattribs->{lastcol}; | ||||
1924 | 0 | 0 | my $lastrow = $sheetattribs->{lastrow}; | ||||
1925 | my ( | ||||||
1926 | 0 | 0 | $coloffset, $rowoffset, $colend, $rowend, | ||||
1927 | $newcolstart, $newcolend, $newrowstart, $newrowend | ||||||
1928 | ); | ||||||
1929 | 0 | 0 | 0 | if ($cmd1 eq "insertcol") { | |||
1930 | 0 | 0 | $coloffset = 1; | ||||
1931 | 0 | 0 | $colend = $c1; | ||||
1932 | 0 | 0 | $rowend = 1; | ||||
1933 | 0 | 0 | $newcolstart = $c1; | ||||
1934 | 0 | 0 | $newcolend = $c1; | ||||
1935 | 0 | 0 | $newrowstart = 1; | ||||
1936 | 0 | 0 | $newrowend = $lastrow; | ||||
1937 | } else { | ||||||
1938 | 0 | 0 | $rowoffset = 1; | ||||
1939 | 0 | 0 | $rowend = $r1; | ||||
1940 | 0 | 0 | $colend = 1; | ||||
1941 | 0 | 0 | $newcolstart = 1; | ||||
1942 | 0 | 0 | $newcolend = $lastcol; | ||||
1943 | 0 | 0 | $newrowstart = $r1; | ||||
1944 | 0 | 0 | $newrowend = $r1; | ||||
1945 | } | ||||||
1946 | |||||||
1947 | 0 | 0 | for (my $row = $lastrow ; $row >= $rowend ; $row--) | ||||
1948 | { # copy the cells forward | ||||||
1949 | 0 | 0 | for (my $col = $lastcol ; $col >= $colend ; $col--) { | ||||
1950 | 0 | 0 | my $coord = cr_to_coord($col, $row); | ||||
1951 | 0 | 0 | my $coordnext = cr_to_coord($col + $coloffset, $row + $rowoffset); | ||||
1952 | 0 | 0 | 0 | if (!$cellattribs->{$coord}) { # copying empty cell | |||
1953 | 0 | 0 | delete $cellattribs->{$coordnext}; | ||||
1954 | 0 | 0 | delete $datavalues->{$coordnext}; | ||||
1955 | 0 | 0 | delete $datatypes->{$coordnext}; | ||||
1956 | 0 | 0 | delete $valuetypes->{$coordnext}; | ||||
1957 | 0 | 0 | delete $dataformulas->{$coordnext}; | ||||
1958 | 0 | 0 | delete $cellerrors->{$coordnext}; | ||||
1959 | 0 | 0 | next; | ||||
1960 | } | ||||||
1961 | 0 | 0 | $cellattribs->{$coordnext} = | ||||
1962 | { 'coord' => $coordnext }; # Start with minimal set | ||||||
1963 | 0 | 0 | foreach my $attribtype (keys %{ $cellattribs->{$coord} }) { | ||||
0 | 0 | ||||||
1964 | 0 | 0 | 0 | if ($attribtype ne "coord") { | |||
1965 | 0 | 0 | $cellattribs->{$coordnext}->{$attribtype} = | ||||
1966 | $cellattribs->{$coord}->{$attribtype}; | ||||||
1967 | } | ||||||
1968 | } | ||||||
1969 | 0 | 0 | $datavalues->{$coordnext} = $datavalues->{$coord}; | ||||
1970 | 0 | 0 | $datatypes->{$coordnext} = $datatypes->{$coord}; | ||||
1971 | 0 | 0 | $valuetypes->{$coordnext} = $valuetypes->{$coord}; | ||||
1972 | 0 | 0 | $dataformulas->{$coordnext} = $dataformulas->{$coord}; | ||||
1973 | 0 | 0 | $cellerrors->{$coordnext} = $cellerrors->{$coord}; | ||||
1974 | } | ||||||
1975 | } | ||||||
1976 | 0 | 0 | for (my $r = $newrowstart ; $r <= $newrowend ; $r++) | ||||
1977 | { # fill the new cells | ||||||
1978 | 0 | 0 | for (my $c = $newcolstart ; $c <= $newcolend ; $c++) { | ||||
1979 | 0 | 0 | my $cr = cr_to_coord($c, $r); | ||||
1980 | 0 | 0 | delete $cellattribs->{$cr}; | ||||
1981 | 0 | 0 | delete $datavalues->{$cr}; | ||||
1982 | 0 | 0 | delete $datatypes->{$cr}; | ||||
1983 | 0 | 0 | delete $valuetypes->{$cr}; | ||||
1984 | 0 | 0 | delete $dataformulas->{$cr}; | ||||
1985 | 0 | 0 | delete $cellerrors->{$cr}; | ||||
1986 | 0 | 0 | my $crbase = | ||||
1987 | cr_to_coord($c - $coloffset, $r - $rowoffset) | ||||||
1988 | ; # copy attribs of the one before (0 give you A or 1) | ||||||
1989 | |||||||
1990 | 0 | 0 | 0 | if ($cellattribs->{$crbase}) { | |||
1991 | 0 | 0 | $cellattribs->{$cr} = { 'coord' => $cr }; | ||||
1992 | 0 | 0 | foreach my $attribtype (keys %{ $cellattribs->{$crbase} }) { | ||||
0 | 0 | ||||||
1993 | 0 | 0 | 0 | if ($attribtype ne "coord") { | |||
1994 | 0 | 0 | $cellattribs->{$cr}->{$attribtype} = | ||||
1995 | $cellattribs->{$crbase}->{$attribtype}; | ||||||
1996 | } | ||||||
1997 | } | ||||||
1998 | } | ||||||
1999 | } | ||||||
2000 | } | ||||||
2001 | 0 | 0 | foreach my $cr (keys %$dataformulas) | ||||
2002 | { # update cell references to moved cells in calculated formulas | ||||||
2003 | 0 | 0 | 0 | if ($datatypes->{$cr} eq "f") { | |||
2004 | 0 | 0 | $dataformulas->{$cr} = | ||||
2005 | adjust_formula_coords($dataformulas->{$cr}, $c1, $coloffset, $r1, | ||||||
2006 | $rowoffset); | ||||||
2007 | } | ||||||
2008 | } | ||||||
2009 | 0 | 0 | foreach my $name (keys %$names) | ||||
2010 | { # update cell references to moved cells in names | ||||||
2011 | 0 | 0 | 0 | if ($names->{$name}) { # works with "A1", "A1:A20", and "=formula" forms | |||
2012 | 0 | 0 | $v1 = $names->{$name}->{definition}; | ||||
2013 | 0 | 0 | $v2 = ""; | ||||
2014 | 0 | 0 | 0 | if (substr($v1, 0, 1) eq "=") { | |||
2015 | 0 | 0 | $v2 = "="; | ||||
2016 | 0 | 0 | $v1 = substr($v1, 1); | ||||
2017 | } | ||||||
2018 | 0 | 0 | $names->{$name}->{definition} = | ||||
2019 | $v2 . adjust_formula_coords($v1, $c1, $coloffset, $r1, $rowoffset); | ||||||
2020 | } | ||||||
2021 | } | ||||||
2022 | 0 | 0 | 0 | for (my $row = $lastrow ; | |||
2023 | $row >= $rowend && $cmd1 eq "insertrow" ; $row--) | ||||||
2024 | { # copy the row attributes forward | ||||||
2025 | 0 | 0 | my $rownext = $row + $rowoffset; | ||||
2026 | 0 | 0 | $rowattribs->{$rownext} = { 'coord' => $rownext }; # start clean | ||||
2027 | 0 | 0 | foreach my $attribtype (keys %{ $rowattribs->{$row} }) { | ||||
0 | 0 | ||||||
2028 | 0 | 0 | 0 | if ($attribtype ne "coord") { | |||
2029 | 0 | 0 | $rowattribs->{$rownext}->{$attribtype} = | ||||
2030 | $rowattribs->{$row}->{$attribtype}; | ||||||
2031 | } | ||||||
2032 | } | ||||||
2033 | } | ||||||
2034 | 0 | 0 | 0 | for (my $col = $lastcol ; | |||
2035 | $col >= $colend && $cmd1 eq "insertcol" ; $col--) | ||||||
2036 | { # copy the column attributes forward | ||||||
2037 | 0 | 0 | my $colthis = number_to_col($col); | ||||
2038 | 0 | 0 | my $colnext = number_to_col($col + $coloffset); | ||||
2039 | 0 | 0 | $colattribs->{$colnext} = { 'coord' => $colnext }; | ||||
2040 | 0 | 0 | foreach my $attribtype (keys %{ $colattribs->{$colthis} }) { | ||||
0 | 0 | ||||||
2041 | 0 | 0 | 0 | if ($attribtype ne "coord") { | |||
2042 | 0 | 0 | $colattribs->{$colnext}->{$attribtype} = | ||||
2043 | $colattribs->{$colthis}->{$attribtype}; | ||||||
2044 | } | ||||||
2045 | } | ||||||
2046 | } | ||||||
2047 | |||||||
2048 | 0 | 0 | $sheetattribs->{lastcol} += $coloffset; | ||||
2049 | 0 | 0 | $sheetattribs->{lastrow} += $rowoffset; | ||||
2050 | 0 | 0 | $sheetdata->{sheetattribs}->{needsrecalc} = "yes"; | ||||
2051 | } | ||||||
2052 | |||||||
2053 | elsif ($cmd1 eq "deletecol" || $cmd1 eq "deleterow") { | ||||||
2054 | 0 | 0 | ($what, $rest) = split (/ /, $rest, 2); | ||||
2055 | 0 | 0 | $what = uc($what); | ||||
2056 | 0 | 0 | ($coord1, $coord2) = split (/:/, $what); | ||||
2057 | 0 | 0 | my ($c1, $r1) = coord_to_cr($coord1); | ||||
2058 | 0 | 0 | my $c2 = $c1; | ||||
2059 | 0 | 0 | my $r2 = $r1; | ||||
2060 | 0 | 0 | 0 | ($c2, $r2) = coord_to_cr($coord2) if $coord2; | |||
2061 | 0 | 0 | my $lastcol = $sheetattribs->{lastcol}; | ||||
2062 | 0 | 0 | my $lastrow = $sheetattribs->{lastrow}; | ||||
2063 | 0 | 0 | my ($coloffset, $rowoffset, $colstart, $rowstart); | ||||
2064 | |||||||
2065 | 0 | 0 | 0 | if ($cmd1 eq "deletecol") { | |||
2066 | 0 | 0 | $coloffset = $c1 - $c2 - 1; | ||||
2067 | 0 | 0 | $colstart = $c2 + 1; | ||||
2068 | 0 | 0 | $rowstart = 1; | ||||
2069 | } else { | ||||||
2070 | 0 | 0 | $rowoffset = $r1 - $r2 - 1; | ||||
2071 | 0 | 0 | $rowstart = $r2 + 1; | ||||
2072 | 0 | 0 | $colstart = 1; | ||||
2073 | } | ||||||
2074 | |||||||
2075 | 0 | 0 | for (my $row = $rowstart ; $row <= $lastrow - $rowoffset ; $row++) | ||||
2076 | { # copy the cells backwards - extra so no dup of last set | ||||||
2077 | 0 | 0 | for (my $col = $colstart ; $col <= $lastcol - $coloffset ; $col++) { | ||||
2078 | 0 | 0 | my $coord = cr_to_coord($col, $row); | ||||
2079 | 0 | 0 | my $coordbefore = cr_to_coord($col + $coloffset, $row + $rowoffset); | ||||
2080 | 0 | 0 | 0 | if (!$cellattribs->{$coord}) { # copying empty cell | |||
2081 | 0 | 0 | delete $cellattribs->{$coordbefore}; | ||||
2082 | 0 | 0 | delete $datavalues->{$coordbefore}; | ||||
2083 | 0 | 0 | delete $datatypes->{$coordbefore}; | ||||
2084 | 0 | 0 | delete $valuetypes->{$coordbefore}; | ||||
2085 | 0 | 0 | delete $dataformulas->{$coordbefore}; | ||||
2086 | 0 | 0 | delete $cellerrors->{$coordbefore}; | ||||
2087 | 0 | 0 | next; | ||||
2088 | } | ||||||
2089 | 0 | 0 | $cellattribs->{$coordbefore} = | ||||
2090 | { 'coord' => $coordbefore }; # Start with minimal set | ||||||
2091 | 0 | 0 | foreach my $attribtype (keys %{ $cellattribs->{$coord} }) { | ||||
0 | 0 | ||||||
2092 | 0 | 0 | 0 | if ($attribtype ne "coord") { | |||
2093 | 0 | 0 | $cellattribs->{$coordbefore}->{$attribtype} = | ||||
2094 | $cellattribs->{$coord}->{$attribtype}; | ||||||
2095 | } | ||||||
2096 | } | ||||||
2097 | 0 | 0 | $datavalues->{$coordbefore} = $datavalues->{$coord}; | ||||
2098 | 0 | 0 | $datatypes->{$coordbefore} = $datatypes->{$coord}; | ||||
2099 | 0 | 0 | $valuetypes->{$coordbefore} = $valuetypes->{$coord}; | ||||
2100 | 0 | 0 | $dataformulas->{$coordbefore} = $dataformulas->{$coord}; | ||||
2101 | 0 | 0 | $cellerrors->{$coordbefore} = $cellerrors->{$coord}; | ||||
2102 | } | ||||||
2103 | } | ||||||
2104 | 0 | 0 | foreach my $cr (keys %$dataformulas) | ||||
2105 | { # update references to moved cells in calculated formulas | ||||||
2106 | 0 | 0 | 0 | if ($datatypes->{$cr} eq "f") { | |||
2107 | 0 | 0 | $dataformulas->{$cr} = | ||||
2108 | adjust_formula_coords($dataformulas->{$cr}, $c1, $coloffset, $r1, | ||||||
2109 | $rowoffset); | ||||||
2110 | } | ||||||
2111 | } | ||||||
2112 | 0 | 0 | foreach my $name (keys %$names) | ||||
2113 | { # update cell references to moved cells in names | ||||||
2114 | 0 | 0 | 0 | if ($names->{$name}) { # works with "A1", "A1:A20", and "=formula" forms | |||
2115 | 0 | 0 | $v1 = $names->{$name}->{definition}; | ||||
2116 | 0 | 0 | $v2 = ""; | ||||
2117 | 0 | 0 | 0 | if (substr($v1, 0, 1) eq "=") { | |||
2118 | 0 | 0 | $v2 = "="; | ||||
2119 | 0 | 0 | $v1 = substr($v1, 1); | ||||
2120 | } | ||||||
2121 | 0 | 0 | $names->{$name}->{definition} = | ||||
2122 | $v2 . adjust_formula_coords($v1, $c1, $coloffset, $r1, $rowoffset); | ||||||
2123 | } | ||||||
2124 | } | ||||||
2125 | 0 | 0 | 0 | for ( | |||
2126 | my $row = $rowstart ; | ||||||
2127 | $row <= $lastrow - $rowoffset && $cmd1 eq "deleterow" ; | ||||||
2128 | $row++ | ||||||
2129 | ) { # copy the row attributes backward | ||||||
2130 | 0 | 0 | my $rowbefore = $row + $rowoffset; | ||||
2131 | 0 | 0 | $rowattribs->{$rowbefore} = | ||||
2132 | { 'coord' => $rowbefore }; # start with only coord | ||||||
2133 | 0 | 0 | foreach my $attribtype (keys %{ $rowattribs->{$row} }) { | ||||
0 | 0 | ||||||
2134 | 0 | 0 | 0 | if ($attribtype ne "coord") { | |||
2135 | 0 | 0 | $rowattribs->{$rowbefore}->{$attribtype} = | ||||
2136 | $rowattribs->{$row}->{$attribtype}; | ||||||
2137 | } | ||||||
2138 | } | ||||||
2139 | } | ||||||
2140 | 0 | 0 | 0 | for ( | |||
2141 | my $col = $colstart ; | ||||||
2142 | $col <= $lastcol - $coloffset && $cmd1 eq "deletecol" ; | ||||||
2143 | $col++ | ||||||
2144 | ) { # copy the column attributes backward | ||||||
2145 | 0 | 0 | my $colthis = number_to_col($col); | ||||
2146 | 0 | 0 | my $colbefore = number_to_col($col + $coloffset); | ||||
2147 | 0 | 0 | $colattribs->{$colbefore} = { 'coord' => $colbefore }; | ||||
2148 | 0 | 0 | foreach my $attribtype (keys %{ $colattribs->{$colthis} }) { | ||||
0 | 0 | ||||||
2149 | 0 | 0 | 0 | if ($attribtype ne "coord") { | |||
2150 | 0 | 0 | $colattribs->{$colbefore}->{$attribtype} = | ||||
2151 | $colattribs->{$colthis}->{$attribtype}; | ||||||
2152 | } | ||||||
2153 | } | ||||||
2154 | } | ||||||
2155 | |||||||
2156 | 0 | 0 | 0 | if ($cmd1 eq "deletecol") { | |||
2157 | 0 | 0 | 0 | if ($c1 <= $lastcol) | |||
2158 | { # shrink sheet unless deleted phantom cols off the end | ||||||
2159 | 0 | 0 | 0 | if ($c2 <= $lastcol) { | |||
2160 | 0 | 0 | $sheetattribs->{lastcol} += $coloffset; | ||||
2161 | } else { | ||||||
2162 | 0 | 0 | $sheetattribs->{lastcol} = $c1 - 1; | ||||
2163 | } | ||||||
2164 | } | ||||||
2165 | } else { | ||||||
2166 | 0 | 0 | 0 | if ($r1 <= $lastrow) | |||
2167 | { # shrink sheet unless deleted phantom rows off the end | ||||||
2168 | 0 | 0 | 0 | if ($r2 <= $lastrow) { | |||
2169 | 0 | 0 | $sheetattribs->{lastrow} += $rowoffset; | ||||
2170 | } else { | ||||||
2171 | 0 | 0 | $sheetattribs->{lastrow} = $r1 - 1; | ||||
2172 | } | ||||||
2173 | } | ||||||
2174 | } | ||||||
2175 | 0 | 0 | $sheetdata->{sheetattribs}->{needsrecalc} = "yes"; | ||||
2176 | } | ||||||
2177 | |||||||
2178 | elsif ($cmd1 eq "name") { | ||||||
2179 | 1 | 5 | ($what, $name, $rest) = split (/ /, $rest, 3); | ||||
2180 | 1 | 3 | $name = uc $name; | ||||
2181 | 1 | 50 | 3 | if ($what eq "define") { | |||
0 | |||||||
0 | |||||||
2182 | 1 | 50 | 3 | $value = $names->{$name} ? $names->{$name}->{desc} : ""; | |||
2183 | 1 | 6 | $names->{$name} = { definition => $rest, desc => $value }; | ||||
2184 | } elsif ($what eq "desc") { | ||||||
2185 | 0 | 0 | 0 | if ($names->{$name}) { | |||
2186 | 0 | 0 | $names->{$name}->{desc} = $rest; | ||||
2187 | } else { | ||||||
2188 | 0 | 0 | $names->{$name} = { definition => "", desc => $rest }; | ||||
2189 | } | ||||||
2190 | } elsif ($what eq "delete") { | ||||||
2191 | 0 | 0 | delete $names->{$name}; | ||||
2192 | } | ||||||
2193 | } | ||||||
2194 | |||||||
2195 | else { | ||||||
2196 | 3 | 13 | $errortext = "Unknown command '$cmd1' in line:\n$command\n"; | ||||
2197 | 3 | 12 | return 0; | ||||
2198 | } | ||||||
2199 | |||||||
2200 | 675 | 2480 | return $command; | ||||
2201 | } | ||||||
2202 | |||||||
2203 | =head2 recalc_sheet | ||||||
2204 | |||||||
2205 | recalc_sheet(\%sheetdata); | ||||||
2206 | |||||||
2207 | Recalculates the entire spreadsheet | ||||||
2208 | |||||||
2209 | =cut | ||||||
2210 | |||||||
2211 | sub recalc_sheet { | ||||||
2212 | 680 | 680 | 1 | 1021 | my $Sheet = shift; | ||
2213 | |||||||
2214 | 680 | 2011 | $Sheet->{checked} = {}; | ||||
2215 | 680 | 1808 | delete $Sheet->{sheetattribs}->{circularreferencecell}; | ||||
2216 | |||||||
2217 | 680 | 1023 | foreach my $coord (keys %{ $Sheet->{formulas} }) { | ||||
680 | 15146 | ||||||
2218 | 52629 | 50 | 149700 | my $err = check_and_calc_cell($Sheet, $coord) if $coord; | |||
2219 | } | ||||||
2220 | |||||||
2221 | 680 | 20489 | delete $Sheet | ||||
2222 | ->{checked}; # save memory and clear out for name lookup formula evaluation | ||||||
2223 | 680 | 4555 | delete $Sheet->{sheetattribs}->{needsrecalc}; # remember recalc done | ||||
2224 | } | ||||||
2225 | |||||||
2226 | =head2 parse_header_save | ||||||
2227 | |||||||
2228 | parse_header_save(\@lines, my \%headerdata); | ||||||
2229 | |||||||
2230 | Returns "" if OK, otherwise error string. | ||||||
2231 | |||||||
2232 | Fills in %headerdata: | ||||||
2233 | |||||||
2234 | $headerdata{version} - version number, currently 1.1 | ||||||
2235 | $headerdata{fullname} - title of page | ||||||
2236 | $headerdata{templatetext} - template HTML | ||||||
2237 | $headerdata{templatefile} - where to get template (location:name), see get_template | ||||||
2238 | $headerdata{lastmodified} - date/time last modified | ||||||
2239 | $headerdata{lastauthor} - author when last modified | ||||||
2240 | $headerdata{basefiledt} - date/time of backup file before this set of edits or blank if new file first edits (survives rename) | ||||||
2241 | $headerdata{backupfiledt} - date/time of backup file holding this data (blank during edits, yyyy-mm-... in published/backup/archive) | ||||||
2242 | $headerdata{reverted} - if non-blank, name of backup file this came from (only during initial editing) | ||||||
2243 | $headerdata{editcomments} - comment text about this series of edits, used when listing backups and RSS | ||||||
2244 | $headerdata{publishhtml} - publish the HTML for this page - sometimes you only want access-controlled live view (yes/no - default yes) | ||||||
2245 | $headerdata{publishsource} - put a copy of the published .txt file along with HTML and allow live view of source (yes/no - default no) | ||||||
2246 | $headerdata{publishjs} - put an embeddable copy of the published HTML as a .js file along with HTML (yes/no - default no) | ||||||
2247 | $headerdata{publishlive} - (ignored and removed after 0.91) make the HTML be a redirect to the recalc code (yes/no - default no) | ||||||
2248 | $headerdata{viewwithoutlogin} - allow live view without being logged in (ignore login for this page) | ||||||
2249 | $headerdata{editlog} - array of entries about edits made since editing started (cleared on new open for edit) | ||||||
2250 | [0] - log entry: command string to execute_sheet_command or comment (starts with "# ") | ||||||
2251 | |||||||
2252 | =cut | ||||||
2253 | |||||||
2254 | sub parse_header_save { | ||||||
2255 | 1 | 1 | 1 | 30 | my ($lines, $headerdata) = @_; | ||
2256 | 1 | 3 | foreach my $line (@$lines) { | ||||
2257 | 9 | 38 | chomp $line; | ||||
2258 | 9 | 13 | $line =~ s/\r//g; | ||||
2259 | 9 | 25 | my ($linetype, $rest) = split (/:/, $line, 2); | ||||
2260 | 9 | 100 | 100 | 80 | next if !$linetype or $linetype =~ /^#/ or $linetype !~ /\S/; | ||
100 | |||||||
2261 | |||||||
2262 | 6 | 100 | 15 | if ($linetype eq 'edit') { | |||
2263 | 3 | 4 | push @{ $headerdata->{editlog} }, decode_from_save($rest); | ||||
3 | 16 | ||||||
2264 | } else { | ||||||
2265 | 3 | 9 | $headerdata->{$linetype} = decode_from_save($rest); | ||||
2266 | } | ||||||
2267 | } | ||||||
2268 | |||||||
2269 | 1 | 3 | return ""; | ||||
2270 | } | ||||||
2271 | |||||||
2272 | =head2 create_header_save | ||||||
2273 | |||||||
2274 | my $outstr = create_header_save(\%headerdata); | ||||||
2275 | |||||||
2276 | Header output routine | ||||||
2277 | |||||||
2278 | =cut | ||||||
2279 | |||||||
2280 | sub create_header_save { | ||||||
2281 | |||||||
2282 | 0 | 0 | 1 | 0 | my $headerdata = shift @_; | ||
2283 | |||||||
2284 | 0 | 0 | my $outstr; | ||||
2285 | |||||||
2286 | 0 | 0 | $headerdata->{version} = "1.1"; # this is the current version | ||||
2287 | |||||||
2288 | 0 | 0 | foreach my $val (@headerfieldnames) { | ||||
2289 | 0 | 0 | my $valstr = encode_for_save($headerdata->{$val}); | ||||
2290 | 0 | 0 | $outstr .= "$val:$valstr\n"; | ||||
2291 | } | ||||||
2292 | |||||||
2293 | 0 | 0 | foreach my $logentry (@{ $headerdata->{editlog} }) { | ||||
0 | 0 | ||||||
2294 | 0 | 0 | my $valstr = encode_for_save($logentry); | ||||
2295 | 0 | 0 | $outstr .= "edit:$valstr\n"; | ||||
2296 | } | ||||||
2297 | |||||||
2298 | 0 | 0 | return $outstr; | ||||
2299 | |||||||
2300 | } | ||||||
2301 | |||||||
2302 | =head2 add_to_editlog | ||||||
2303 | |||||||
2304 | add_to_editlog(\%headerdata, $str); | ||||||
2305 | |||||||
2306 | Adds $str to the header editlog. This should be either a string | ||||||
2307 | acceptable to execute_sheet_command or start with "# " | ||||||
2308 | |||||||
2309 | =cut | ||||||
2310 | |||||||
2311 | sub add_to_editlog { | ||||||
2312 | 0 | 0 | 1 | 0 | my ($headerdata, $str) = @_; | ||
2313 | 0 | 0 | 0 | $headerdata->{editlog} ||= (); # make sure array exists | |||
2314 | 0 | 0 | push @{ $headerdata->{editlog} }, $str; | ||||
0 | 0 | ||||||
2315 | 0 | 0 | return; | ||||
2316 | } | ||||||
2317 | |||||||
2318 | =head1 OTHER EXPORTS | ||||||
2319 | |||||||
2320 | These are currently exported, as they are used from multiple places. You | ||||||
2321 | shouldn't rely on this, however, as they will likely move somewhere else | ||||||
2322 | RSN. | ||||||
2323 | |||||||
2324 | =head2 convert_date_gregorian_to_julian | ||||||
2325 | |||||||
2326 | $juliandate = convert_date_gregorian_to_julian($year, $month, $day); | ||||||
2327 | |||||||
2328 | From: http://aa.usno.navy.mil/faq/docs/JD_Formula.html | ||||||
2329 | |||||||
2330 | Uses: Fliegel, H. F. and van Flandern, T. C. (1968). Communications of the ACM, Vol. 11, No. 10 (October, 1968). | ||||||
2331 | Translated from the FORTRAN. | ||||||
2332 | |||||||
2333 | =cut | ||||||
2334 | |||||||
2335 | sub convert_date_gregorian_to_julian { | ||||||
2336 | |||||||
2337 | 1852 | 1852 | 1 | 2817 | my ($year, $month, $day) = @_; | ||
2338 | |||||||
2339 | 1852 | 6421 | my $juliandate = | ||||
2340 | $day - 32075 + int(1461 * ($year + 4800 + int(($month - 14) / 12)) / 4); | ||||||
2341 | 1852 | 4322 | $juliandate += int(367 * ($month - 2 - int(($month - 14) / 12) * 12) / 12); | ||||
2342 | 1852 | 4124 | $juliandate = $juliandate - | ||||
2343 | int(3 * int(($year + 4900 + int(($month - 14) / 12)) / 100) / 4); | ||||||
2344 | |||||||
2345 | 1852 | 40790 | return $juliandate; | ||||
2346 | |||||||
2347 | } | ||||||
2348 | |||||||
2349 | =head2 convert_date_julian_to_gregorian | ||||||
2350 | |||||||
2351 | ($year, $month, $day) = convert_date_julian_to_gregorian($juliandate) | ||||||
2352 | |||||||
2353 | From: http://aa.usno.navy.mil/faq/docs/JD_Formula.html | ||||||
2354 | |||||||
2355 | Uses: Fliegel, H. F. and van Flandern, T. C. (1968). Communications of the ACM, Vol. 11, No. 10 (October, 1968). | ||||||
2356 | Translated from the FORTRAN. | ||||||
2357 | |||||||
2358 | =cut | ||||||
2359 | |||||||
2360 | sub convert_date_julian_to_gregorian { | ||||||
2361 | |||||||
2362 | 215 | 215 | 1 | 431 | my $juliandate = shift @_; | ||
2363 | |||||||
2364 | 215 | 354 | my ($L, $N, $I, $J, $K); | ||||
2365 | |||||||
2366 | 215 | 470 | $L = $juliandate + 68569; | ||||
2367 | 215 | 587 | $N = int(4 * $L / 146097); | ||||
2368 | 215 | 505 | $L = $L - int((146097 * $N + 3) / 4); | ||||
2369 | 215 | 699 | $I = int(4000 * ($L + 1) / 1461001); | ||||
2370 | 215 | 466 | $L = $L - int(1461 * $I / 4) + 31; | ||||
2371 | 215 | 391 | $J = int(80 * $L / 2447); | ||||
2372 | 215 | 429 | $K = $L - int(2447 * $J / 80); | ||||
2373 | 215 | 345 | $L = int($J / 11); | ||||
2374 | 215 | 470 | $J = $J + 2 - 12 * $L; | ||||
2375 | 215 | 383 | $I = 100 * ($N - 49) + $I + $L; | ||||
2376 | |||||||
2377 | 215 | 1161 | return ($I, $J, $K); | ||||
2378 | } | ||||||
2379 | |||||||
2380 | =head2 determine_value_type | ||||||
2381 | |||||||
2382 | $value = determine_value_type($rawvalue, \$type) | ||||||
2383 | |||||||
2384 | Takes a value and looks for special formatting like $, %, numbers, etc. | ||||||
2385 | Returns the value as a number or string and the type. | ||||||
2386 | Tries to follow the spec for spreadsheet function VALUE(v). | ||||||
2387 | |||||||
2388 | =cut | ||||||
2389 | |||||||
2390 | sub determine_value_type { | ||||||
2391 | |||||||
2392 | 4008 | 4008 | 1 | 7298 | my ($rawvalue, $type) = @_; | ||
2393 | |||||||
2394 | 4008 | 100 | 8682 | my $value = $rawvalue || ''; | |||
2395 | |||||||
2396 | 4008 | 5373 | $$type = "t"; | ||||
2397 | |||||||
2398 | 4008 | 5554 | my $fch = substr($value, 0, 1); | ||||
2399 | 4008 | 5742 | my $tvalue = $value; | ||||
2400 | 4008 | 8926 | $tvalue =~ s/^\s+//; # value with leading and trailing spaces removed | ||||
2401 | 4008 | 7167 | $tvalue =~ s/\s+$//; | ||||
2402 | |||||||
2403 | 4008 | 100 | 33 | 44510 | if (length $value == 0) { | ||
50 | 33 | ||||||
100 | |||||||
100 | |||||||
50 | |||||||
50 | |||||||
50 | |||||||
50 | |||||||
100 | |||||||
100 | |||||||
100 | |||||||
100 | |||||||
100 | |||||||
50 | |||||||
2404 | 17 | 32 | $$type = ""; | ||||
2405 | } elsif ($value =~ m/^\s+$/) { # just blanks | ||||||
2406 | ; # leave as is with type "t" | ||||||
2407 | } elsif ($tvalue =~ m/^[-+]?\d*(?:\.)?\d*(?:[eE][-+]?\d+)?$/) | ||||||
2408 | { # general number, including E | ||||||
2409 | 3172 | 4705 | $value = $tvalue + 0; | ||||
2410 | 3172 | 4489 | $$type = "n"; | ||||
2411 | } elsif ($tvalue =~ m/^[-+]?\d*(?:\.)?\d*\s*%$/) { # 15.1% | ||||||
2412 | 21 | 74 | $value = substr($tvalue, 0, -1) / 100; | ||||
2413 | 21 | 41 | $$type = "n%"; | ||||
2414 | } elsif ($tvalue =~ m/^[-+]?\$\s*\d*(?:\.)?\d*\s*$/ && $tvalue =~ m/\d/) | ||||||
2415 | { # $1.49 | ||||||
2416 | 0 | 0 | $tvalue =~ s/\$//; | ||||
2417 | 0 | 0 | $value = $tvalue; | ||||
2418 | 0 | 0 | $$type = 'n$'; | ||||
2419 | } elsif ($tvalue =~ m/^[-+]?(\d*,\d*)+(?:\.)?\d*$/) { # 1,234.49 | ||||||
2420 | 0 | 0 | $tvalue =~ s/,//g; | ||||
2421 | 0 | 0 | $value = $tvalue; | ||||
2422 | 0 | 0 | $$type = 'n'; | ||||
2423 | } elsif ($tvalue =~ m/^[-+]?(\d*,\d*)+(?:\.)?\d*\s*%$/) { # 1,234.49% | ||||||
2424 | 0 | 0 | $tvalue =~ s/,//g; | ||||
2425 | 0 | 0 | $value = substr($tvalue, 0, -1) / 100; | ||||
2426 | 0 | 0 | $$type = 'n%'; | ||||
2427 | } elsif ($tvalue =~ m/^[-+]?\$\s*(\d*,\d*)+(?:\.)?\d*$/ && $tvalue =~ m/\d/) | ||||||
2428 | { # $1,234.49 | ||||||
2429 | 0 | 0 | $tvalue =~ s/,//g; | ||||
2430 | 0 | 0 | $tvalue =~ s/\$//; | ||||
2431 | 0 | 0 | $value = $tvalue; | ||||
2432 | 0 | 0 | $$type = 'n$'; | ||||
2433 | } elsif ($value =~ m/^(\d{1,2})[\/\-](\d{1,2})[\/\-](\d{1,4})\s*$/) | ||||||
2434 | { # MM/DD/YYYY, MM/DD/YYYY | ||||||
2435 | 32 | 100 | 174 | my $year = $3 < 1000 ? $3 + 2000 : $3; | |||
2436 | 32 | 118 | $value = convert_date_gregorian_to_julian($year, $1, $2) - 2415019; | ||||
2437 | 32 | 81 | $$type = 'nd'; | ||||
2438 | } elsif ($value =~ m/^(\d{4})[\/\-](\d{1,2})[\/\-](\d{1,2})\s*$/) | ||||||
2439 | { # YYYY-MM-DD, YYYY/MM/DD | ||||||
2440 | 126 | 50 | 466 | my $year = $1 < 1000 ? $1 + 2000 : $1; | |||
2441 | 126 | 335 | $value = convert_date_gregorian_to_julian($year, $2, $3) - 2415019; | ||||
2442 | 126 | 231 | $$type = 'nd'; | ||||
2443 | } elsif ($value =~ m/^(\d{1,2}):(\d{1,2})\s*$/) { # HH:MM | ||||||
2444 | 77 | 231 | my $hour = $1; | ||||
2445 | 77 | 212 | my $minute = $2; | ||||
2446 | 77 | 50 | 33 | 520 | if ($hour < 24 && $minute < 60) { | ||
2447 | 77 | 280 | $value = $hour / 24 + $minute / (24 * 60); | ||||
2448 | 77 | 206 | $$type = 'nt'; | ||||
2449 | } | ||||||
2450 | } elsif ($value =~ m/^(\d{1,2}):(\d{1,2}):(\d{1,2})\s*$/) { # HH:MM:SS | ||||||
2451 | 12 | 34 | my $hour = $1; | ||||
2452 | 12 | 32 | my $minute = $2; | ||||
2453 | 12 | 34 | my $second = $3; | ||||
2454 | 12 | 50 | 33 | 107 | if ($hour < 24 && $minute < 60 && $second < 60) { | ||
33 | |||||||
2455 | 12 | 37 | $value = $hour / 24 + $minute / (24 * 60) + $second / (24 * 60 * 60); | ||||
2456 | 12 | 28 | $$type = 'nt'; | ||||
2457 | } | ||||||
2458 | } elsif ($value =~ m/^\s*([-+]?\d+) (\d+)\/(\d+)\s*$/) { # 1 1/2 | ||||||
2459 | 54 | 213 | my $int = $1; | ||||
2460 | 54 | 155 | my $num = $2; | ||||
2461 | 54 | 115 | my $denom = $3; | ||||
2462 | 54 | 50 | 199 | if ($denom > 0) { | |||
2463 | 54 | 194 | $value = $int + $num / $denom; | ||||
2464 | 54 | 141 | $$type = 'n'; | ||||
2465 | } | ||||||
2466 | } elsif ($input_constants{ uc($value) }) { | ||||||
2467 | 0 | 0 | ($value, $$type) = split (/,/, $input_constants{ uc($value) }); | ||||
2468 | } | ||||||
2469 | |||||||
2470 | 4008 | 12454 | return $value; | ||||
2471 | |||||||
2472 | } | ||||||
2473 | |||||||
2474 | =head2 test_criteria | ||||||
2475 | |||||||
2476 | test_criteria($value, $type, $criteria); | ||||||
2477 | |||||||
2478 | Determines whether a value/type meets the criteria. A criteria can | ||||||
2479 | be a numeric value, text beginning with <, <=, =, >=, >, <>, text | ||||||
2480 | by itself is start of text to match. | ||||||
2481 | |||||||
2482 | Returns 1 or 0 for true or false. | ||||||
2483 | |||||||
2484 | =cut | ||||||
2485 | |||||||
2486 | sub test_criteria { | ||||||
2487 | |||||||
2488 | 2908 | 2908 | 1 | 4833 | my ($value, $type, $criteria) = @_; | ||
2489 | |||||||
2490 | 2908 | 2886 | my ($comparitor, $basevalue, $basetype); | ||||
2491 | |||||||
2492 | 2908 | 50 | 5038 | return 0 | |||
2493 | unless defined $criteria; # undefined (e.g., error value) is always false | ||||||
2494 | |||||||
2495 | 2908 | 100 | 6804 | if ($criteria =~ m/^(<=|<>|<|=|>=|>)(.+?)$/) { # has comparitor | |||
2496 | 753 | 1238 | $comparitor = $1; | ||||
2497 | 753 | 1339 | $basevalue = $2; | ||||
2498 | } else { | ||||||
2499 | 2155 | 2351 | $comparitor = "none"; | ||||
2500 | 2155 | 8630 | $basevalue = $criteria; | ||||
2501 | } | ||||||
2502 | |||||||
2503 | 2908 | 5070 | my $basevaluenum = determine_value_type($basevalue, \$basetype); | ||||
2504 | 2908 | 50 | 6217 | if (!$basetype) { # no criteria base value given | |||
2505 | 0 | 0 | 0 | return 0 if $comparitor eq "none"; # blank criteria matches nothing | |||
2506 | 0 | 0 | 0 | if (substr($type, 0, 1) eq "b") { # empty cell | |||
2507 | 0 | 0 | 0 | return 1 if $comparitor eq "="; # empty equals empty | |||
2508 | } else { | ||||||
2509 | 0 | 0 | 0 | return 1 if $comparitor eq "<>"; # something does not equal empty | |||
2510 | } | ||||||
2511 | 0 | 0 | return 0; # otherwise false | ||||
2512 | } | ||||||
2513 | |||||||
2514 | 2908 | 3110 | my $cond = 0; | ||||
2515 | |||||||
2516 | 2908 | 100 | 100 | 12772 | if (substr($basetype, 0, 1) eq "n" && substr($type, 0, 1) eq "t") | ||
2517 | { # criteria is number, but value is text | ||||||
2518 | 17 | 28 | my $testtype; | ||||
2519 | 17 | 52 | my $testvalue = determine_value_type($value, \$testtype); | ||||
2520 | 17 | 100 | 65 | if (substr($testtype, 0, 1) eq "n") { # could be number - make it one | |||
2521 | 15 | 27 | $value = $testvalue; | ||||
2522 | 15 | 29 | $type = $testtype; | ||||
2523 | } | ||||||
2524 | } | ||||||
2525 | |||||||
2526 | 2908 | 100 | 66 | 11778 | if (substr($type, 0, 1) eq "n" && substr($basetype, 0, 1) eq "n") | ||
50 | |||||||
50 | |||||||
2527 | { # compare two numbers | ||||||
2528 | 2618 | 100 | 66 | 12630 | if ($comparitor eq "<") { $cond = $value < $basevaluenum ? 1 : 0; } | ||
582 | 100 | 1286 | |||||
100 | |||||||
100 | |||||||
100 | |||||||
50 | |||||||
0 | |||||||
2529 | 52 | 100 | 148 | elsif ($comparitor eq "<=") { $cond = $value <= $basevaluenum ? 1 : 0; } | |||
2530 | elsif ($comparitor eq "=" || $comparitor eq "none") { | ||||||
2531 | 1865 | 100 | 3664 | $cond = $value == $basevaluenum ? 1 : 0; | |||
2532 | } elsif ($comparitor eq ">=") { | ||||||
2533 | 21 | 100 | 44 | $cond = $value >= $basevaluenum ? 1 : 0; | |||
2534 | } elsif ($comparitor eq ">") { | ||||||
2535 | 98 | 100 | 230 | $cond = $value > $basevaluenum ? 1 : 0; | |||
2536 | } elsif ($comparitor eq "<>") { | ||||||
2537 | 0 | 0 | 0 | $cond = $value != $basevaluenum ? 1 : 0; | |||
2538 | } | ||||||
2539 | } elsif (substr($value, 0, 1) eq "e") { # error on left | ||||||
2540 | 0 | 0 | $cond = 0; | ||||
2541 | } elsif (substr($basetype, 0, 1) eq "e") { # error on right | ||||||
2542 | 0 | 0 | $cond = 0; | ||||
2543 | } else { # text maybe mixed with numbers or blank | ||||||
2544 | 290 | 50 | 1007 | if (substr($type, 0, 1) eq "n") { | |||
2545 | 0 | 0 | $value = format_number_for_display($value, "n", ""); | ||||
2546 | } | ||||||
2547 | 290 | 100 | 541 | if (substr($basetype, 0, 1) eq "n") { | |||
2548 | 6 | 31 | return 0; # if number and didn't match already, isn't a match | ||||
2549 | } | ||||||
2550 | |||||||
2551 | 284 | 543 | utf8::decode($value); # ignore case and use UTF-8 as chars not bytes | ||||
2552 | 284 | 352 | $value = lc $value; # ignore case | ||||
2553 | 284 | 394 | utf8::decode($basevalue); | ||||
2554 | 284 | 314 | $basevalue = lc $basevalue; | ||||
2555 | |||||||
2556 | 284 | 0 | 886 | if ($comparitor eq "<") { $cond = $value lt $basevalue ? 1 : 0; } | |||
0 | 50 | 0 | |||||
50 | |||||||
50 | |||||||
50 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
2557 | 0 | 0 | 0 | elsif ($comparitor eq "<=") { $cond = $value le $basevalue ? 1 : 0; } | |||
2558 | 0 | 0 | 0 | elsif ($comparitor eq "=") { $cond = $value eq $basevalue ? 1 : 0; } | |||
2559 | elsif ($comparitor eq "none") { | ||||||
2560 | 284 | 100 | 1604 | $cond = $value =~ m/^$basevalue/ ? 1 : 0; | |||
2561 | } elsif ($comparitor eq ">=") { | ||||||
2562 | 0 | 0 | 0 | $cond = $value ge $basevalue ? 1 : 0; | |||
2563 | } elsif ($comparitor eq ">") { | ||||||
2564 | 0 | 0 | 0 | $cond = $value gt $basevalue ? 1 : 0; | |||
2565 | } elsif ($comparitor eq "<>") { | ||||||
2566 | 0 | 0 | 0 | $cond = $value ne $basevalue ? 1 : 0; | |||
2567 | } | ||||||
2568 | } | ||||||
2569 | |||||||
2570 | 2902 | 15779 | return $cond; | ||||
2571 | |||||||
2572 | } | ||||||
2573 | |||||||
2574 | =head2 lookup_result_type | ||||||
2575 | |||||||
2576 | $resulttype = lookup_result_type($type1, $type2, \%typelookup); | ||||||
2577 | |||||||
2578 | %typelookup has values of the following form: | ||||||
2579 | |||||||
2580 | $typelookup{"typespec1"} = "|typespec2A:resultA|typespec2B:resultB|..." | ||||||
2581 | |||||||
2582 | First $type1 is looked up. If no match, then the first letter (major | ||||||
2583 | type) of $type1 plus "*" is looked up. $resulttype is $type1 if | ||||||
2584 | result is "1", $type2 if result is "2", otherwise the value of | ||||||
2585 | result. | ||||||
2586 | |||||||
2587 | =cut | ||||||
2588 | |||||||
2589 | sub lookup_result_type { | ||||||
2590 | |||||||
2591 | 24509 | 24509 | 1 | 81009 | my ($type1, $type2, $typelookup) = @_; | ||
2592 | |||||||
2593 | 24509 | 29223 | my $t2 = $type2; | ||||
2594 | |||||||
2595 | 24509 | 42700 | my $table1 = $typelookup->{$type1}; | ||||
2596 | 24509 | 100 | 49150 | if (!$table1) { | |||
2597 | 8622 | 22621 | $table1 = $typelookup->{ substr($type1, 0, 1) . '*' }; | ||||
2598 | 8622 | 100 | 18605 | return "e#VALUE! (missing)" | |||
2599 | unless $table1; # missing from table -- please add it | ||||||
2600 | } | ||||||
2601 | 24283 | 100 | 203632 | if ($table1 =~ m/\Q|$type2:\E(.*?)\|/) { | |||
2602 | 15961 | 50 | 41034 | return $type1 if $1 eq '1'; | |||
2603 | 15961 | 50 | 33780 | return $type2 if $1 eq '2'; | |||
2604 | 15961 | 63708 | return $1; | ||||
2605 | } | ||||||
2606 | 8322 | 14427 | $t2 = substr($t2, 0, 1) . '*'; | ||||
2607 | 8322 | 50 | 63259 | if ($table1 =~ m/\Q|$t2:\E(.*?)\|/) { | |||
2608 | 8322 | 100 | 29009 | return $type1 if $1 eq '1'; | |||
2609 | 6018 | 100 | 17485 | return $type2 if $1 eq '2'; | |||
2610 | 5325 | 33452 | return $1; | ||||
2611 | } | ||||||
2612 | 0 | 0 | return "e#VALUE!"; | ||||
2613 | } | ||||||
2614 | |||||||
2615 | =head2 copy_function_args | ||||||
2616 | |||||||
2617 | copy_function_args(\@operand, \@foperand) | ||||||
2618 | |||||||
2619 | Pops operands from @operand and pushes on @foperand up to function start | ||||||
2620 | reversing order in the process. | ||||||
2621 | |||||||
2622 | =cut | ||||||
2623 | |||||||
2624 | sub copy_function_args { | ||||||
2625 | |||||||
2626 | 18496 | 18496 | 1 | 120004 | my ($operand, $foperand) = @_; | ||
2627 | |||||||
2628 | 18496 | 66 | 108125 | while (@$operand && $operand->[ @$operand - 1 ]->{type} ne "start") | |||
2629 | { # get each arg | ||||||
2630 | 27694 | 52009 | push @$foperand, $operand->[ @$operand - 1 ]; # copy it | ||||
2631 | 27694 | 135253 | pop @$operand; | ||||
2632 | } | ||||||
2633 | 18496 | 22179 | pop @$operand; # get rid of "start" | ||||
2634 | |||||||
2635 | 18496 | 69422 | return; | ||||
2636 | } | ||||||
2637 | |||||||
2638 | =head2 function_args_error | ||||||
2639 | |||||||
2640 | function_args_error($fname, \@operand, $$errortext) | ||||||
2641 | |||||||
2642 | Pushes appropriate error on operand stack and sets errortext, including $fname | ||||||
2643 | |||||||
2644 | =cut | ||||||
2645 | |||||||
2646 | sub function_args_error { | ||||||
2647 | |||||||
2648 | 5 | 5 | 1 | 15 | my ($fname, $operand, $errortext) = @_; | ||
2649 | |||||||
2650 | 5 | 15 | $$errortext = qq!Incorrect arguments to function "$fname". !; | ||||
2651 | 5 | 24 | push @$operand, { type => "e#VALUE!", value => $$errortext }; | ||||
2652 | |||||||
2653 | 5 | 15 | return; | ||||
2654 | } | ||||||
2655 | |||||||
2656 | =head2 function_specific_error | ||||||
2657 | |||||||
2658 | function_specific_error($fname, \@operand, $errortext, $errortype, $text) | ||||||
2659 | |||||||
2660 | Pushes specified error and text on operand stack | ||||||
2661 | |||||||
2662 | =cut | ||||||
2663 | |||||||
2664 | sub function_specific_error { | ||||||
2665 | |||||||
2666 | 0 | 0 | 1 | 0 | my ($fname, $operand, $errortext, $errortype, $text) = @_; | ||
2667 | |||||||
2668 | 0 | 0 | $$errortext = $text; | ||||
2669 | 0 | 0 | push @$operand, { type => $errortype, value => $$errortext }; | ||||
2670 | |||||||
2671 | 0 | 0 | return; | ||||
2672 | } | ||||||
2673 | |||||||
2674 | =head2 top_of_stack_value_and_type | ||||||
2675 | |||||||
2676 | ($value, $type) = top_of_stack_value_and_type(\%sheetdata, \@operand, \$errortext,) | ||||||
2677 | |||||||
2678 | Returns top of stack value and type and then pops the stack | ||||||
2679 | |||||||
2680 | =cut | ||||||
2681 | |||||||
2682 | sub top_of_stack_value_and_type { | ||||||
2683 | 827 | 827 | 1 | 3145 | my ($sheetdata, $operand, $errortext) = @_; | ||
2684 | 827 | 100 | 1675 | if (@$operand) { | |||
2685 | 773 | 2283 | my ($value, $type) = ( | ||||
2686 | $operand->[ @$operand - 1 ]->{value}, | ||||||
2687 | $operand->[ @$operand - 1 ]->{type} | ||||||
2688 | ); | ||||||
2689 | 773 | 970 | pop @$operand; | ||||
2690 | 773 | 100 | 2262 | if ($type eq "name") { | |||
2691 | 186 | 368 | $value = uc $value; | ||||
2692 | 186 | 514 | $value = lookup_name($sheetdata, $value, \$type, $errortext); | ||||
2693 | } | ||||||
2694 | 773 | 2806 | return ($value, $type); | ||||
2695 | } else { | ||||||
2696 | 54 | 150 | return (); | ||||
2697 | } | ||||||
2698 | } | ||||||
2699 | |||||||
2700 | =head2 operand_as_number | ||||||
2701 | |||||||
2702 | $value = operand_as_number(\%sheetdata, \@operand, \$errortext, \$tostype) | ||||||
2703 | |||||||
2704 | Uses operand_value_and_type to get top of stack and pops it. | ||||||
2705 | Returns numeric value and type. | ||||||
2706 | Text values are treated as 0 if they can't be converted somehow. | ||||||
2707 | |||||||
2708 | =cut | ||||||
2709 | |||||||
2710 | sub operand_as_number { | ||||||
2711 | |||||||
2712 | 48898 | 48898 | 1 | 149559 | my ($sheetdata, $operand, $errortext, $tostype) = @_; | ||
2713 | |||||||
2714 | 48898 | 80192 | my $value = | ||||
2715 | operand_value_and_type($sheetdata, $operand, $errortext, $tostype); | ||||||
2716 | |||||||
2717 | 48898 | 100 | 143734 | if (substr($$tostype, 0, 1) eq "n") { | |||
50 | |||||||
100 | |||||||
2718 | 48009 | 112379 | return 0 + $value; | ||||
2719 | } elsif (substr($$tostype, 0, 1) eq "b") { # blank cell | ||||||
2720 | 0 | 0 | $$tostype = "n"; | ||||
2721 | 0 | 0 | return 0; | ||||
2722 | } elsif (substr($$tostype, 0, 1) eq "e") { # error | ||||||
2723 | 97 | 250 | return 0; | ||||
2724 | } else { | ||||||
2725 | 792 | 2208 | $value = determine_value_type($value, $tostype); | ||||
2726 | 792 | 100 | 2165 | if (substr($$tostype, 0, 1) eq "n") { | |||
2727 | 604 | 1835 | return 0 + $value; | ||||
2728 | } else { | ||||||
2729 | 188 | 668 | return 0; | ||||
2730 | } | ||||||
2731 | } | ||||||
2732 | } | ||||||
2733 | |||||||
2734 | =head2 operand_as_text | ||||||
2735 | |||||||
2736 | $value = operand_as_text(\%sheetdata, \@operand, \$errortext, \$tostype) | ||||||
2737 | |||||||
2738 | Uses operand_value_and_type to get top of stack and pops it. | ||||||
2739 | Returns text value, preserving sub-type. | ||||||
2740 | |||||||
2741 | =cut | ||||||
2742 | |||||||
2743 | sub operand_as_text { | ||||||
2744 | |||||||
2745 | 2935 | 2935 | 1 | 16677 | my ($sheetdata, $operand, $errortext, $tostype) = @_; | ||
2746 | |||||||
2747 | 2935 | 5978 | my $value = | ||||
2748 | operand_value_and_type($sheetdata, $operand, $errortext, $tostype); | ||||||
2749 | |||||||
2750 | 2935 | 100 | 8314 | if (substr($$tostype, 0, 1) eq "t") { | |||
100 | |||||||
50 | |||||||
0 | |||||||
2751 | 2708 | 7675 | return $value; | ||||
2752 | } elsif (substr($$tostype, 0, 1) eq "n") { | ||||||
2753 | 157 | 301 | $value = "$value"; | ||||
2754 | 157 | 314 | $$tostype = "t"; | ||||
2755 | 157 | 487 | return $value; | ||||
2756 | } elsif (substr($$tostype, 0, 1) eq "b") { # blank | ||||||
2757 | 70 | 102 | $$tostype = "t"; | ||||
2758 | 70 | 175 | return ""; | ||||
2759 | } elsif (substr($$tostype, 0, 1) eq "e") { # error | ||||||
2760 | 0 | 0 | return ""; | ||||
2761 | } else { | ||||||
2762 | 0 | 0 | $$tostype = "t"; | ||||
2763 | 0 | 0 | return "$value"; | ||||
2764 | } | ||||||
2765 | } | ||||||
2766 | |||||||
2767 | =head2 operand_value_and_type | ||||||
2768 | |||||||
2769 | $value = operand_value_and_type(\%sheetdata, \@operand, \$errortext, \$operandtype) | ||||||
2770 | |||||||
2771 | Pops the top of stack and returns it, following a coord reference | ||||||
2772 | if necessary. Ranges are returned as if they were pushed onto the | ||||||
2773 | stack first coord first. Also sets $operandtype with "t", "n", | ||||||
2774 | "th", etc., as appropriate. Errortext is set if there is a reference | ||||||
2775 | to a cell with error. | ||||||
2776 | |||||||
2777 | =cut | ||||||
2778 | |||||||
2779 | sub operand_value_and_type { | ||||||
2780 | |||||||
2781 | 75829 | 75829 | 1 | 161495 | my ($sheetdata, $operand, $errortext, $operandtype) = @_; | ||
2782 | |||||||
2783 | 75829 | 88884 | my $stacklen = scalar @$operand; | ||||
2784 | 75829 | 50 | 148941 | if (!$stacklen) { # make sure something is there | |||
2785 | 0 | 0 | $$operandtype = ""; | ||||
2786 | 0 | 0 | return ""; | ||||
2787 | } | ||||||
2788 | 75829 | 140657 | my $value = $operand->[ $stacklen - 1 ]->{value}; # get top of stack | ||||
2789 | 75829 | 117845 | my $tostype = $operand->[ $stacklen - 1 ]->{type}; | ||||
2790 | 75829 | 94236 | pop @$operand; # we have data - pop stack | ||||
2791 | |||||||
2792 | 75829 | 100 | 209085 | if ($tostype eq "name") { | |||
2793 | 32 | 61 | $value = uc $value; | ||||
2794 | 32 | 89 | $value = lookup_name($sheetdata, $value, \$tostype, $errortext); | ||||
2795 | } | ||||||
2796 | |||||||
2797 | 75829 | 100 | 131074 | if ($tostype eq "range") { | |||
2798 | 3165 | 8472 | $value = step_through_range_down($operand, $value, \$tostype); | ||||
2799 | } | ||||||
2800 | |||||||
2801 | 75829 | 100 | 139391 | if ($tostype eq "coord") { # value is a coord reference | |||
2802 | 19894 | 23000 | my $coordsheetdata = $sheetdata; | ||||
2803 | 19894 | 50 | 44807 | if ($value =~ m/^([^!]+)!(.+)$/) { # sheet reference | |||
2804 | 0 | 0 | $value = $1; | ||||
2805 | 0 | 0 | my $othersheet = $2; | ||||
2806 | 0 | 0 | $coordsheetdata = find_in_sheet_cache($sheetdata, $othersheet); | ||||
2807 | 0 | 0 | 0 | if ($coordsheetdata->{loaderror}) { # this sheet is unavailable | |||
2808 | 0 | 0 | $$operandtype = "e#REF!"; | ||||
2809 | 0 | 0 | return 0; | ||||
2810 | } | ||||||
2811 | } | ||||||
2812 | 19894 | 44343 | my $cellvtype = | ||||
2813 | $coordsheetdata->{valuetypes} | ||||||
2814 | ->{$value}; # get type of value in the cell it points to | ||||||
2815 | 19894 | 36576 | $value = $coordsheetdata->{datavalues}->{$value}; | ||||
2816 | 19894 | 100 | 40347 | $tostype = $cellvtype || "b"; | |||
2817 | 19894 | 100 | 43769 | if ($tostype eq "b") { # blank | |||
2818 | 260 | 601 | $value = 0; | ||||
2819 | } | ||||||
2820 | } | ||||||
2821 | |||||||
2822 | 75829 | 97997 | $$operandtype = $tostype; # return information | ||||
2823 | 75829 | 171063 | return $value; | ||||
2824 | |||||||
2825 | } | ||||||
2826 | |||||||
2827 | =head2 decode_range_parts | ||||||
2828 | |||||||
2829 | ($sheetdata, $col1num, $ncols, $row1num, $nrows) = decode_range_parts(\@sheetdata, $rangevalue, $rangetype) | ||||||
2830 | |||||||
2831 | Returns \@sheetdata for the sheet where the range is, as well as | ||||||
2832 | the number of the first column in the range, the number of columns, | ||||||
2833 | and equivalent row information. | ||||||
2834 | |||||||
2835 | If any errors, $sheetdata is returned as null. | ||||||
2836 | |||||||
2837 | =cut | ||||||
2838 | |||||||
2839 | sub decode_range_parts { | ||||||
2840 | |||||||
2841 | 620 | 620 | 1 | 1130 | my ($sheetdata, $rangevalue, $rangetype) = @_; | ||
2842 | |||||||
2843 | 620 | 2488 | my ($value1, $value2, $sequence) = split (/\|/, $rangevalue); | ||||
2844 | 620 | 823 | my ($sheet1, $sheet2); | ||||
2845 | 620 | 1441 | ($value1, $sheet1) = split (/!/, $value1); | ||||
2846 | 620 | 1465 | ($value2, $sheet2) = split (/!/, $value2); | ||||
2847 | 620 | 843 | my $coordsheetdata = $sheetdata; | ||||
2848 | 620 | 50 | 1164 | if ($sheet1) { # sheet reference | |||
2849 | 0 | 0 | $coordsheetdata = find_in_sheet_cache($sheetdata, $sheet1); | ||||
2850 | 0 | 0 | 0 | if ($coordsheetdata->{loaderror}) { # this sheet is unavailable | |||
2851 | 0 | 0 | $coordsheetdata = undef; | ||||
2852 | } | ||||||
2853 | } | ||||||
2854 | |||||||
2855 | 620 | 1104 | my ($c1, $r1) = coord_to_cr($value1); | ||||
2856 | 620 | 1186 | my ($c2, $r2) = coord_to_cr($value2); | ||||
2857 | 620 | 50 | 1372 | ($c2, $c1) = ($c1, $c2) if ($c1 > $c2); | |||
2858 | 620 | 50 | 1481 | ($r2, $r1) = ($r1, $r2) if ($r1 > $r2); | |||
2859 | 620 | 2938 | return ($coordsheetdata, $c1, $c2 - $c1 + 1, $r1, $r2 - $r1 + 1); | ||||
2860 | } | ||||||
2861 | |||||||
2862 | =head2 coord_to_cr | ||||||
2863 | |||||||
2864 | ($col, $row) = coord_to_cr($coord) | ||||||
2865 | |||||||
2866 | Turns B3 into (2, 3). The default for both is 1. | ||||||
2867 | If range, only do this to first coord. | ||||||
2868 | |||||||
2869 | =cut | ||||||
2870 | |||||||
2871 | sub coord_to_cr { | ||||||
2872 | 16280 | 16280 | 1 | 43421 | my $coord = shift @_; | ||
2873 | 16280 | 23673 | $coord = lc($coord); | ||||
2874 | 16280 | 22405 | $coord =~ s/\$//g; | ||||
2875 | 16280 | 45883 | $coord =~ m/([a-z])([a-z])?(\d+)/; | ||||
2876 | 16280 | 31409 | my $col = ord($1) - ord('a') + 1; | ||||
2877 | 16280 | 50 | 36499 | $col = 26 * $col + ord($2) - ord('a') + 1 if $2; | |||
2878 | 16280 | 49865 | return ($col, $3); | ||||
2879 | } | ||||||
2880 | |||||||
2881 | =head2 cr_to_coord | ||||||
2882 | |||||||
2883 | $coord = cr_to_coord($col, $row) | ||||||
2884 | |||||||
2885 | Turns (2, 3) into B3. The default for both is 1. | ||||||
2886 | |||||||
2887 | =cut | ||||||
2888 | |||||||
2889 | sub cr_to_coord { | ||||||
2890 | 51087 | 51087 | 1 | 68722 | my ($col, $row) = @_; | ||
2891 | 51087 | 100 | 118384 | $row = 1 unless $row > 1; | |||
2892 | 51087 | 100 | 88576 | $col = 1 unless $col > 1; | |||
2893 | 51087 | 76496 | my $col_high = int(($col - 1) / 26); | ||||
2894 | 51087 | 69779 | my $col_low = ($col - 1) % 26; | ||||
2895 | 51087 | 67677 | my $coord = chr(ord('A') + $col_low); | ||||
2896 | 51087 | 50 | 85073 | $coord = chr(ord('A') + $col_high - 1) . $coord if $col_high; | |||
2897 | 51087 | 59598 | $coord .= $row; | ||||
2898 | 51087 | 117537 | return $coord; | ||||
2899 | } | ||||||
2900 | |||||||
2901 | =head2 encode_for_save | ||||||
2902 | |||||||
2903 | my $estring = encode_for_save($string) | ||||||
2904 | |||||||
2905 | Returns $estring where :, \n, and \ are escaped | ||||||
2906 | |||||||
2907 | =cut | ||||||
2908 | |||||||
2909 | sub encode_for_save { | ||||||
2910 | 0 | 0 | 1 | 0 | my $string = shift @_; | ||
2911 | 0 | 0 | $string =~ s/\\/\\b/g; # \ to \b | ||||
2912 | 0 | 0 | $string =~ s/:/\\c/g; # : to \c | ||||
2913 | 0 | 0 | $string =~ s/\n/\\n/g; # line end to \n | ||||
2914 | 0 | 0 | return $string; | ||||
2915 | } | ||||||
2916 | |||||||
2917 | =head2 decode_from_save | ||||||
2918 | |||||||
2919 | my $estring = decode_from_save($string) | ||||||
2920 | |||||||
2921 | Returns $estring with \c, \n, \b and \\ un-escaped | ||||||
2922 | |||||||
2923 | =cut | ||||||
2924 | |||||||
2925 | sub decode_from_save { | ||||||
2926 | 6508 | 6508 | 1 | 9074 | my $string = shift @_; | ||
2927 | 6508 | 7508 | $string =~ s/\\\\/\\/g; # Old -- shouldn't get this, replace with \b | ||||
2928 | 6508 | 7829 | $string =~ s/\\c/:/g; | ||||
2929 | 6508 | 6862 | $string =~ s/\\n/\n/g; | ||||
2930 | 6508 | 6312 | $string =~ s/\\b/\\/g; | ||||
2931 | 6508 | 15869 | return $string; | ||||
2932 | } | ||||||
2933 | |||||||
2934 | =head2 html_escape / special_chars | ||||||
2935 | |||||||
2936 | my $estring = html_escape($string) | ||||||
2937 | |||||||
2938 | Returns $estring where &, <, >, " are HTML escaped. | ||||||
2939 | |||||||
2940 | This used to be known as special_chars() but that usage is deprecated. | ||||||
2941 | |||||||
2942 | =cut | ||||||
2943 | |||||||
2944 | sub html_escape { | ||||||
2945 | 0 | 0 | 1 | 0 | my $string = shift @_; | ||
2946 | 0 | 0 | $string =~ s/&/&/g; | ||||
2947 | 0 | 0 | $string =~ s/</g; | ||||
2948 | 0 | 0 | $string =~ s/>/>/g; | ||||
2949 | 0 | 0 | $string =~ s/"/"/g; | ||||
2950 | 0 | 0 | return $string; | ||||
2951 | } | ||||||
2952 | *special_chars = \&html_escape; | ||||||
2953 | |||||||
2954 | =head2 special_chars_nl | ||||||
2955 | |||||||
2956 | my $estring = special_chars_nl($string) | ||||||
2957 | |||||||
2958 | Returns $estring where &, <, >, ", and LF are HTML escaped, CR's are removed | ||||||
2959 | |||||||
2960 | =cut | ||||||
2961 | |||||||
2962 | sub special_chars_nl { | ||||||
2963 | 0 | 0 | 1 | 0 | my $string = shift @_; | ||
2964 | 0 | 0 | $string =~ s/&/&/g; | ||||
2965 | 0 | 0 | $string =~ s/</g; | ||||
2966 | 0 | 0 | $string =~ s/>/>/g; | ||||
2967 | 0 | 0 | $string =~ s/"/"/g; | ||||
2968 | 0 | 0 | $string =~ s/\r//gs; | ||||
2969 | 0 | 0 | $string =~ s/\n/ /gs; | ||||
2970 | 0 | 0 | return $string; | ||||
2971 | } | ||||||
2972 | |||||||
2973 | =head1 HELPERS | ||||||
2974 | |||||||
2975 | These are 'private' functions, not exported, and should not be relied | ||||||
2976 | on. The interface to any of these is subject to change at any time. | ||||||
2977 | |||||||
2978 | =head2 offset_formula_coords | ||||||
2979 | |||||||
2980 | $updatedformula = offset_formula_coords($formula, $coloffset, $rowoffset); | ||||||
2981 | |||||||
2982 | Change relative cell references by offsets (even those to other | ||||||
2983 | worksheets so fill, paste, sort work as expected). If not what you | ||||||
2984 | want, use absolute references. | ||||||
2985 | |||||||
2986 | =cut | ||||||
2987 | |||||||
2988 | sub offset_formula_coords { | ||||||
2989 | |||||||
2990 | 0 | 0 | 1 | 0 | my ($formula, $coloffset, $rowoffset, $othersheets) = @_; | ||
2991 | |||||||
2992 | 0 | 0 | my $parseinfo = parse_formula_into_tokens($formula); | ||||
2993 | |||||||
2994 | 0 | 0 | my $parsed_token_text = $parseinfo->{tokentext}; | ||||
2995 | 0 | 0 | my $parsed_token_type = $parseinfo->{tokentype}; | ||||
2996 | 0 | 0 | my $parsed_token_opcode = $parseinfo->{tokenopcode}; | ||||
2997 | |||||||
2998 | 0 | 0 | my ($ttype, $ttext, $sheetref, $updatedformula); | ||||
2999 | 0 | 0 | for (my $i = 0 ; $i < scalar @$parsed_token_text ; $i++) { | ||||
3000 | 0 | 0 | $ttype = $parsed_token_type->[$i]; | ||||
3001 | 0 | 0 | $ttext = $parsed_token_text->[$i]; | ||||
3002 | 0 | 0 | 0 | if ($ttype == $token_coord) { | |||
0 | |||||||
0 | |||||||
3003 | 0 | 0 | my ($c, $r) = coord_to_cr($ttext); | ||||
3004 | 0 | 0 | my $abscol = $ttext =~ m/^\$/; | ||||
3005 | 0 | 0 | 0 | $c += $coloffset unless $abscol; | |||
3006 | 0 | 0 | my $absrow = $ttext =~ m/^\${0,1}[a-zA-Z]{1,2}\$\d+$/; | ||||
3007 | 0 | 0 | 0 | $r += $rowoffset unless $absrow; | |||
3008 | 0 | 0 | $ttext = cr_to_coord($c, $r); | ||||
3009 | 0 | 0 | 0 | $ttext =~ s/^/\$/ if $abscol; | |||
3010 | 0 | 0 | 0 | $ttext =~ s/(\d+)$/\$$1/ if $absrow; | |||
3011 | |||||||
3012 | 0 | 0 | 0 | 0 | if ($r < 1 || $c < 1) { | ||
3013 | 0 | 0 | $ttext = "ERRCELL"; | ||||
3014 | } | ||||||
3015 | } elsif ($ttype == $token_string) { | ||||||
3016 | 0 | 0 | $ttext =~ s/"/""/g; | ||||
3017 | 0 | 0 | $ttext = '"' . $ttext . '"'; | ||||
3018 | } elsif ($ttype == $token_op) { | ||||||
3019 | 0 | 0 | 0 | $ttext = $token_op_expansion{$ttext} | |||
3020 | || $ttext; # make sure short tokens (e.g., "G") go back full (">=") | ||||||
3021 | } | ||||||
3022 | 0 | 0 | $updatedformula .= $ttext; | ||||
3023 | } | ||||||
3024 | |||||||
3025 | 0 | 0 | return $updatedformula; | ||||
3026 | } | ||||||
3027 | |||||||
3028 | =head2 adjust_formula_coords | ||||||
3029 | |||||||
3030 | $updatedformula = adjust_formula_coords($formula, $col, $coloffset, $row, $rowoffset) | ||||||
3031 | |||||||
3032 | Change all cell references to cells starting with $col/$row by offsets | ||||||
3033 | |||||||
3034 | =cut | ||||||
3035 | |||||||
3036 | sub adjust_formula_coords { | ||||||
3037 | |||||||
3038 | 0 | 0 | 1 | 0 | my ($formula, $col, $coloffset, $row, $rowoffset) = @_; | ||
3039 | |||||||
3040 | 0 | 0 | my $parseinfo = parse_formula_into_tokens($formula); | ||||
3041 | |||||||
3042 | 0 | 0 | my $parsed_token_text = $parseinfo->{tokentext}; | ||||
3043 | 0 | 0 | my $parsed_token_type = $parseinfo->{tokentype}; | ||||
3044 | 0 | 0 | my $parsed_token_opcode = $parseinfo->{tokenopcode}; | ||||
3045 | |||||||
3046 | 0 | 0 | my ($ttype, $ttext, $sheetref, $updatedformula); | ||||
3047 | 0 | 0 | for (my $i = 0 ; $i < scalar @$parsed_token_text ; $i++) { | ||||
3048 | 0 | 0 | $ttype = $parsed_token_type->[$i]; | ||||
3049 | 0 | 0 | $ttext = $parsed_token_text->[$i]; | ||||
3050 | 0 | 0 | 0 | if ($ttype == $token_op) | |||
3051 | { # references with sheet specifier are not offset | ||||||
3052 | 0 | 0 | 0 | if ($ttext eq "!") { | |||
0 | |||||||
3053 | 0 | 0 | $sheetref = 1; # found a sheet reference | ||||
3054 | } elsif ($ttext ne ":") { # for everything but a range, reset | ||||||
3055 | 0 | 0 | $sheetref = 0; | ||||
3056 | } | ||||||
3057 | 0 | 0 | 0 | $ttext = $token_op_expansion{$ttext} | |||
3058 | || $ttext; # make sure short tokens (e.g., "G") go back full (">=") | ||||||
3059 | } | ||||||
3060 | 0 | 0 | 0 | if ($ttype == $token_coord) { | |||
0 | |||||||
3061 | 0 | 0 | my ($c, $r) = coord_to_cr($ttext); | ||||
3062 | 0 | 0 | 0 | 0 | if (($c == $col && $coloffset < 0) || ($r == $row && $rowoffset < 0)) | ||
0 | |||||||
0 | |||||||
3063 | { # refs to deleted cells become invalid | ||||||
3064 | 0 | 0 | 0 | $c = 0 unless $sheetref; | |||
3065 | 0 | 0 | 0 | $r = 0 unless $sheetref; | |||
3066 | } | ||||||
3067 | 0 | 0 | my $abscol = $ttext =~ m/^\$/; | ||||
3068 | 0 | 0 | 0 | 0 | $c += $coloffset if $c >= $col && !$sheetref; | ||
3069 | 0 | 0 | my $absrow = $ttext =~ m/^\${0,1}[a-zA-Z]{1,2}\$\d+$/; | ||||
3070 | 0 | 0 | 0 | 0 | $r += $rowoffset if $r >= $row && !$sheetref; | ||
3071 | 0 | 0 | $ttext = cr_to_coord($c, $r); | ||||
3072 | 0 | 0 | 0 | $ttext =~ s/^/\$/ if $abscol; | |||
3073 | 0 | 0 | 0 | $ttext =~ s/(\d+)$/\$$1/ if $absrow; | |||
3074 | |||||||
3075 | 0 | 0 | 0 | 0 | if ($r < 1 || $c < 1) { | ||
3076 | 0 | 0 | $ttext = "ERRCELL"; | ||||
3077 | } | ||||||
3078 | } elsif ($ttype == $token_string) { | ||||||
3079 | 0 | 0 | $ttext =~ s/"/""/g; | ||||
3080 | 0 | 0 | $ttext = '"' . $ttext . '"'; | ||||
3081 | } | ||||||
3082 | 0 | 0 | $updatedformula .= $ttext; | ||||
3083 | } | ||||||
3084 | |||||||
3085 | 0 | 0 | return $updatedformula; | ||||
3086 | |||||||
3087 | } | ||||||
3088 | |||||||
3089 | =head2 format_value_for_display | ||||||
3090 | |||||||
3091 | $displayvalue = format_value_for_display(\%sheetdata, $value, $cr, $linkstyle) | ||||||
3092 | |||||||
3093 | =cut | ||||||
3094 | |||||||
3095 | sub format_value_for_display { | ||||||
3096 | 0 | 0 | 1 | 0 | my ($sheetdata, $value, $cr, $linkstyle) = @_; | ||
3097 | |||||||
3098 | # Get references to the parts | ||||||
3099 | 0 | 0 | my $datavalues = $sheetdata->{datavalues}; | ||||
3100 | 0 | 0 | my $valuetypes = $sheetdata->{valuetypes}; | ||||
3101 | 0 | 0 | my $cellerrors = $sheetdata->{cellerrors}; | ||||
3102 | 0 | 0 | my $cellattribs = $sheetdata->{cellattribs}; | ||||
3103 | 0 | 0 | my $sheetattribs = $sheetdata->{sheetattribs}; | ||||
3104 | 0 | 0 | my $valueformats = $sheetdata->{valueformats}; | ||||
3105 | 0 | 0 | my $datatypes = $sheetdata->{datatypes}; | ||||
3106 | 0 | 0 | my $dataformulas = $sheetdata->{formulas}; | ||||
3107 | |||||||
3108 | 0 | 0 | my $displayvalue = $value; | ||||
3109 | |||||||
3110 | 0 | 0 | my $valuetype = | ||||
3111 | $valuetypes->{$cr}; # get type of value to determine formatting | ||||||
3112 | 0 | 0 | my $valuesubtype = substr($valuetype, 1); | ||||
3113 | 0 | 0 | $valuetype = substr($valuetype, 0, 1); | ||||
3114 | |||||||
3115 | 0 | 0 | 0 | if ($cellerrors->{$cr}) { | |||
3116 | |||||||
3117 | # TODO check this, now that expand_markup no longer exists | ||||||
3118 | # $displayvalue = expand_markup($cellerrors->{$cr}, $sheetdata, $linkstyle) || $valuesubtype || "Error in cell"; | ||||||
3119 | 0 | 0 | 0 | $displayvalue = $cellerrors->{$cr} || $valuesubtype || "Error in cell"; | |||
3120 | 0 | 0 | return $displayvalue; | ||||
3121 | } | ||||||
3122 | |||||||
3123 | 0 | 0 | 0 | if ($valuetype eq "t") { | |||
0 | |||||||
3124 | 0 | 0 | 0 | my $valueformat = $valueformats->[ | |||
3125 | ( $cellattribs->{$cr}->{textvalueformat} | ||||||
3126 | || $sheetattribs->{defaulttextvalueformat}) | ||||||
3127 | ] | ||||||
3128 | || ""; | ||||||
3129 | 0 | 0 | 0 | if ($valueformat eq "formula") { | |||
3130 | 0 | 0 | 0 | if ($datatypes->{$cr} eq "f") { | |||
0 | |||||||
3131 | 0 | 0 | 0 | $displayvalue = html_escape("=$dataformulas->{$cr}") || " "; | |||
3132 | } elsif ($datatypes->{$cr} eq "c") { | ||||||
3133 | 0 | 0 | 0 | $displayvalue = html_escape("'$dataformulas->{$cr}") || " "; | |||
3134 | } else { | ||||||
3135 | 0 | 0 | 0 | $displayvalue = html_escape("'$displayvalue") || " "; | |||
3136 | } | ||||||
3137 | 0 | 0 | return $displayvalue; | ||||
3138 | } | ||||||
3139 | $displayvalue = | ||||||
3140 | 0 | 0 | format_text_for_display($displayvalue, $valuetypes->{$cr}, $valueformat, | ||||
3141 | $sheetdata, $linkstyle); | ||||||
3142 | } | ||||||
3143 | |||||||
3144 | elsif ($valuetype eq "n") { | ||||||
3145 | 0 | 0 | my $valueformat = $cellattribs->{$cr}->{nontextvalueformat}; | ||||
3146 | 0 | 0 | 0 | if (length($valueformat) == 0) { # "0" is a legal value format | |||
3147 | 0 | 0 | $valueformat = $sheetattribs->{defaultnontextvalueformat}; | ||||
3148 | } | ||||||
3149 | 0 | 0 | $valueformat = $valueformats->[$valueformat]; | ||||
3150 | 0 | 0 | 0 | if (length($valueformat) == 0) { | |||
3151 | 0 | 0 | $valueformat = ""; | ||||
3152 | } | ||||||
3153 | 0 | 0 | 0 | $valueformat = "" if $valueformat eq "none"; | |||
3154 | 0 | 0 | 0 | if ($valueformat eq "formula") { | |||
0 | |||||||
3155 | 0 | 0 | 0 | if ($datatypes->{$cr} eq "f") { | |||
0 | |||||||
3156 | 0 | 0 | 0 | $displayvalue = html_escape("=$dataformulas->{$cr}") || " "; | |||
3157 | } elsif ($datatypes->{$cr} eq "c") { | ||||||
3158 | 0 | 0 | 0 | $displayvalue = html_escape("'$dataformulas->{$cr}") || " "; | |||
3159 | } else { | ||||||
3160 | 0 | 0 | 0 | $displayvalue = html_escape("'$displayvalue") || " "; | |||
3161 | } | ||||||
3162 | 0 | 0 | return $displayvalue; | ||||
3163 | } elsif ($valueformat eq "forcetext") { | ||||||
3164 | 0 | 0 | 0 | if ($datatypes->{$cr} eq "f") { | |||
0 | |||||||
3165 | 0 | 0 | 0 | $displayvalue = html_escape("=$dataformulas->{$cr}") || " "; | |||
3166 | } elsif ($datatypes->{$cr} eq "c") { | ||||||
3167 | 0 | 0 | 0 | $displayvalue = html_escape($dataformulas->{$cr}) || " "; | |||
3168 | } else { | ||||||
3169 | 0 | 0 | 0 | $displayvalue = html_escape($displayvalue) || " "; | |||
3170 | } | ||||||
3171 | 0 | 0 | return $displayvalue; | ||||
3172 | } | ||||||
3173 | $displayvalue = | ||||||
3174 | 0 | 0 | format_number_for_display($displayvalue, $valuetypes->{$cr}, | ||||
3175 | $valueformat); | ||||||
3176 | } | ||||||
3177 | |||||||
3178 | else { # unknown type - probably blank | ||||||
3179 | 0 | 0 | $displayvalue = " "; | ||||
3180 | } | ||||||
3181 | |||||||
3182 | 0 | 0 | return $displayvalue; | ||||
3183 | |||||||
3184 | } | ||||||
3185 | |||||||
3186 | =head2 format_text_for_display | ||||||
3187 | |||||||
3188 | $displayvalue = format_text_for_display($rawvalue, $valuetype, $valueformat, $sheetdata, $linkstyle) | ||||||
3189 | |||||||
3190 | =cut | ||||||
3191 | |||||||
3192 | sub format_text_for_display { | ||||||
3193 | |||||||
3194 | 0 | 0 | 1 | 0 | my ($rawvalue, $valuetype, $valueformat, $sheetdata, $linkstyle) = @_; | ||
3195 | |||||||
3196 | 0 | 0 | my $valuesubtype = substr($valuetype, 1); | ||||
3197 | |||||||
3198 | 0 | 0 | my $displayvalue = $rawvalue; | ||||
3199 | |||||||
3200 | 0 | 0 | 0 | $valueformat = "" if $valueformat eq "none"; | |||
3201 | 0 | 0 | 0 | $valueformat = "" unless $valueformat =~ m/^(text-|custom|hidden)/; | |||
3202 | 0 | 0 | 0 | 0 | if (!$valueformat || $valueformat eq "General") | ||
3203 | { # determine format from type | ||||||
3204 | 0 | 0 | 0 | $valueformat = "text-html" if ($valuesubtype eq "h"); | |||
3205 | 0 | 0 | 0 | $valueformat = "text-wiki" if ($valuesubtype eq "w"); | |||
3206 | 0 | 0 | 0 | $valueformat = "text-plain" unless $valuesubtype; | |||
3207 | } | ||||||
3208 | 0 | 0 | 0 | if ($valueformat eq "text-html") { # HTML - output as it as is | |||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
3209 | ; | ||||||
3210 | } elsif ($valueformat eq "text-wiki") { # wiki text | ||||||
3211 | 0 | 0 | die "Wiki text not handled"; | ||||
3212 | } elsif ($valueformat eq "text-url") { # text is a URL for a link | ||||||
3213 | 0 | 0 | my $dvsc = html_escape($displayvalue); | ||||
3214 | 0 | 0 | my $dvue = url_encode($displayvalue); | ||||
3215 | 0 | 0 | $dvue =~ s/\Q{{amp}}/%26/g; | ||||
3216 | 0 | 0 | $displayvalue = qq!$dvsc!; | ||||
3217 | } elsif ($valueformat eq "text-link") | ||||||
3218 | { # text is a URL for a link shown as Link | ||||||
3219 | 0 | 0 | my $dvsc = html_escape($displayvalue); | ||||
3220 | 0 | 0 | my $dvue = url_encode($displayvalue); | ||||
3221 | 0 | 0 | $dvue =~ s/\Q{{amp}}/%26/g; | ||||
3222 | 0 | 0 | $displayvalue = qq!Link!; | ||||
3223 | } elsif ($valueformat eq "text-image") { # text is a URL for an image | ||||||
3224 | 0 | 0 | my $dvue = url_encode($displayvalue); | ||||
3225 | 0 | 0 | $dvue =~ s/\Q{{amp}}/%26/g; | ||||
3226 | 0 | 0 | $displayvalue = qq!!; | ||||
3227 | } elsif ($valueformat =~ m/^text-custom\:/) | ||||||
3228 | { # construct a custom text format: @r = text raw, @s = special chars, @u = url encoded | ||||||
3229 | 0 | 0 | my $dvsc = html_escape($displayvalue); # do special chars | ||||
3230 | 0 | 0 | $dvsc =~ s/ / /g; # keep multiple spaces | ||||
3231 | 0 | 0 | $dvsc =~ s/\n/ /g; # keep line breaks |
||||
3232 | 0 | 0 | my $dvue = url_encode($displayvalue); | ||||
3233 | 0 | 0 | $dvue =~ s/\Q{{amp}}/%26/g; | ||||
3234 | 0 | 0 | my %textval; | ||||
3235 | 0 | 0 | $textval{r} = $displayvalue; | ||||
3236 | 0 | 0 | $textval{s} = $dvsc; | ||||
3237 | 0 | 0 | $textval{u} = $dvue; | ||||
3238 | 0 | 0 | $displayvalue = $valueformat; | ||||
3239 | 0 | 0 | $displayvalue =~ s/^text-custom\://; | ||||
3240 | 0 | 0 | $displayvalue =~ s/@(r|s|u)/$textval{$1}/ge; | ||||
0 | 0 | ||||||
3241 | } elsif ($valueformat =~ m/^custom/) { # custom | ||||||
3242 | 0 | 0 | $displayvalue = html_escape($displayvalue); # do special chars | ||||
3243 | 0 | 0 | $displayvalue =~ s/ / /g; # keep multiple spaces | ||||
3244 | 0 | 0 | $displayvalue =~ s/\n/ /g; # keep line breaks |
||||
3245 | 0 | 0 | $displayvalue .= " (custom format)"; | ||||
3246 | } elsif ($valueformat eq "hidden") { | ||||||
3247 | 0 | 0 | $displayvalue = " "; | ||||
3248 | } else { # plain text | ||||||
3249 | 0 | 0 | $displayvalue = html_escape($displayvalue); # do special chars | ||||
3250 | 0 | 0 | $displayvalue =~ s/ / /g; # keep multiple spaces | ||||
3251 | 0 | 0 | $displayvalue =~ s/\n/ /g; # keep line breaks |
||||
3252 | } | ||||||
3253 | |||||||
3254 | 0 | 0 | return $displayvalue; | ||||
3255 | |||||||
3256 | } | ||||||
3257 | |||||||
3258 | =head2 format_number_for_display | ||||||
3259 | |||||||
3260 | $displayvalue = format_number_for_display($rawvalue, $valuetype, $valueformat) | ||||||
3261 | |||||||
3262 | =cut | ||||||
3263 | |||||||
3264 | sub format_number_for_display { | ||||||
3265 | |||||||
3266 | 85 | 85 | 1 | 14177 | my ($rawvalue, $valuetype, $valueformat) = @_; | ||
3267 | |||||||
3268 | 85 | 141 | my ($has_parens, $has_commas); | ||||
3269 | |||||||
3270 | 85 | 193 | my $displayvalue = $rawvalue; | ||||
3271 | 85 | 204 | my $valuesubtype = substr($valuetype, 1); | ||||
3272 | |||||||
3273 | 85 | 100 | 66 | 491 | if ($valueformat eq "Auto" || length($valueformat) == 0) | ||
3274 | { # cases with default format | ||||||
3275 | 63 | 50 | 507 | if ($valuesubtype eq "%") { # will display a % character | |||
50 | |||||||
50 | |||||||
50 | |||||||
50 | |||||||
50 | |||||||
3276 | 0 | 0 | $valueformat = "#,##0.0%"; | ||||
3277 | } elsif ($valuesubtype eq '$') { | ||||||
3278 | 0 | 0 | $valueformat = '[$]#,##0.00'; | ||||
3279 | } elsif ($valuesubtype eq 'dt') { | ||||||
3280 | 0 | 0 | $valueformat = 'd-mmm-yyyy h:mm:ss'; | ||||
3281 | } elsif ($valuesubtype eq 'd') { | ||||||
3282 | 0 | 0 | $valueformat = 'd-mmm-yyyy'; | ||||
3283 | } elsif ($valuesubtype eq 't') { | ||||||
3284 | 0 | 0 | $valueformat = '[h]:mm:ss'; | ||||
3285 | } elsif ($valuesubtype eq 'l') { | ||||||
3286 | 0 | 0 | $valueformat = 'logical'; | ||||
3287 | } else { | ||||||
3288 | 63 | 123 | $valueformat = "General"; | ||||
3289 | } | ||||||
3290 | } | ||||||
3291 | |||||||
3292 | 85 | 50 | 381 | if ($valueformat eq "logical") { # do logical format | |||
3293 | 0 | 0 | 0 | return $rawvalue ? 'TRUE' : 'FALSE'; | |||
3294 | } | ||||||
3295 | |||||||
3296 | 85 | 50 | 174 | if ($valueformat eq "hidden") { # do hidden format | |||
3297 | 0 | 0 | return " "; | ||||
3298 | } | ||||||
3299 | |||||||
3300 | # Use format | ||||||
3301 | |||||||
3302 | 85 | 240 | return format_number_with_format_string($rawvalue, $valueformat); | ||||
3303 | |||||||
3304 | } | ||||||
3305 | |||||||
3306 | =head2 format_number_with_format_string | ||||||
3307 | |||||||
3308 | $result = format_number_with_format_string($value, $format_string, $currency_char) | ||||||
3309 | |||||||
3310 | Use a format string to format a numeric value. Returns a string with the result. | ||||||
3311 | This is a subset of the normal styles accepted by many other spreadsheets, without fractions, E format, and @, | ||||||
3312 | and with any number of comparison fields and with [style=style-specification] (e.g., [style=color:red]) | ||||||
3313 | |||||||
3314 | =cut | ||||||
3315 | |||||||
3316 | my %allowedcolors = ( | ||||||
3317 | BLACK => "#000000", | ||||||
3318 | BLUE => "#0000FF", | ||||||
3319 | CYAN => "#00FFFF", | ||||||
3320 | GREEN => "#00FF00", | ||||||
3321 | MAGENTA => "#FF00FF", | ||||||
3322 | RED => "#FF0000", | ||||||
3323 | WHITE => "#FFFFFF", | ||||||
3324 | YELLOW => "#FFFF00" | ||||||
3325 | ); | ||||||
3326 | |||||||
3327 | my %alloweddates = | ||||||
3328 | (H => "h]", M => "m]", MM => "mm]", "S" => "s]", "SS" => "ss]"); | ||||||
3329 | |||||||
3330 | my %format_definitions; | ||||||
3331 | my $cmd_copy = 1; | ||||||
3332 | my $cmd_color = 2; | ||||||
3333 | my $cmd_integer_placeholder = 3; | ||||||
3334 | my $cmd_fraction_placeholder = 4; | ||||||
3335 | my $cmd_decimal = 5; | ||||||
3336 | my $cmd_currency = 6; | ||||||
3337 | my $cmd_general = 7; | ||||||
3338 | my $cmd_separator = 8; | ||||||
3339 | my $cmd_date = 9; | ||||||
3340 | my $cmd_comparison = 10; | ||||||
3341 | my $cmd_section = 11; | ||||||
3342 | my $cmd_style = 12; | ||||||
3343 | |||||||
3344 | sub format_number_with_format_string { | ||||||
3345 | |||||||
3346 | 85 | 85 | 1 | 160 | my ($rawvalue, $format_string, $currency_char) = @_; | ||
3347 | |||||||
3348 | 85 | 50 | 337 | $currency_char ||= '$'; | |||
3349 | |||||||
3350 | 85 | 119 | my ($op, $operandstr, $fromend, $cval, $operandstrlc); | ||||
3351 | 0 | 0 | my ($yr, $mn, $dy, $hrs, $mins, $secs, $ehrs, $emins, $esecs, $ampmstr); | ||||
3352 | 0 | 0 | my $result; | ||||
3353 | |||||||
3354 | 85 | 167 | my $value = $rawvalue + 0; # get a working copy that's numeric | ||||
3355 | |||||||
3356 | 85 | 100 | 204 | my $negativevalue = $value < 0 ? 1 : 0; # determine sign, etc. | |||
3357 | 85 | 100 | 199 | $value = -$value if $negativevalue; | |||
3358 | 85 | 50 | 172 | my $zerovalue = $value == 0 ? 1 : 0; | |||
3359 | |||||||
3360 | 85 | 327 | parse_format_string(\%format_definitions, $format_string) | ||||
3361 | ; # make sure format is parsed | ||||||
3362 | 85 | 176 | my $thisformat = $format_definitions{$format_string}; # Get format structure | ||||
3363 | |||||||
3364 | 85 | 50 | 222 | return "Format error!" unless $thisformat; | |||
3365 | |||||||
3366 | 85 | 210 | my $section = | ||||
3367 | 85 | 106 | (scalar @{ $thisformat->{sectioninfo} }) - 1; # get number of sections - 1 | ||||
3368 | |||||||
3369 | 85 | 50 | 295 | if ($thisformat->{hascomparison}) | |||
100 | |||||||
3370 | { # has comparisons - determine which section | ||||||
3371 | 0 | 0 | $section = 0; # set to which section we will use | ||||
3372 | 0 | 0 | my $gotcomparison = 0; # this section has no comparison | ||||
3373 | 0 | 0 | for (my $cpos ; ; $cpos++) { # scan for comparisons | ||||
3374 | 0 | 0 | $op = $thisformat->{operators}->[$cpos]; | ||||
3375 | 0 | 0 | $operandstr = | ||||
3376 | $thisformat->{operands}->[$cpos]; # get next operator and operand | ||||||
3377 | 0 | 0 | 0 | if (!$op) { # at end with no match | |||
3378 | 0 | 0 | 0 | if ($gotcomparison) { # if comparison but no match | |||
3379 | 0 | 0 | $format_string = "General"; # use default of General | ||||
3380 | 0 | 0 | parse_format_string(\%format_definitions, $format_string); | ||||
3381 | 0 | 0 | $thisformat = $format_definitions{$format_string}; | ||||
3382 | 0 | 0 | $section = 0; | ||||
3383 | } | ||||||
3384 | 0 | 0 | last; # if no comparision, matchines on this section | ||||
3385 | } | ||||||
3386 | 0 | 0 | 0 | if ($op == $cmd_section) { # end of section | |||
3387 | 0 | 0 | 0 | if (!$gotcomparison) { # no comparison, so it's a match | |||
3388 | 0 | 0 | last; | ||||
3389 | } | ||||||
3390 | 0 | 0 | $gotcomparison = 0; | ||||
3391 | 0 | 0 | $section++; # check out next one | ||||
3392 | 0 | 0 | next; | ||||
3393 | } | ||||||
3394 | 0 | 0 | 0 | if ($op == $cmd_comparison) { # found a comparison - do we meet it? | |||
3395 | 0 | 0 | my ($compop, $compval) = split (/:/, $operandstr, 2); | ||||
3396 | 0 | 0 | $compval = 0 + $compval; | ||||
3397 | 0 | 0 | 0 | 0 | if ( ($compop eq "<" && $rawvalue < $compval) | ||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
3398 | || ($compop eq "<=" && $rawvalue <= $compval) | ||||||
3399 | || ($compop eq "<>" && $rawvalue != $compval) | ||||||
3400 | || ($compop eq ">=" && $rawvalue >= $compval) | ||||||
3401 | || ($compop eq ">" && $rawvalue > $compval)) { # a match | ||||||
3402 | 0 | 0 | last; | ||||
3403 | } | ||||||
3404 | 0 | 0 | $gotcomparison = 1; | ||||
3405 | } | ||||||
3406 | } | ||||||
3407 | } elsif ($section > 0) { # more than one section (separated by ";") | ||||||
3408 | 2 | 50 | 5 | if ($section == 1) { # two sections | |||
0 | |||||||
3409 | 2 | 100 | 5 | if ($negativevalue) { | |||
3410 | 1 | 2 | $negativevalue = 0; # sign will provided by section, not automatically | ||||
3411 | 1 | 2 | $section = 1; # use second section for negative values | ||||
3412 | } else { | ||||||
3413 | 1 | 2 | $section = 0; # use first for all others | ||||
3414 | } | ||||||
3415 | } elsif ($section == 2) { # three sections | ||||||
3416 | 0 | 0 | 0 | if ($negativevalue) { | |||
0 | |||||||
3417 | 0 | 0 | $negativevalue = 0; # sign will provided by section, not automatically | ||||
3418 | 0 | 0 | $section = 1; # use second section for negative values | ||||
3419 | } elsif ($zerovalue) { | ||||||
3420 | 0 | 0 | $section = 2; # use third section for zero values | ||||
3421 | } else { | ||||||
3422 | 0 | 0 | $section = 0; # use first for positive | ||||
3423 | } | ||||||
3424 | } | ||||||
3425 | } | ||||||
3426 | |||||||
3427 | # Get values for our section | ||||||
3428 | 85 | 3065 | my ($sectionstart, $integerdigits, $fractiondigits, $commas, $percent, | ||||
3429 | $thousandssep) | ||||||
3430 | = map $_ || 0, | ||||||
3431 | 85 | 100 | 145 | @{ $thisformat->{sectioninfo}->[$section] } | |||
3432 | {qw(sectionstart integerdigits fractiondigits commas percent thousandssep) | ||||||
3433 | }; | ||||||
3434 | |||||||
3435 | 85 | 100 | 316 | if ($commas > 0) { # scale by thousands | |||
3436 | 3 | 10 | for (my $i = 0 ; $i < $commas ; $i++) { | ||||
3437 | 4 | 12 | $value /= 1000; | ||||
3438 | } | ||||||
3439 | } | ||||||
3440 | 85 | 100 | 202 | if ($percent > 0) { # do percent scaling | |||
3441 | 2 | 7 | for (my $i = 0 ; $i < $percent ; $i++) { | ||||
3442 | 2 | 7 | $value *= 100; | ||||
3443 | } | ||||||
3444 | } | ||||||
3445 | |||||||
3446 | 85 | 123 | my $decimalscale = 1; # cut down to required number of decimal digits | ||||
3447 | 85 | 272 | for (my $i = 0 ; $i < $fractiondigits ; $i++) { | ||||
3448 | 8 | 17 | $decimalscale *= 10; | ||||
3449 | } | ||||||
3450 | 85 | 220 | my $scaledvalue = int($value * $decimalscale + 0.5); | ||||
3451 | 85 | 142 | $scaledvalue = $scaledvalue / $decimalscale; | ||||
3452 | |||||||
3453 | 85 | 0 | 0 | 206 | $negativevalue = 0 | ||
33 | |||||||
3454 | if ($scaledvalue == 0 && ($fractiondigits || $integerdigits)) | ||||||
3455 | ; # no "-0" unless using multiple sections or General | ||||||
3456 | |||||||
3457 | 85 | 211 | my $strvalue = "$scaledvalue"; # convert to string | ||||
3458 | 85 | 50 | 268 | if ($strvalue =~ m/e/) { # converted to scientific notation | |||
3459 | 0 | 0 | return "$rawvalue"; # Just return plain converted raw value | ||||
3460 | } | ||||||
3461 | 85 | 426 | $strvalue =~ m/^\+{0,1}(\d*)(?:\.(\d*)){0,1}$/ | ||||
3462 | ; # get integer and fraction as character arrays | ||||||
3463 | 85 | 100 | 344 | my $integervalue = $1 || ""; | |||
3464 | 85 | 326 | my @integervalue = split (//, $integervalue); | ||||
3465 | 85 | 100 | 432 | my $fractionvalue = $2 || ""; | |||
3466 | 85 | 204 | my @fractionvalue = split (//, $fractionvalue); | ||||
3467 | |||||||
3468 | 85 | 100 | 282 | if ($thisformat->{sectioninfo}->[$section]->{hasdate}) | |||
3469 | { # there are date placeholders | ||||||
3470 | 12 | 50 | 24 | if ($rawvalue < 0) { # bad date | |||
3471 | 0 | 0 | return "??-???-?? ??:??:??"; | ||||
3472 | } | ||||||
3473 | 12 | 21 | my $startval = | ||||
3474 | ($rawvalue - int($rawvalue)) * $seconds_in_a_day; # get date/time parts | ||||||
3475 | 12 | 13 | my $estartval = | ||||
3476 | $rawvalue * $seconds_in_a_day; # do elapsed time version, too | ||||||
3477 | 12 | 15 | $hrs = int($startval / $seconds_in_an_hour); | ||||
3478 | 12 | 14 | $ehrs = int($estartval / $seconds_in_an_hour); | ||||
3479 | 12 | 16 | $startval = $startval - $hrs * $seconds_in_an_hour; | ||||
3480 | 12 | 16 | $mins = int($startval / 60); | ||||
3481 | 12 | 14 | $emins = int($estartval / 60); | ||||
3482 | 12 | 14 | $secs = $startval - $mins * 60; | ||||
3483 | 12 | 13 | $decimalscale = 1; # round appropriately depending if there is ss.0 | ||||
3484 | |||||||
3485 | 12 | 29 | for (my $i = 0 ; $i < $fractiondigits ; $i++) { | ||||
3486 | 0 | 0 | $decimalscale *= 10; | ||||
3487 | } | ||||||
3488 | 12 | 21 | $secs = int($secs * $decimalscale + 0.5); | ||||
3489 | 12 | 13 | $secs = $secs / $decimalscale; | ||||
3490 | 12 | 24 | $esecs = int($estartval * $decimalscale + 0.5); | ||||
3491 | 12 | 14 | $esecs = $esecs / $decimalscale; | ||||
3492 | 12 | 50 | 24 | if ($secs >= 60) { # handle round up into next second, minute, etc. | |||
3493 | 0 | 0 | $secs = 0; | ||||
3494 | 0 | 0 | $mins++; | ||||
3495 | 0 | 0 | $emins++; | ||||
3496 | 0 | 0 | 0 | if ($mins >= 60) { | |||
3497 | 0 | 0 | $mins = 0; | ||||
3498 | 0 | 0 | $hrs++; | ||||
3499 | 0 | 0 | $ehrs++; | ||||
3500 | 0 | 0 | 0 | if ($hrs >= 24) { | |||
3501 | 0 | 0 | $hrs = 0; | ||||
3502 | 0 | 0 | $rawvalue++; | ||||
3503 | } | ||||||
3504 | } | ||||||
3505 | } | ||||||
3506 | 12 | 39 | @fractionvalue = split (//, $secs - int($secs)); # for "hh:mm:ss.00" | ||||
3507 | 12 | 16 | shift @fractionvalue; | ||||
3508 | 12 | 18 | shift @fractionvalue; | ||||
3509 | 12 | 34 | ($yr, $mn, $dy) = | ||||
3510 | convert_date_julian_to_gregorian(int($rawvalue + $julian_offset)); | ||||||
3511 | |||||||
3512 | 12 | 17 | my $minOK; # says "m" can be minutes | ||||
3513 | 12 | 15 | my $mspos = $sectionstart; # m scan position in ops | ||||
3514 | 12 | 15 | for (; ; $mspos++) | ||||
3515 | { # scan for "m" and "mm" to see if any minutes fields, and am/pm | ||||||
3516 | 31 | 41 | $op = $thisformat->{operators}->[$mspos]; | ||||
3517 | 31 | 41 | $operandstr = | ||||
3518 | $thisformat->{operands}->[$mspos]; # get next operator and operand | ||||||
3519 | 31 | 100 | 63 | last unless $op; # don't go past end | |||
3520 | 19 | 50 | 34 | last if $op == $cmd_section; | |||
3521 | 19 | 100 | 35 | if ($op == $cmd_date) { | |||
50 | |||||||
3522 | 15 | 50 | 33 | 76 | if ((lc($operandstr) eq "am/pm" || lc($operandstr) eq "a/p") | ||
33 | |||||||
3523 | && !$ampmstr) { | ||||||
3524 | 0 | 0 | 0 | if ($hrs >= 12) { | |||
3525 | 0 | 0 | $hrs -= 12; | ||||
3526 | 0 | 0 | 0 | $ampmstr = lc($operandstr) eq "a/p" ? "P" : "PM"; | |||
3527 | } else { | ||||||
3528 | 0 | 0 | 0 | $ampmstr = lc($operandstr) eq "a/p" ? "A" : "AM"; | |||
3529 | } | ||||||
3530 | 0 | 0 | 0 | $ampmstr = lc $ampmstr if $operandstr !~ m/$ampmstr/; | |||
3531 | } | ||||||
3532 | 15 | 0 | 0 | 30 | if ($minOK && ($operandstr eq "m" || $operandstr eq "mm")) { | ||
33 | |||||||
3533 | 0 | 0 | $thisformat->{operands}->[$mspos] .= | ||||
3534 | "in"; # turn into "min" or "mmin" | ||||||
3535 | } | ||||||
3536 | 15 | 50 | 32 | if (substr($operandstr, 0, 1) eq "h") { | |||
3537 | 0 | 0 | $minOK = 1; # m following h or hh or [h] is minutes not months | ||||
3538 | } else { | ||||||
3539 | 15 | 27 | $minOK = 0; | ||||
3540 | } | ||||||
3541 | } elsif ($op != $cmd_copy) { # copying chars can be between h and m | ||||||
3542 | 0 | 0 | $minOK = 0; | ||||
3543 | } | ||||||
3544 | } | ||||||
3545 | 12 | 13 | $minOK = 0; | ||||
3546 | 12 | 16 | for (--$mspos ; ; $mspos--) { # scan other way for s after m | ||||
3547 | 50 | 67 | $op = $thisformat->{operators}->[$mspos]; | ||||
3548 | 50 | 63 | $operandstr = | ||||
3549 | $thisformat->{operands}->[$mspos]; # get next operator and operand | ||||||
3550 | 50 | 100 | 79 | last unless $op; # don't go past end | |||
3551 | 38 | 50 | 57 | last if $op == $cmd_section; | |||
3552 | 38 | 100 | 65 | if ($op == $cmd_date) { | |||
50 | |||||||
3553 | 30 | 0 | 0 | 53 | if ($minOK && ($operandstr eq "m" || $operandstr eq "mm")) { | ||
33 | |||||||
3554 | 0 | 0 | $thisformat->{operands}->[$mspos] .= | ||||
3555 | "in"; # turn into "min" or "mmin" | ||||||
3556 | } | ||||||
3557 | 30 | 50 | 48 | if ($operandstr eq "ss") { | |||
3558 | 0 | 0 | $minOK = 1; # m before ss is minutes not months | ||||
3559 | } else { | ||||||
3560 | 30 | 35 | $minOK = 0; | ||||
3561 | } | ||||||
3562 | } elsif ($op != $cmd_copy) { # copying chars can be between ss and m | ||||||
3563 | 0 | 0 | $minOK = 0; | ||||
3564 | } | ||||||
3565 | } | ||||||
3566 | } | ||||||
3567 | |||||||
3568 | 85 | 133 | my $integerdigits2 = 0; # init counters, etc. | ||||
3569 | 85 | 144 | my $integerpos = 0; | ||||
3570 | 85 | 106 | my $fractionpos = 0; | ||||
3571 | 85 | 235 | my $textcolor = ""; | ||||
3572 | 85 | 105 | my $textstyle = ""; | ||||
3573 | 85 | 109 | my $separatorchar = ","; | ||||
3574 | 85 | 152 | my $decimalchar = '.'; | ||||
3575 | |||||||
3576 | 85 | 111 | my $oppos = $sectionstart; | ||||
3577 | |||||||
3578 | 85 | 276 | while ($op = $thisformat->{operators}->[$oppos]) { # execute format | ||||
3579 | 126 | 257 | $operandstr = | ||||
3580 | $thisformat->{operands}->[ $oppos++ ]; # get next operator and operand | ||||||
3581 | 126 | 100 | 865 | if ($op == $cmd_copy) { # put char in result | |||
50 | |||||||
50 | |||||||
100 | |||||||
100 | |||||||
100 | |||||||
50 | |||||||
100 | |||||||
100 | |||||||
50 | |||||||
0 | |||||||
3582 | 8 | 19 | $result .= $operandstr; | ||||
3583 | } | ||||||
3584 | |||||||
3585 | elsif ($op == $cmd_color) { # set color | ||||||
3586 | 0 | 0 | $textcolor = $operandstr; | ||||
3587 | } | ||||||
3588 | |||||||
3589 | elsif ($op == $cmd_style) { # set style | ||||||
3590 | 0 | 0 | $textstyle = $operandstr; | ||||
3591 | } | ||||||
3592 | |||||||
3593 | elsif ($op == $cmd_integer_placeholder) { # insert number part | ||||||
3594 | 28 | 50 | 48 | if ($negativevalue) { | |||
3595 | 0 | 0 | $result .= "-"; | ||||
3596 | 0 | 0 | $negativevalue = 0; | ||||
3597 | } | ||||||
3598 | 28 | 27 | $integerdigits2++; | ||||
3599 | 28 | 100 | 50 | if ($integerdigits2 == 1) { # first one | |||
3600 | 10 | 100 | 21 | if ((scalar @integervalue) > $integerdigits) | |||
3601 | { # see if integer wider than field | ||||||
3602 | 2 | 6 | for ( | ||||
3603 | ; | ||||||
3604 | $integerpos < ((scalar @integervalue) - $integerdigits) ; | ||||||
3605 | $integerpos++ | ||||||
3606 | ) { | ||||||
3607 | 2 | 4 | $result .= $integervalue[$integerpos]; | ||||
3608 | 2 | 50 | 9 | if ($thousandssep) { # see if this is a separator position | |||
3609 | 0 | 0 | $fromend = (scalar @integervalue) - $integerpos - 1; | ||||
3610 | 0 | 0 | 0 | 0 | if ($fromend > 2 && $fromend % 3 == 0) { | ||
3611 | 0 | 0 | $result .= $separatorchar; | ||||
3612 | } | ||||||
3613 | } | ||||||
3614 | } | ||||||
3615 | } | ||||||
3616 | } | ||||||
3617 | 28 | 100 | 100 | 95 | if ((scalar @integervalue) < $integerdigits | ||
3618 | && $integerdigits2 <= $integerdigits - (scalar @integervalue)) | ||||||
3619 | { # field is wider than value | ||||||
3620 | 9 | 100 | 66 | 45 | if ($operandstr eq "0" || $operandstr eq "?") | ||
3621 | { # fill with appropriate characters | ||||||
3622 | 4 | 50 | 9 | $result .= $operandstr eq "0" ? "0" : " "; | |||
3623 | 4 | 50 | 15 | if ($thousandssep) { # see if this is a separator position | |||
3624 | 0 | 0 | $fromend = $integerdigits - $integerdigits2; | ||||
3625 | 0 | 0 | 0 | 0 | if ($fromend > 2 && $fromend % 3 == 0) { | ||
3626 | 0 | 0 | $result .= $separatorchar; | ||||
3627 | } | ||||||
3628 | } | ||||||
3629 | } | ||||||
3630 | } else { # normal integer digit - add it | ||||||
3631 | 19 | 24 | $result .= $integervalue[$integerpos]; | ||||
3632 | 19 | 100 | 47 | if ($thousandssep) { # see if this is a separator position | |||
3633 | 15 | 19 | $fromend = (scalar @integervalue) - $integerpos - 1; | ||||
3634 | 15 | 100 | 66 | 52 | if ($fromend > 2 && $fromend % 3 == 0) { | ||
3635 | 3 | 5 | $result .= $separatorchar; | ||||
3636 | } | ||||||
3637 | } | ||||||
3638 | 19 | 58 | $integerpos++; | ||||
3639 | } | ||||||
3640 | } elsif ($op == $cmd_fraction_placeholder) { # add fraction part of number | ||||||
3641 | 8 | 50 | 15 | if ($fractionpos >= scalar @fractionvalue) { | |||
3642 | 0 | 0 | 0 | 0 | if ($operandstr eq "0" || $operandstr eq "?") { | ||
3643 | 0 | 0 | 0 | $result .= $operandstr eq "0" ? "0" : " "; | |||
3644 | } | ||||||
3645 | } else { | ||||||
3646 | 8 | 12 | $result .= $fractionvalue[$fractionpos]; | ||||
3647 | } | ||||||
3648 | 8 | 21 | $fractionpos++; | ||||
3649 | } | ||||||
3650 | |||||||
3651 | elsif ($op == $cmd_decimal) { # decimal point | ||||||
3652 | 3 | 50 | 8 | if ($negativevalue) { | |||
3653 | 0 | 0 | $result .= "-"; | ||||
3654 | 0 | 0 | $negativevalue = 0; | ||||
3655 | } | ||||||
3656 | 3 | 9 | $result .= $decimalchar; | ||||
3657 | } | ||||||
3658 | |||||||
3659 | elsif ($op == $cmd_currency) { # currency symbol | ||||||
3660 | 0 | 0 | 0 | if ($negativevalue) { | |||
3661 | 0 | 0 | $result .= "-"; | ||||
3662 | 0 | 0 | $negativevalue = 0; | ||||
3663 | } | ||||||
3664 | 0 | 0 | $result .= $operandstr; | ||||
3665 | } | ||||||
3666 | |||||||
3667 | elsif ($op == $cmd_general) { # insert "General" conversion | ||||||
3668 | 63 | 101 | my $gvalue = $rawvalue + 0; # make sure it's numeric | ||||
3669 | 63 | 50 | 121 | if ($negativevalue) { | |||
3670 | 0 | 0 | $result .= "-"; | ||||
3671 | 0 | 0 | $negativevalue = 0; | ||||
3672 | 0 | 0 | $gvalue = -$gvalue; | ||||
3673 | } | ||||||
3674 | 63 | 108 | $strvalue = "$gvalue"; # convert original value to string | ||||
3675 | 63 | 50 | 170 | if ($strvalue =~ m/e/) { # converted to scientific notation | |||
3676 | 0 | 0 | $result .= "$strvalue"; | ||||
3677 | 0 | 0 | next; | ||||
3678 | } | ||||||
3679 | 63 | 263 | $strvalue =~ m/^\+{0,1}(\d*)(?:\.(\d*)){0,1}$/; | ||||
3680 | 63 | 122 | $integervalue = $1; | ||||
3681 | 63 | 50 | 158 | $integervalue = "" if ($integervalue == 0); | |||
3682 | 63 | 199 | @integervalue = split (//, $integervalue); | ||||
3683 | 63 | 119 | $fractionvalue = $2; | ||||
3684 | 63 | 50 | 230 | $fractionvalue ||= ""; | |||
3685 | 63 | 150 | @fractionvalue = split (//, $fractionvalue); | ||||
3686 | 63 | 99 | $integerpos = 0; | ||||
3687 | 63 | 101 | $fractionpos = 0; | ||||
3688 | |||||||
3689 | 63 | 50 | 159 | if (scalar @integervalue) { | |||
3690 | 63 | 178 | for (; $integerpos < scalar @integervalue ; $integerpos++) { | ||||
3691 | 63 | 122 | $result .= $integervalue[$integerpos]; | ||||
3692 | 63 | 50 | 244 | if ($thousandssep) { # see if this is a separator position | |||
3693 | 0 | 0 | $fromend = (scalar @integervalue) - $integerpos - 1; | ||||
3694 | 0 | 0 | 0 | 0 | if ($fromend > 2 && $fromend % 3 == 0) { | ||
3695 | 0 | 0 | $result .= $separatorchar; | ||||
3696 | } | ||||||
3697 | } | ||||||
3698 | } | ||||||
3699 | } else { | ||||||
3700 | 0 | 0 | $result .= "0"; | ||||
3701 | } | ||||||
3702 | 63 | 50 | 300 | if (scalar @fractionvalue) { | |||
3703 | 0 | 0 | $result .= $decimalchar; | ||||
3704 | 0 | 0 | for (; $fractionpos < scalar @fractionvalue ; $fractionpos++) { | ||||
3705 | 0 | 0 | $result .= $fractionvalue[$fractionpos]; | ||||
3706 | } | ||||||
3707 | } | ||||||
3708 | } | ||||||
3709 | |||||||
3710 | elsif ($op == $cmd_date) { # date placeholder | ||||||
3711 | 15 | 20 | $operandstrlc = lc $operandstr; | ||||
3712 | 15 | 100 | 66 | 126 | if ($operandstrlc eq "y" || $operandstrlc eq "yy") { | ||
100 | 0 | ||||||
100 | |||||||
100 | |||||||
100 | |||||||
100 | |||||||
100 | |||||||
100 | |||||||
100 | |||||||
100 | |||||||
50 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
3713 | 1 | 5 | $result .= substr("$yr", -2); | ||||
3714 | } elsif ($operandstrlc eq "yyyy") { | ||||||
3715 | 2 | 6 | $result .= "$yr"; | ||||
3716 | } elsif ($operandstrlc eq "d") { | ||||||
3717 | 2 | 7 | $result .= "$dy"; | ||||
3718 | } elsif ($operandstrlc eq "dd") { | ||||||
3719 | 1 | 3 | $cval = 1000 + $dy; | ||||
3720 | 1 | 17 | $result .= substr("$cval", -2); | ||||
3721 | } elsif ($operandstrlc eq "ddd") { | ||||||
3722 | 2 | 9 | my @names = qw/Sun Mon Tue Wed Thu Fri Sat/; | ||||
3723 | 2 | 5 | $cval = int($rawvalue + 6) % 7; | ||||
3724 | 2 | 8 | $result .= $names[$cval]; | ||||
3725 | } elsif ($operandstrlc eq "dddd") { | ||||||
3726 | 1 | 4 | my @names = | ||||
3727 | qw/Sunday Monday Tuesday Wednesday Thursday Friday Saturday/; | ||||||
3728 | 1 | 3 | $cval = int($rawvalue + 6) % 7; | ||||
3729 | 1 | 6 | $result .= $names[$cval]; | ||||
3730 | } elsif ($operandstrlc eq "m") { | ||||||
3731 | 1 | 5 | $result .= "$mn"; | ||||
3732 | } elsif ($operandstrlc eq "mm") { | ||||||
3733 | 1 | 2 | $cval = 1000 + $mn; | ||||
3734 | 1 | 5 | $result .= substr("$cval", -2); | ||||
3735 | } elsif ($operandstrlc eq "mmm") { | ||||||
3736 | 1 | 4 | my @names = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/; | ||||
3737 | 1 | 4 | $result .= $names[ $mn - 1 ]; | ||||
3738 | } elsif ($operandstrlc eq "mmmm") { | ||||||
3739 | 2 | 9 | my @names = qw/ | ||||
3740 | January February March April May June | ||||||
3741 | July August September October November December | ||||||
3742 | /; | ||||||
3743 | 2 | 8 | $result .= $names[ $mn - 1 ]; | ||||
3744 | } elsif ($operandstrlc eq "mmmmm") { | ||||||
3745 | 1 | 7 | my @names = qw/J F M A M J J A S O N D/; | ||||
3746 | 1 | 6 | $result .= $names[ $mn - 1 ]; | ||||
3747 | } elsif ($operandstrlc eq "h") { | ||||||
3748 | 0 | 0 | $result .= "$hrs"; | ||||
3749 | } elsif ($operandstrlc eq "h]") { | ||||||
3750 | 0 | 0 | $result .= "$ehrs"; | ||||
3751 | } elsif ($operandstrlc eq "mmin") { | ||||||
3752 | 0 | 0 | $cval = 1000 + $mins; | ||||
3753 | 0 | 0 | $result .= substr("$cval", -2); | ||||
3754 | } elsif ($operandstrlc eq "mm]") { | ||||||
3755 | 0 | 0 | 0 | if ($emins < 100) { | |||
3756 | 0 | 0 | $cval = 1000 + $emins; | ||||
3757 | 0 | 0 | $result .= substr("$cval", -2); | ||||
3758 | } else { | ||||||
3759 | 0 | 0 | $result .= "$emins"; | ||||
3760 | } | ||||||
3761 | } elsif ($operandstrlc eq "min") { | ||||||
3762 | 0 | 0 | $result .= "$mins"; | ||||
3763 | } elsif ($operandstrlc eq "m]") { | ||||||
3764 | 0 | 0 | $result .= "$emins"; | ||||
3765 | } elsif ($operandstrlc eq "hh") { | ||||||
3766 | 0 | 0 | $cval = 1000 + $hrs; | ||||
3767 | 0 | 0 | $result .= substr("$cval", -2); | ||||
3768 | } elsif ($operandstrlc eq "s") { | ||||||
3769 | 0 | 0 | $cval = int($secs); | ||||
3770 | 0 | 0 | $result .= "$cval"; | ||||
3771 | } elsif ($operandstrlc eq "ss") { | ||||||
3772 | 0 | 0 | $cval = 1000 + int($secs); | ||||
3773 | 0 | 0 | $result .= substr("$cval", -2); | ||||
3774 | } elsif ($operandstrlc eq "am/pm" || $operandstrlc eq "a/p") { | ||||||
3775 | 0 | 0 | $result .= $ampmstr; | ||||
3776 | } elsif ($operandstrlc eq "ss]") { | ||||||
3777 | 0 | 0 | 0 | if ($esecs < 100) { | |||
3778 | 0 | 0 | $cval = 1000 + int($esecs); | ||||
3779 | 0 | 0 | $result .= substr("$cval", -2); | ||||
3780 | } else { | ||||||
3781 | 0 | 0 | $cval = int($esecs); | ||||
3782 | 0 | 0 | $result = "$cval"; | ||||
3783 | } | ||||||
3784 | } | ||||||
3785 | } | ||||||
3786 | |||||||
3787 | elsif ($op == $cmd_section) { # end of section | ||||||
3788 | 1 | 2 | last; | ||||
3789 | } | ||||||
3790 | |||||||
3791 | elsif ($op == $cmd_comparison) { # ignore | ||||||
3792 | 0 | 0 | next; | ||||
3793 | } | ||||||
3794 | |||||||
3795 | else { | ||||||
3796 | 0 | 0 | $result .= "!! Parse error !!"; | ||||
3797 | } | ||||||
3798 | } | ||||||
3799 | |||||||
3800 | 85 | 50 | 287 | if ($textcolor) { | |||
3801 | 0 | 0 | $result = qq!$result!; | ||||
3802 | } | ||||||
3803 | 85 | 50 | 173 | if ($textstyle) { | |||
3804 | 0 | 0 | $result = qq!$result!; | ||||
3805 | } | ||||||
3806 | |||||||
3807 | 85 | 586 | return $result; | ||||
3808 | } | ||||||
3809 | |||||||
3810 | =head2 parse_format_string | ||||||
3811 | |||||||
3812 | parse_format_string(\%format_defs, $format_string) | ||||||
3813 | |||||||
3814 | Takes a format string (e.g., "#,##0.00_);(#,##0.00)") and fills in %foramt_defs with the parsed info | ||||||
3815 | |||||||
3816 | %format_defs | ||||||
3817 | {"#,##0.0"}->{} # elements in the hash are one hash for each format | ||||||
3818 | {operators}->[] # array of operators from parsing the format string (each a number) | ||||||
3819 | {operands}->[] # array of corresponding operators (each usually a string) | ||||||
3820 | {sectioninfo}->[] # one hash for each section of the format | ||||||
3821 | {start} | ||||||
3822 | {integerdigits} | ||||||
3823 | {fractiondigits} | ||||||
3824 | {commas} | ||||||
3825 | {percent} | ||||||
3826 | {thousandssep} | ||||||
3827 | {hasdates} | ||||||
3828 | {hascomparison} # true if any section has [<100], etc. | ||||||
3829 | |||||||
3830 | =cut | ||||||
3831 | |||||||
3832 | sub parse_format_string { | ||||||
3833 | |||||||
3834 | 85 | 85 | 1 | 132 | my ($format_defs, $format_string) = @_; | ||
3835 | |||||||
3836 | return | ||||||
3837 | 85 | 100 | 279 | if ($format_defs->{$format_string}); # already defined - nothing to do | |||
3838 | |||||||
3839 | 21 | 112 | my $thisformat = | ||||
3840 | { operators => [], operands => [], | ||||||
3841 | sectioninfo => [ {} ] }; # create info structure for this format | ||||||
3842 | 21 | 48 | $format_defs->{$format_string} = | ||||
3843 | $thisformat; # add to other format definitions | ||||||
3844 | |||||||
3845 | 21 | 62 | my $section = 0; # start with section 0 | ||||
3846 | 21 | 37 | my $sectioninfo = | ||||
3847 | $thisformat->{sectioninfo}->[$section] | ||||||
3848 | ; # get reference to info for current section | ||||||
3849 | 21 | 48 | $sectioninfo->{sectionstart} = | ||||
3850 | 0; # position in operands that starts this section | ||||||
3851 | |||||||
3852 | 21 | 105 | my @formatchars = split //, | ||||
3853 | $format_string; # break into individual characters | ||||||
3854 | |||||||
3855 | 21 | 34 | my $integerpart = 1; # start out in integer part | ||||
3856 | 21 | 27 | my $lastwasinteger; # last char was an integer placeholder | ||||
3857 | my $lastwasslash; # last char was a backslash - escaping following character | ||||||
3858 | 0 | 0 | my $lastwasasterisk; # repeat next char | ||||
3859 | 0 | 0 | my $lastwasunderscore | ||||
3860 | ; # last char was _ which picks up following char for width | ||||||
3861 | 0 | 0 | my ($inquote, $quotestr); # processing a quoted string | ||||
3862 | 0 | 0 | my ($inbracket, $bracketstr, $cmd); # processing a bracketed string | ||||
3863 | 0 | 0 | my ($ingeneral, $gpos); # checks for characters "General" | ||||
3864 | 0 | 0 | my $ampmstr; # checks for characters "A/P" and "AM/PM" | ||||
3865 | 0 | 0 | my $indate; # keeps track of date/time placeholders | ||||
3866 | |||||||
3867 | 21 | 39 | foreach my $ch (@formatchars) { # parse | ||||
3868 | 100 | 50 | 186 | if ($inquote) { | |||
3869 | 0 | 0 | 0 | if ($ch eq '"') { | |||
3870 | 0 | 0 | $inquote = 0; | ||||
3871 | 0 | 0 | push @{ $thisformat->{operators} }, $cmd_copy; | ||||
0 | 0 | ||||||
3872 | 0 | 0 | push @{ $thisformat->{operands} }, $quotestr; | ||||
0 | 0 | ||||||
3873 | 0 | 0 | next; | ||||
3874 | } | ||||||
3875 | 0 | 0 | $quotestr .= $ch; | ||||
3876 | 0 | 0 | next; | ||||
3877 | } | ||||||
3878 | 100 | 50 | 243 | if ($inbracket) { | |||
3879 | 0 | 0 | 0 | if ($ch eq ']') { | |||
3880 | 0 | 0 | $inbracket = 0; | ||||
3881 | 0 | 0 | ($cmd, $bracketstr) = parse_format_bracket($bracketstr); | ||||
3882 | 0 | 0 | 0 | if ($cmd == $cmd_separator) { | |||
3883 | 0 | 0 | $sectioninfo->{thousandssep} = 1; # explicit [,] | ||||
3884 | 0 | 0 | next; | ||||
3885 | } | ||||||
3886 | 0 | 0 | 0 | if ($cmd == $cmd_date) { | |||
3887 | 0 | 0 | $sectioninfo->{hasdate} = 1; | ||||
3888 | } | ||||||
3889 | 0 | 0 | 0 | if ($cmd == $cmd_comparison) { | |||
3890 | 0 | 0 | $thisformat->{hascomparison} = 1; | ||||
3891 | } | ||||||
3892 | 0 | 0 | push @{ $thisformat->{operators} }, $cmd; | ||||
0 | 0 | ||||||
3893 | 0 | 0 | push @{ $thisformat->{operands} }, $bracketstr; | ||||
0 | 0 | ||||||
3894 | 0 | 0 | next; | ||||
3895 | } | ||||||
3896 | 0 | 0 | $bracketstr .= $ch; | ||||
3897 | 0 | 0 | next; | ||||
3898 | } | ||||||
3899 | 100 | 50 | 160 | if ($lastwasslash) { | |||
3900 | 0 | 0 | push @{ $thisformat->{operators} }, $cmd_copy; | ||||
0 | 0 | ||||||
3901 | 0 | 0 | push @{ $thisformat->{operands} }, $ch; | ||||
0 | 0 | ||||||
3902 | 0 | 0 | $lastwasslash = 0; | ||||
3903 | 0 | 0 | next; | ||||
3904 | } | ||||||
3905 | 100 | 50 | 163 | if ($lastwasasterisk) { | |||
3906 | 0 | 0 | push @{ $thisformat->{operators} }, $cmd_copy; | ||||
0 | 0 | ||||||
3907 | 0 | 0 | push @{ $thisformat->{operands} }, $ch x 5; | ||||
0 | 0 | ||||||
3908 | 0 | 0 | $lastwasasterisk = 0; | ||||
3909 | 0 | 0 | next; | ||||
3910 | } | ||||||
3911 | 100 | 50 | 151 | if ($lastwasunderscore) { | |||
3912 | 0 | 0 | push @{ $thisformat->{operators} }, $cmd_copy; | ||||
0 | 0 | ||||||
3913 | 0 | 0 | push @{ $thisformat->{operands} }, " "; | ||||
0 | 0 | ||||||
3914 | 0 | 0 | $lastwasunderscore = 0; | ||||
3915 | 0 | 0 | next; | ||||
3916 | } | ||||||
3917 | 100 | 100 | 177 | if ($ingeneral) { | |||
3918 | 6 | 50 | 15 | if (substr("general", $ingeneral, 1) eq lc $ch) { | |||
3919 | 6 | 7 | $ingeneral++; | ||||
3920 | 6 | 100 | 11 | if ($ingeneral == 7) { | |||
3921 | 1 | 2 | push @{ $thisformat->{operators} }, $cmd_general; | ||||
1 | 3 | ||||||
3922 | 1 | 7 | push @{ $thisformat->{operands} }, $ch; | ||||
1 | 3 | ||||||
3923 | 1 | 3 | $ingeneral = 0; | ||||
3924 | } | ||||||
3925 | 6 | 14 | next; | ||||
3926 | } | ||||||
3927 | 0 | 0 | $ingeneral = 0; | ||||
3928 | } | ||||||
3929 | 94 | 100 | 160 | if ($indate) { # last char was part of a date placeholder | |||
3930 | 30 | 100 | 64 | if (substr($indate, 0, 1) eq $ch) { # another of the same char | |||
3931 | 27 | 33 | $indate .= $ch; # accumulate it | ||||
3932 | 27 | 49 | next; | ||||
3933 | } | ||||||
3934 | 3 | 5 | push @{ $thisformat->{operators} }, | ||||
3 | 9 | ||||||
3935 | $cmd_date; # something else, save date info | ||||||
3936 | 3 | 4 | push @{ $thisformat->{operands} }, $indate; | ||||
3 | 8 | ||||||
3937 | 3 | 9 | $sectioninfo->{hasdate} = 1; | ||||
3938 | 3 | 4 | $indate = ""; | ||||
3939 | } | ||||||
3940 | 67 | 50 | 108 | if ($ampmstr) { | |||
3941 | 0 | 0 | $ampmstr .= $ch; | ||||
3942 | 0 | 0 | 0 | 0 | if ("am/pm" =~ m/^$ampmstr/i || "a/p" =~ m/^$ampmstr/i) { | ||
3943 | 0 | 0 | 0 | 0 | if (("am/pm" eq lc $ampmstr) || ("a/p" eq lc $ampmstr)) { | ||
3944 | 0 | 0 | push @{ $thisformat->{operators} }, $cmd_date; | ||||
0 | 0 | ||||||
3945 | 0 | 0 | push @{ $thisformat->{operands} }, $ampmstr; | ||||
0 | 0 | ||||||
3946 | 0 | 0 | $ampmstr = ""; | ||||
3947 | } | ||||||
3948 | 0 | 0 | next; | ||||
3949 | } | ||||||
3950 | 0 | 0 | $ampmstr = ""; | ||||
3951 | } | ||||||
3952 | 67 | 100 | 100 | 658 | if ($ch eq "#" || $ch eq "0" || $ch eq "?") { # placeholder | ||
100 | 66 | ||||||
50 | |||||||
100 | |||||||
100 | |||||||
50 | |||||||
50 | |||||||
50 | |||||||
50 | |||||||
50 | |||||||
100 | |||||||
100 | |||||||
50 | |||||||
100 | |||||||
3953 | 32 | 100 | 46 | if ($integerpart) { | |||
3954 | 24 | 33 | $sectioninfo->{integerdigits}++; | ||||
3955 | 24 | 100 | 46 | if ($sectioninfo->{commas}) { # comma inside of integer placeholders | |||
3956 | 4 | 7 | $sectioninfo->{thousandssep} = | ||||
3957 | 1; # any number is thousands separator | ||||||
3958 | 4 | 8 | $sectioninfo->{commas} = 0; # reset count of "thousand" factors | ||||
3959 | } | ||||||
3960 | 24 | 26 | $lastwasinteger = 1; | ||||
3961 | 24 | 20 | push @{ $thisformat->{operators} }, $cmd_integer_placeholder; | ||||
24 | 46 | ||||||
3962 | 24 | 26 | push @{ $thisformat->{operands} }, $ch; | ||||
24 | 63 | ||||||
3963 | } else { | ||||||
3964 | 8 | 10 | $sectioninfo->{fractiondigits}++; | ||||
3965 | 8 | 9 | push @{ $thisformat->{operators} }, $cmd_fraction_placeholder; | ||||
8 | 16 | ||||||
3966 | 8 | 9 | push @{ $thisformat->{operands} }, $ch; | ||||
8 | 19 | ||||||
3967 | } | ||||||
3968 | } elsif ($ch eq ".") { # decimal point | ||||||
3969 | 3 | 4 | $lastwasinteger = 0; | ||||
3970 | 3 | 4 | push @{ $thisformat->{operators} }, $cmd_decimal; | ||||
3 | 6 | ||||||
3971 | 3 | 5 | push @{ $thisformat->{operands} }, $ch; | ||||
3 | 5 | ||||||
3972 | 3 | 6 | $integerpart = 0; | ||||
3973 | } elsif ($ch eq '$') { # currency char | ||||||
3974 | 0 | 0 | $lastwasinteger = 0; | ||||
3975 | 0 | 0 | push @{ $thisformat->{operators} }, $cmd_currency; | ||||
0 | 0 | ||||||
3976 | 0 | 0 | push @{ $thisformat->{operands} }, $ch; | ||||
0 | 0 | ||||||
3977 | } elsif ($ch eq ",") { | ||||||
3978 | 8 | 100 | 19 | if ($lastwasinteger) { | |||
3979 | 7 | 16 | $sectioninfo->{commas}++; | ||||
3980 | } else { | ||||||
3981 | 1 | 3 | push @{ $thisformat->{operators} }, $cmd_copy; | ||||
1 | 3 | ||||||
3982 | 1 | 2 | push @{ $thisformat->{operands} }, $ch; | ||||
1 | 4 | ||||||
3983 | } | ||||||
3984 | } elsif ($ch eq "%") { | ||||||
3985 | 2 | 3 | $lastwasinteger = 0; | ||||
3986 | 2 | 4 | $sectioninfo->{percent}++; | ||||
3987 | 2 | 3 | push @{ $thisformat->{operators} }, $cmd_copy; | ||||
2 | 3 | ||||||
3988 | 2 | 3 | push @{ $thisformat->{operands} }, $ch; | ||||
2 | 8 | ||||||
3989 | } elsif ($ch eq '"') { | ||||||
3990 | 0 | 0 | $lastwasinteger = 0; | ||||
3991 | 0 | 0 | $inquote = 1; | ||||
3992 | 0 | 0 | $quotestr = ""; | ||||
3993 | } elsif ($ch eq '[') { | ||||||
3994 | 0 | 0 | $lastwasinteger = 0; | ||||
3995 | 0 | 0 | $inbracket = 1; | ||||
3996 | 0 | 0 | $bracketstr = ""; | ||||
3997 | } elsif ($ch eq '\\') { | ||||||
3998 | 0 | 0 | $lastwasslash = 1; | ||||
3999 | 0 | 0 | $lastwasinteger = 0; | ||||
4000 | } elsif ($ch eq '*') { | ||||||
4001 | 0 | 0 | $lastwasasterisk = 1; | ||||
4002 | 0 | 0 | $lastwasinteger = 0; | ||||
4003 | } elsif ($ch eq '_') { | ||||||
4004 | 0 | 0 | $lastwasunderscore = 1; | ||||
4005 | 0 | 0 | $lastwasinteger = 0; | ||||
4006 | } elsif ($ch eq ";") { | ||||||
4007 | 1 | 2 | $section++; # start next section | ||||
4008 | 1 | 3 | $thisformat->{sectioninfo}->[$section] = {}; # create a new section | ||||
4009 | 1 | 3 | $sectioninfo = | ||||
4010 | $thisformat->{sectioninfo}->[$section] | ||||||
4011 | ; # set to point to the new section | ||||||
4012 | 1 | 42 | $sectioninfo->{sectionstart} = | ||||
4013 | 1 | 1 | 1 + scalar @{ $thisformat->{operators} }; # remember where it starts | ||||
4014 | 1 | 3 | $integerpart = 1; # reset for new section | ||||
4015 | 1 | 1 | $lastwasinteger = 0; | ||||
4016 | 1 | 2 | push @{ $thisformat->{operators} }, $cmd_section; | ||||
1 | 3 | ||||||
4017 | 1 | 2 | push @{ $thisformat->{operands} }, $ch; | ||||
1 | 3 | ||||||
4018 | } elsif ((lc $ch) eq "g") { | ||||||
4019 | 1 | 1 | $ingeneral = 1; | ||||
4020 | 1 | 3 | $lastwasinteger = 0; | ||||
4021 | } elsif ((lc $ch) eq "a") { | ||||||
4022 | 0 | 0 | $ampmstr = $ch; | ||||
4023 | 0 | 0 | $lastwasinteger = 0; | ||||
4024 | } elsif ($ch =~ m/[dmyhHs]/) { | ||||||
4025 | 15 | 31 | $indate = $ch; | ||||
4026 | } else { | ||||||
4027 | 5 | 8 | $lastwasinteger = 0; | ||||
4028 | 5 | 7 | push @{ $thisformat->{operators} }, $cmd_copy; | ||||
5 | 13 | ||||||
4029 | 5 | 8 | push @{ $thisformat->{operands} }, $ch; | ||||
5 | 14 | ||||||
4030 | } | ||||||
4031 | } | ||||||
4032 | |||||||
4033 | 21 | 100 | 58 | if ($indate) { # last char was part of unsaved date placeholder | |||
4034 | 12 | 14 | push @{ $thisformat->{operators} }, $cmd_date; # save what we got | ||||
12 | 101 | ||||||
4035 | 12 | 17 | push @{ $thisformat->{operands} }, $indate; | ||||
12 | 25 | ||||||
4036 | 12 | 22 | $sectioninfo->{hasdate} = 1; | ||||
4037 | } | ||||||
4038 | |||||||
4039 | 21 | 63 | return; | ||||
4040 | |||||||
4041 | } | ||||||
4042 | |||||||
4043 | =head2 parse_format_bracket | ||||||
4044 | |||||||
4045 | ($operator, $operand) = parse_format_bracket($bracketstr) | ||||||
4046 | |||||||
4047 | =cut | ||||||
4048 | |||||||
4049 | sub parse_format_bracket { | ||||||
4050 | |||||||
4051 | 0 | 0 | 1 | 0 | my $bracketstr = shift @_; | ||
4052 | |||||||
4053 | 0 | 0 | my ($operator, $operand); | ||||
4054 | |||||||
4055 | 0 | 0 | 0 | if (substr($bracketstr, 0, 1) eq '$') { # currency | |||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
4056 | 0 | 0 | $operator = $cmd_currency; | ||||
4057 | 0 | 0 | 0 | if ($bracketstr =~ m/^\$(.+?)(\-.+?){0,1}$/) { | |||
4058 | 0 | 0 | 0 | $operand = $1 || '$'; | |||
4059 | } else { | ||||||
4060 | 0 | 0 | 0 | $operand = substr($bracketstr, 1) || '$'; | |||
4061 | } | ||||||
4062 | } elsif ($bracketstr eq '?$') { | ||||||
4063 | 0 | 0 | $operator = $cmd_currency; | ||||
4064 | 0 | 0 | $operand = '[?$]'; | ||||
4065 | } elsif ($allowedcolors{ uc $bracketstr }) { | ||||||
4066 | 0 | 0 | $operator = $cmd_color; | ||||
4067 | 0 | 0 | $operand = $allowedcolors{ uc $bracketstr }; | ||||
4068 | } elsif ($bracketstr =~ m/^style=([^"]*)$/) { # [style=...] | ||||||
4069 | 0 | 0 | $operator = $cmd_style; | ||||
4070 | 0 | 0 | $operand = $1; | ||||
4071 | } elsif ($bracketstr eq ",") { | ||||||
4072 | 0 | 0 | $operator = $cmd_separator; | ||||
4073 | 0 | 0 | $operand = $bracketstr; | ||||
4074 | } elsif ($alloweddates{ uc $bracketstr }) { | ||||||
4075 | 0 | 0 | $operator = $cmd_date; | ||||
4076 | 0 | 0 | $operand = $alloweddates{ uc $bracketstr }; | ||||
4077 | } elsif ($bracketstr =~ m/^[<>=]/) { # comparison operator | ||||||
4078 | 0 | 0 | $bracketstr =~ m/^([<>=]+)(.+)$/; # split operator and value | ||||
4079 | 0 | 0 | $operator = $cmd_comparison; | ||||
4080 | 0 | 0 | $operand = "$1:$2"; | ||||
4081 | } else { # unknown bracket | ||||||
4082 | 0 | 0 | $operator = $cmd_copy; | ||||
4083 | 0 | 0 | $operand = "[$bracketstr]"; | ||||
4084 | } | ||||||
4085 | |||||||
4086 | 0 | 0 | return ($operator, $operand); | ||||
4087 | |||||||
4088 | } | ||||||
4089 | |||||||
4090 | =head2 check_and_calc_cell | ||||||
4091 | |||||||
4092 | $circref = check_and_calc_cell(\%sheetdata, $coord) | ||||||
4093 | |||||||
4094 | Recalculates one cell after making sure dependencies are calc'ed, too. | ||||||
4095 | If circular reference, returns non-null. | ||||||
4096 | Circular referenced detected by using $sheetdata->{checked}->{$coord}: | ||||||
4097 | null - not evaluated | ||||||
4098 | 1 - cell is being recursed into -- if get back here => circular reference | ||||||
4099 | 2 - cell was fully recursed into and calculated this recalc cycle | ||||||
4100 | |||||||
4101 | =cut | ||||||
4102 | |||||||
4103 | sub check_and_calc_cell { | ||||||
4104 | |||||||
4105 | 106850 | 106850 | 1 | 145497 | my ($Sheet, $coord) = @_; | ||
4106 | |||||||
4107 | 106850 | 149599 | my $coordchecked = $Sheet->{checked}; | ||||
4108 | |||||||
4109 | 106850 | 100 | 100 | 634671 | return "" | ||
4110 | if !$Sheet->{datatypes}->{$coord} | ||||||
4111 | or $Sheet->{datatypes}->{$coord} ne 'f'; | ||||||
4112 | |||||||
4113 | 50015 | 100 | 115081 | if ($Sheet->{checked}->{$coord}) { | |||
4114 | 16538 | 100 | 40737 | return $Sheet->{cellerrors}->{$coord} = "Circular reference to $coord" | |||
4115 | if $Sheet->{checked}->{$coord} == 1; | ||||||
4116 | 16537 | 37888 | return ""; | ||||
4117 | } | ||||||
4118 | 33477 | 72638 | $Sheet->{checked}->{$coord} = 1; | ||||
4119 | |||||||
4120 | 33477 | 70725 | my $line = $Sheet->{formulas}->{$coord}; | ||||
4121 | 33477 | 69529 | my $parseinfo = parse_formula_into_tokens($line); | ||||
4122 | |||||||
4123 | 33477 | 58708 | my $parsed_token_text = $parseinfo->{tokentext}; | ||||
4124 | 33477 | 47439 | my $parsed_token_type = $parseinfo->{tokentype}; | ||||
4125 | 33477 | 45494 | my ($ttype, $ttext, $sheetref); | ||||
4126 | 33477 | 80991 | for (my $i = 0 ; $i < @$parsed_token_text ; $i++) { | ||||
4127 | 160574 | 195300 | $ttype = $parsed_token_type->[$i]; | ||||
4128 | 160574 | 189657 | $ttext = $parsed_token_text->[$i]; | ||||
4129 | 160574 | 100 | 289613 | if ($ttype == $token_op) | |||
4130 | { # references with sheet specifier are not recursed into | ||||||
4131 | 74497 | 100 | 179705 | if ($ttext eq "!") { | |||
100 | |||||||
4132 | 83 | 172 | $sheetref = 1; # found a sheet reference | ||||
4133 | } elsif ($ttext ne ":") { # for everything but a range, reset | ||||||
4134 | 73120 | 91661 | $sheetref = 0; | ||||
4135 | } | ||||||
4136 | } | ||||||
4137 | 160574 | 100 | 262814 | if ($ttype == $token_name) { # look for named range | |||
4138 | 18891 | 20878 | my ($valuetype, $errortext); | ||||
4139 | 18891 | 50233 | my $value = lookup_name($Sheet, $ttext, \$valuetype, \$errortext); | ||||
4140 | 18891 | 100 | 52390 | if ($valuetype eq "range") | |||
4141 | { # only need to recurse for range, which may be just one cell | ||||||
4142 | 198 | 919 | my ($cr1, $cr2) = split (/\|/, $value); | ||||
4143 | 198 | 33 | 637 | $cr2 ||= $cr1; | |||
4144 | 198 | 495 | my ($c1, $r1) = coord_to_cr($cr1); | ||||
4145 | 198 | 425 | my ($c2, $r2) = coord_to_cr($cr2); | ||||
4146 | 198 | 50 | 525 | ($c2, $c1) = ($c1, $c2) if ($c1 > $c2); | |||
4147 | 198 | 50 | 504 | ($r2, $r1) = ($r1, $r2) if ($r1 > $r2); | |||
4148 | 198 | 528 | for (my $r = $r1 ; $r <= $r2 ; $r++) { | ||||
4149 | 2596 | 5173 | for (my $c = $c1 ; $c <= $c2 ; $c++) { | ||||
4150 | 22980 | 40294 | my $rangecoord = cr_to_coord($c, $r); | ||||
4151 | 22980 | 42448 | my $circref = check_and_calc_cell($Sheet, $rangecoord); | ||||
4152 | 22980 | 50 | 70952 | $Sheet->{sheetattribs}->{circularreferencecell} = | |||
4153 | "$coord|$rangecoord" | ||||||
4154 | if $circref; | ||||||
4155 | } | ||||||
4156 | } | ||||||
4157 | } | ||||||
4158 | } | ||||||
4159 | 160574 | 100 | 424420 | if ($ttype == $token_coord) { | |||
4160 | 19285 | 100 | 100 | 97605 | if ( $i >= 2 | ||
100 | 100 | ||||||
66 | |||||||
100 | |||||||
4161 | && $parsed_token_type->[ $i - 1 ] == $token_op | ||||||
4162 | && $parsed_token_text->[ $i - 1 ] eq ':' | ||||||
4163 | && $parsed_token_type->[ $i - 2 ] == $token_coord | ||||||
4164 | && !$sheetref) { # Range -- check each cell | ||||||
4165 | 1272 | 4506 | my ($c1, $r1) = coord_to_cr($parsed_token_text->[ $i - 2 ]); | ||||
4166 | 1272 | 3469 | my ($c2, $r2) = coord_to_cr($ttext); | ||||
4167 | 1272 | 50 | 3836 | ($c2, $c1) = ($c1, $c2) if ($c1 > $c2); | |||
4168 | 1272 | 50 | 3635 | ($r2, $r1) = ($r1, $r2) if ($r1 > $r2); | |||
4169 | 1272 | 3832 | for (my $r = $r1 ; $r <= $r2 ; $r++) | ||||
4170 | { # Checks first cell a second time, but that should just return | ||||||
4171 | 5276 | 11288 | for (my $c = $c1 ; $c <= $c2 ; $c++) { | ||||
4172 | 13260 | 22497 | my $rangecoord = cr_to_coord($c, $r); | ||||
4173 | 13260 | 23140 | my $circref = check_and_calc_cell($Sheet, $rangecoord); | ||||
4174 | 13260 | 100 | 49599 | $Sheet->{sheetattribs}->{circularreferencecell} = | |||
4175 | "$coord|$rangecoord" | ||||||
4176 | if $circref; | ||||||
4177 | } | ||||||
4178 | } | ||||||
4179 | } elsif (!$sheetref) { # Single cell reference | ||||||
4180 | 17981 | 29573 | $ttext =~ s/\$//g; | ||||
4181 | 17981 | 37280 | my $circref = check_and_calc_cell($Sheet, $ttext); | ||||
4182 | 17981 | 50 | 71031 | $Sheet->{sheetattribs}->{circularreferencecell} = "$coord|$ttext" | |||
4183 | if $circref; # remember at least one circ ref | ||||||
4184 | } | ||||||
4185 | } | ||||||
4186 | } | ||||||
4187 | 33477 | 67639 | my ($value, $valuetype, $errortext) = | ||||
4188 | evaluate_parsed_formula($parseinfo, $Sheet); | ||||||
4189 | 33477 | 93341 | $Sheet->{datavalues}->{$coord} = $value; | ||||
4190 | 33477 | 68315 | $Sheet->{valuetypes}->{$coord} = $valuetype; | ||||
4191 | 33477 | 100 | 97224 | if ($errortext) { | |||
100 | |||||||
4192 | 2244 | 5540 | $Sheet->{cellerrors}->{$coord} = $errortext; | ||||
4193 | } elsif ($Sheet->{cellerrors}->{$coord}) { | ||||||
4194 | 1 | 4 | delete $Sheet->{cellerrors}->{$coord}; | ||||
4195 | } | ||||||
4196 | 33477 | 57441 | $Sheet->{checked}->{$coord} = 2; # Remember we were here | ||||
4197 | 33477 | 184223 | return ""; | ||||
4198 | } | ||||||
4199 | |||||||
4200 | =head2 parse_formula_into_tokens | ||||||
4201 | |||||||
4202 | \%parseinfo = parse_formula_into_tokens($line) | ||||||
4203 | |||||||
4204 | Parses a text string as if it was a spreadsheet formula | ||||||
4205 | |||||||
4206 | This uses a simple state machine run on each character in turn. | ||||||
4207 | States remember whether a number is being gathered, etc. | ||||||
4208 | The result is %parseinfo which has the following arrays with one entry for each token: | ||||||
4209 | {tokentext}->[] - the characters making up the parsed token, | ||||||
4210 | {tokentype}->[] - the type of the token, | ||||||
4211 | {tokenopcode}->[] - a single character version of an operator suitable for use in the | ||||||
4212 | precedence table and distinguishing between unary and binary + and -. | ||||||
4213 | |||||||
4214 | =cut | ||||||
4215 | |||||||
4216 | sub parse_formula_into_tokens { | ||||||
4217 | |||||||
4218 | 33477 | 33477 | 1 | 45936 | my $line = shift @_; | ||
4219 | |||||||
4220 | 33477 | 119796 | my @ch = unpack("C*", $line); | ||||
4221 | 33477 | 59017 | push @ch, ord('#'); # add eof at end | ||||
4222 | |||||||
4223 | 33477 | 35802 | my $state = 0; | ||||
4224 | 33477 | 35831 | my $state_num = 1; | ||||
4225 | 33477 | 35395 | my $state_alpha = 2; | ||||
4226 | 33477 | 34595 | my $state_coord = 3; | ||||
4227 | 33477 | 42439 | my $state_string = 4; | ||||
4228 | 33477 | 34406 | my $state_stringquote = 5; | ||||
4229 | 33477 | 33691 | my $state_numexp1 = 6; | ||||
4230 | 33477 | 33440 | my $state_numexp2 = 7; | ||||
4231 | 33477 | 33022 | my $state_alphanumeric = 8; | ||||
4232 | |||||||
4233 | 33477 | 30619 | my $str; | ||||
4234 | 33477 | 39863 | my ($cclass, $chrc, $ucchrc, $last_token_type, $last_token_text, $t); | ||||
4235 | |||||||
4236 | 0 | 0 | my %parseinfo; | ||||
4237 | |||||||
4238 | 33477 | 73149 | $parseinfo{tokentext} = []; | ||||
4239 | 33477 | 58764 | $parseinfo{tokentype} = []; | ||||
4240 | 33477 | 59779 | $parseinfo{tokenopcode} = []; | ||||
4241 | 33477 | 47296 | my $parsed_token_text = $parseinfo{tokentext}; | ||||
4242 | 33477 | 42180 | my $parsed_token_type = $parseinfo{tokentype}; | ||||
4243 | 33477 | 38735 | my $parsed_token_opcode = $parseinfo{tokenopcode}; | ||||
4244 | |||||||
4245 | 33477 | 50689 | foreach my $c (@ch) { | ||||
4246 | 327791 | 414411 | $chrc = chr($c); | ||||
4247 | 327791 | 426230 | $ucchrc = uc $chrc; | ||||
4248 | 327791 | 50 | 813814 | $cclass = $char_class[ ($c <= 127 ? (($c >= 32) ? $c : 32) : 32) - 32 ]; | |||
50 | |||||||
4249 | |||||||
4250 | 327791 | 100 | 567447 | if ($state == $state_num) { | |||
4251 | 52495 | 100 | 66 | 165417 | if ($cclass == $char_class_num) { | ||
100 | |||||||
100 | |||||||
4252 | 14022 | 19153 | $str .= $chrc; | ||||
4253 | } elsif ($cclass == $char_class_numstart && index($str, '.') == -1) { | ||||||
4254 | 1711 | 3355 | $str .= $chrc; | ||||
4255 | } elsif ($ucchrc eq 'E') { | ||||||
4256 | 6 | 7 | $str .= $chrc; | ||||
4257 | 6 | 10 | $state = $state_numexp1; | ||||
4258 | } else { # end of number - save it | ||||||
4259 | 36756 | 66113 | push @$parsed_token_text, $str; | ||||
4260 | 36756 | 52595 | push @$parsed_token_type, $token_num; | ||||
4261 | 36756 | 46758 | push @$parsed_token_opcode, 0; | ||||
4262 | 36756 | 55823 | $state = 0; | ||||
4263 | } | ||||||
4264 | } | ||||||
4265 | |||||||
4266 | 327791 | 100 | 546205 | if ($state == $state_numexp1) { | |||
4267 | 17 | 100 | 100 | 80 | if ($cclass == $state_num) { | ||
100 | 66 | ||||||
50 | |||||||
4268 | 6 | 8 | $state = $state_numexp2; | ||||
4269 | } elsif (($chrc eq '+' || $chrc eq '-') && (uc substr($str, -1)) eq 'E') | ||||||
4270 | { | ||||||
4271 | 5 | 6 | $str .= $chrc; | ||||
4272 | } elsif ($ucchrc eq 'E') { | ||||||
4273 | ; | ||||||
4274 | } else { | ||||||
4275 | 0 | 0 | push @$parsed_token_text, "Improperly formed number exponent"; | ||||
4276 | 0 | 0 | push @$parsed_token_type, $token_error; | ||||
4277 | 0 | 0 | push @$parsed_token_opcode, 0; | ||||
4278 | 0 | 0 | $state = 0; | ||||
4279 | } | ||||||
4280 | } | ||||||
4281 | |||||||
4282 | 327791 | 100 | 526655 | if ($state == $state_numexp2) { | |||
4283 | 12 | 100 | 15 | if ($cclass == $char_class_num) { | |||
4284 | 6 | 10 | $str .= $chrc; | ||||
4285 | } else { # end of number - save it | ||||||
4286 | 6 | 12 | push @$parsed_token_text, $str; | ||||
4287 | 6 | 7 | push @$parsed_token_type, $token_num; | ||||
4288 | 6 | 9 | push @$parsed_token_opcode, 0; | ||||
4289 | 6 | 8 | $state = 0; | ||||
4290 | } | ||||||
4291 | } | ||||||
4292 | |||||||
4293 | 327791 | 100 | 539619 | if ($state == $state_alpha) { | |||
4294 | 93530 | 100 | 66 | 251968 | if ($cclass == $char_class_num) { | ||
100 | 100 | ||||||
100 | 66 | ||||||
100 | |||||||
4295 | 20212 | 26602 | $state = $state_coord; | ||||
4296 | } elsif ($cclass == $char_class_alpha) { | ||||||
4297 | 55162 | 76780 | $str .= | ||||
4298 | $ucchrc; # coords and functions are uppercase, names ignore case | ||||||
4299 | } elsif ($cclass == $char_class_incoord) { | ||||||
4300 | 6 | 9 | $state = $state_coord; | ||||
4301 | } elsif ($cclass == $char_class_op | ||||||
4302 | || $cclass == $char_class_numstart | ||||||
4303 | || $cclass == $char_class_space | ||||||
4304 | || $cclass == $char_class_eof) { | ||||||
4305 | 18135 | 37616 | push @$parsed_token_text, $str; | ||||
4306 | 18135 | 26577 | push @$parsed_token_type, $token_name; | ||||
4307 | 18135 | 27194 | push @$parsed_token_opcode, 0; | ||||
4308 | 18135 | 27881 | $state = 0; | ||||
4309 | } else { | ||||||
4310 | 15 | 38 | push @$parsed_token_text, $str; | ||||
4311 | 15 | 31 | push @$parsed_token_type, $token_error; | ||||
4312 | 15 | 26 | push @$parsed_token_opcode, 0; | ||||
4313 | 15 | 31 | $state = 0; | ||||
4314 | } | ||||||
4315 | } | ||||||
4316 | |||||||
4317 | 327791 | 100 | 542429 | if ($state == $state_coord) { | |||
4318 | 55226 | 100 | 66 | 174554 | if ($cclass == $char_class_num) { | ||
100 | 100 | ||||||
50 | |||||||
100 | |||||||
4319 | 35002 | 46847 | $str .= $chrc; | ||||
4320 | } elsif ($cclass == $char_class_incoord) { | ||||||
4321 | 6 | 7 | $str .= $chrc; | ||||
4322 | } elsif ($cclass == $char_class_alpha) { | ||||||
4323 | 0 | 0 | $state = $state_alphanumeric; | ||||
4324 | } elsif ($cclass == $char_class_op | ||||||
4325 | || $cclass == $char_class_numstart | ||||||
4326 | || $cclass == $char_class_eof) { | ||||||
4327 | 20041 | 100 | 89370 | if ($str =~ m/^\$?[A-Z]{1,2}\$?[1-9]\d*$/) { | |||
4328 | 19285 | 26043 | $t = $token_coord; | ||||
4329 | } else { | ||||||
4330 | 756 | 1260 | $t = $token_name; | ||||
4331 | } | ||||||
4332 | 20041 | 36449 | push @$parsed_token_text, $str; | ||||
4333 | 20041 | 34054 | push @$parsed_token_type, $t; | ||||
4334 | 20041 | 28736 | push @$parsed_token_opcode, 0; | ||||
4335 | 20041 | 24951 | $state = 0; | ||||
4336 | } else { | ||||||
4337 | 177 | 450 | push @$parsed_token_text, $str; | ||||
4338 | 177 | 358 | push @$parsed_token_type, $token_error; | ||||
4339 | 177 | 332 | push @$parsed_token_opcode, 0; | ||||
4340 | 177 | 315 | $state = 0; | ||||
4341 | } | ||||||
4342 | } | ||||||
4343 | |||||||
4344 | 327791 | 50 | 581136 | if ($state == $state_alphanumeric) { | |||
4345 | 0 | 0 | 0 | 0 | if ($cclass == $char_class_num || $cclass == $char_class_alpha) { | ||
0 | 0 | ||||||
0 | |||||||
0 | |||||||
4346 | 0 | 0 | $str .= | ||||
4347 | $ucchrc; # coords and functions are uppercase, names ignore case | ||||||
4348 | } elsif ($cclass == $char_class_op | ||||||
4349 | || $cclass == $char_class_numstart | ||||||
4350 | || $cclass == $char_class_space | ||||||
4351 | || $cclass == $char_class_eof) { | ||||||
4352 | 0 | 0 | push @$parsed_token_text, $str; | ||||
4353 | 0 | 0 | push @$parsed_token_type, $token_name; | ||||
4354 | 0 | 0 | push @$parsed_token_opcode, 0; | ||||
4355 | 0 | 0 | $state = 0; | ||||
4356 | } else { | ||||||
4357 | 0 | 0 | push @$parsed_token_text, $str; | ||||
4358 | 0 | 0 | push @$parsed_token_type, $token_error; | ||||
4359 | 0 | 0 | push @$parsed_token_opcode, 0; | ||||
4360 | 0 | 0 | $state = 0; | ||||
4361 | } | ||||||
4362 | } | ||||||
4363 | |||||||
4364 | 327791 | 100 | 708784 | if ($state == $state_string) { | |||
100 | |||||||
4365 | 27450 | 100 | 43611 | if ($cclass == $char_class_quote) { | |||
4366 | 6250 | 8185 | $state = | ||||
4367 | $state_stringquote | ||||||
4368 | ; # got quote in string: is it doubled (quote in string) or by itself (end of string)? | ||||||
4369 | } else { | ||||||
4370 | 21200 | 26994 | $str .= $chrc; | ||||
4371 | } | ||||||
4372 | } elsif ($state == $state_stringquote) { # note elseif here | ||||||
4373 | 6250 | 100 | 10466 | if ($cclass == $char_class_quote) { | |||
4374 | 2 | 4 | $str .= '"'; | ||||
4375 | 2 | 5 | $state = | ||||
4376 | $state_string; # double quote: add one then continue getting string | ||||||
4377 | } else { # something else -- end of string | ||||||
4378 | 6248 | 13097 | push @$parsed_token_text, $str; | ||||
4379 | 6248 | 9388 | push @$parsed_token_type, $token_string; | ||||
4380 | 6248 | 8508 | push @$parsed_token_opcode, 0; | ||||
4381 | 6248 | 8599 | $state = 0; # drop through to process | ||||
4382 | } | ||||||
4383 | } | ||||||
4384 | |||||||
4385 | 327791 | 100 | 618964 | if ($state == 0) { | |||
4386 | 194419 | 100 | 100 | 1237150 | if ($cclass == $char_class_num || $cclass == $char_class_numstart) { | ||
100 | 100 | ||||||
100 | |||||||
100 | |||||||
100 | |||||||
100 | |||||||
4387 | 36762 | 47505 | $str = $chrc; | ||||
4388 | 36762 | 54177 | $state = $state_num; | ||||
4389 | } elsif ($cclass == $char_class_alpha || $cclass == $char_class_incoord) | ||||||
4390 | { | ||||||
4391 | 38368 | 49122 | $str = $ucchrc; | ||||
4392 | 38368 | 60680 | $state = $state_alpha; | ||||
4393 | } elsif ($cclass == $char_class_op) { | ||||||
4394 | 74759 | 92297 | $str = chr($c); | ||||
4395 | 74759 | 100 | 123762 | if (@$parsed_token_type) { | |||
4396 | 74505 | 114381 | $last_token_type = $parsed_token_type->[ @$parsed_token_type - 1 ]; | ||||
4397 | 74505 | 113668 | $last_token_text = $parsed_token_text->[ @$parsed_token_text - 1 ]; | ||||
4398 | 74505 | 100 | 145224 | if ($last_token_type == $char_class_op) { | |||
4399 | 13637 | 100 | 100 | 59583 | if ($last_token_text eq '<' || $last_token_text eq ">") { | ||
4400 | 166 | 341 | $str = $last_token_text . $str; | ||||
4401 | 166 | 260 | pop @$parsed_token_text; | ||||
4402 | 166 | 234 | pop @$parsed_token_type; | ||||
4403 | 166 | 216 | pop @$parsed_token_opcode; | ||||
4404 | 166 | 50 | 361 | if (@$parsed_token_type) { | |||
4405 | 166 | 272 | $last_token_type = | ||||
4406 | $parsed_token_type->[ @$parsed_token_type - 1 ]; | ||||||
4407 | 166 | 312 | $last_token_text = | ||||
4408 | $parsed_token_text->[ @$parsed_token_text - 1 ]; | ||||||
4409 | } else { | ||||||
4410 | 0 | 0 | $last_token_type = $char_class_eof; | ||||
4411 | 0 | 0 | $last_token_text = "EOF"; | ||||
4412 | } | ||||||
4413 | } | ||||||
4414 | } | ||||||
4415 | } else { | ||||||
4416 | 254 | 363 | $last_token_type = $char_class_eof; | ||||
4417 | 254 | 446 | $last_token_text = "EOF"; | ||||
4418 | } | ||||||
4419 | 74759 | 78165 | $t = $token_op; | ||||
4420 | 74759 | 100 | 100 | 396238 | if ( | ||
100 | 100 | ||||||
66 | |||||||
4421 | (@$parsed_token_type == 0) | ||||||
4422 | || ( $last_token_type == $char_class_op | ||||||
4423 | && $last_token_text ne ')' | ||||||
4424 | && $last_token_text ne '%') | ||||||
4425 | ) { # Unary operator | ||||||
4426 | 6608 | 100 | 100 | 33594 | if ($str eq '-') { # M is unary minus | ||
100 | |||||||
100 | |||||||
100 | |||||||
4427 | 2284 | 3239 | $str = "M"; | ||||
4428 | 2284 | 3743 | $c = ord($str); | ||||
4429 | } elsif ($str eq '+') { # P is unary plus | ||||||
4430 | 9 | 15 | $str = "P"; | ||||
4431 | 9 | 15 | $c = ord($str); | ||||
4432 | } elsif ($str eq ')' && $last_token_text eq '(') | ||||||
4433 | { # null arg list OK | ||||||
4434 | ; | ||||||
4435 | } elsif ($str ne '(') { # binary-op open-paren OK, others no | ||||||
4436 | 96 | 167 | $t = $token_error; | ||||
4437 | 96 | 167 | $str = | ||||
4438 | "Error in formula (two operators inappropriately in a row)"; | ||||||
4439 | } | ||||||
4440 | } elsif (length $str > 1) { | ||||||
4441 | 166 | 100 | 775 | if ($str eq '>=') { # G is >= | |||
100 | |||||||
50 | |||||||
4442 | 23 | 48 | $str = "G"; | ||||
4443 | 23 | 53 | $c = ord($str); | ||||
4444 | } elsif ($str eq '<=') { # L is <= | ||||||
4445 | 25 | 52 | $str = "L"; | ||||
4446 | 25 | 49 | $c = ord($str); | ||||
4447 | } elsif ($str eq '<>') { # N is <> | ||||||
4448 | 118 | 200 | $str = "N"; | ||||
4449 | 118 | 157 | $c = ord($str); | ||||
4450 | } else { | ||||||
4451 | 0 | 0 | $t = $token_error; | ||||
4452 | 0 | 0 | $str = | ||||
4453 | "Error in formula (two operators inappropriately in a row)"; | ||||||
4454 | } | ||||||
4455 | } | ||||||
4456 | 74759 | 133603 | push @$parsed_token_text, $str; | ||||
4457 | 74759 | 95232 | push @$parsed_token_type, $t; | ||||
4458 | 74759 | 106884 | push @$parsed_token_opcode, $c; | ||||
4459 | 74759 | 122157 | $state = 0; | ||||
4460 | } elsif ($cclass == $char_class_quote) { # starting a string | ||||||
4461 | 6248 | 9481 | $str = ""; | ||||
4462 | 6248 | 13496 | $state = $state_string; | ||||
4463 | } elsif ($cclass == $char_class_space) | ||||||
4464 | { # store so can reconstruct spacing | ||||||
4465 | 4603 | 9466 | push @$parsed_token_text, " "; | ||||
4466 | 4603 | 7286 | push @$parsed_token_type, $token_space; | ||||
4467 | 4603 | 8638 | push @$parsed_token_opcode, 0; | ||||
4468 | } elsif ($cclass == $char_class_eof) { # ignore | ||||||
4469 | } | ||||||
4470 | } | ||||||
4471 | } | ||||||
4472 | |||||||
4473 | 33477 | 130205 | return \%parseinfo; | ||||
4474 | } | ||||||
4475 | |||||||
4476 | =head2 evaluate_parsed_formula | ||||||
4477 | |||||||
4478 | ($value, $valuetype, $errortext) = evaluate_parsed_formula(\%parseinfo, \%sheetdata, $allowrangereturn) | ||||||
4479 | |||||||
4480 | Does the calculation expressed in a parsed formula, returning a value, | ||||||
4481 | its type, and error info. | ||||||
4482 | |||||||
4483 | If $allowrangereturn is present and true, can return a range (e.g., "A1:A10" - translated from "A1|A10|") | ||||||
4484 | |||||||
4485 | =cut | ||||||
4486 | |||||||
4487 | sub evaluate_parsed_formula { | ||||||
4488 | |||||||
4489 | 33477 | 33477 | 1 | 46669 | my ($parseinfo, $sheetdata, $allowrangereturn) = @_; | ||
4490 | |||||||
4491 | 33477 | 60599 | my $parsed_token_text = $parseinfo->{tokentext}; | ||||
4492 | 33477 | 43482 | my $parsed_token_type = $parseinfo->{tokentype}; | ||||
4493 | 33477 | 41422 | my $parsed_token_opcode = $parseinfo->{tokenopcode}; | ||||
4494 | |||||||
4495 | # # # # # # # | ||||||
4496 | # | ||||||
4497 | # Convert infix to reverse polish notation | ||||||
4498 | # | ||||||
4499 | # Based upon the algorithm shown in Wikipedia "Reverse Polish notation" article | ||||||
4500 | # and then enhanced for additional spreadsheet things | ||||||
4501 | # | ||||||
4502 | # The @revpolish array ends up with a sequence of references to tokens by number | ||||||
4503 | # | ||||||
4504 | |||||||
4505 | 33477 | 37616 | my @revpolish; | ||||
4506 | my @parsestack; | ||||||
4507 | |||||||
4508 | 33477 | 38007 | my $function_start = -1; | ||||
4509 | |||||||
4510 | 33477 | 35647 | my ($ttype, $ttext, $tprecedence, $tstackprecedence, $errortext); | ||||
4511 | |||||||
4512 | 33477 | 76618 | for (my $i = 0 ; $i < scalar @$parsed_token_text ; $i++) { | ||||
4513 | 160174 | 181316 | $ttype = $parsed_token_type->[$i]; | ||||
4514 | 160174 | 194722 | $ttext = $parsed_token_text->[$i]; | ||||
4515 | 160174 | 100 | 100 | 1380646 | if ( $ttype == $token_num | ||
100 | 100 | ||||||
100 | |||||||
100 | |||||||
100 | |||||||
100 | |||||||
100 | |||||||
50 | |||||||
4516 | || $ttype == $token_coord | ||||||
4517 | || $ttype == $token_string) { | ||||||
4518 | 62224 | 151157 | push @revpolish, $i; | ||||
4519 | } elsif ($ttype == $token_name) { | ||||||
4520 | 18891 | 25732 | push @parsestack, $i; | ||||
4521 | 18891 | 51939 | push @revpolish, $function_start; | ||||
4522 | } elsif ($ttype == $token_space) { # ignore | ||||||
4523 | 4360 | 11384 | next; | ||||
4524 | } elsif ($ttext eq ',') { | ||||||
4525 | 12867 | 66 | 65723 | while (@parsestack | |||
4526 | && $parsed_token_text->[ $parsestack[ @parsestack - 1 ] ] ne '(') { | ||||||
4527 | 2208 | 10787 | push @revpolish, pop @parsestack; | ||||
4528 | } | ||||||
4529 | 12867 | 50 | 44002 | if (@parsestack == 0) { # no ( -- error | |||
4530 | 0 | 0 | $errortext = "Missing open parenthesis in list with comma(s)."; | ||||
4531 | 0 | 0 | last; | ||||
4532 | } | ||||||
4533 | } elsif ($ttext eq '(') { | ||||||
4534 | 19499 | 47454 | push @parsestack, $i; | ||||
4535 | } elsif ($ttext eq ')') { | ||||||
4536 | 19377 | 66 | 95733 | while (@parsestack | |||
4537 | && $parsed_token_text->[ $parsestack[ @parsestack - 1 ] ] ne '(') { | ||||||
4538 | 4448 | 21754 | push @revpolish, pop @parsestack; | ||||
4539 | } | ||||||
4540 | 19377 | 50 | 43521 | if (@parsestack == 0) { # no ( -- error | |||
4541 | 0 | 0 | $errortext = "Closing parenthesis without open parenthesis."; | ||||
4542 | 0 | 0 | last; | ||||
4543 | } | ||||||
4544 | 19377 | 23242 | pop @parsestack; | ||||
4545 | 19377 | 100 | 100 | 85816 | if ( @parsestack | ||
4546 | && $parsed_token_type->[ $parsestack[ @parsestack - 1 ] ] == | ||||||
4547 | $token_name) { | ||||||
4548 | 18470 | 53454 | push @revpolish, pop @parsestack; | ||||
4549 | } | ||||||
4550 | } elsif ($ttype == $token_op) { | ||||||
4551 | 22668 | 100 | 100 | 77792 | if ( @parsestack | ||
4552 | && $parsed_token_type->[ $parsestack[ @parsestack - 1 ] ] == | ||||||
4553 | $token_name) { | ||||||
4554 | 81 | 140 | push @revpolish, pop @parsestack; | ||||
4555 | } | ||||||
4556 | 22668 | 66 | 106173 | while (@parsestack | |||
100 | |||||||
4557 | && $parsed_token_type->[ $parsestack[ @parsestack - 1 ] ] == $token_op | ||||||
4558 | && $parsed_token_text->[ $parsestack[ @parsestack - 1 ] ] ne '(') { | ||||||
4559 | 3537 | 7546 | $tprecedence = $token_precedence[ $parsed_token_opcode->[$i] - 32 ]; | ||||
4560 | 3537 | 6532 | $tstackprecedence = | ||||
4561 | $token_precedence[ $parsed_token_opcode | ||||||
4562 | ->[ $parsestack[ @parsestack - 1 ] ] - 32 ]; | ||||||
4563 | 3537 | 100 | 100 | 16483 | if ($tprecedence >= 0 && $tprecedence < $tstackprecedence) { | ||
100 | |||||||
4564 | 570 | 1021 | last; | ||||
4565 | } elsif ($tprecedence < 0) { | ||||||
4566 | 113 | 210 | $tprecedence = -$tprecedence; | ||||
4567 | 113 | 50 | 261 | $tstackprecedence = -$tstackprecedence if $tstackprecedence < 0; | |||
4568 | 113 | 50 | 286 | if ($tprecedence <= $tstackprecedence) { | |||
4569 | 113 | 210 | last; | ||||
4570 | } | ||||||
4571 | } | ||||||
4572 | 2854 | 11830 | push @revpolish, pop @parsestack; | ||||
4573 | } | ||||||
4574 | 22668 | 58885 | push @parsestack, $i; | ||||
4575 | } elsif ($ttype == $token_error) { | ||||||
4576 | 288 | 493 | $errortext = $ttext; | ||||
4577 | 288 | 611 | last; | ||||
4578 | } else { | ||||||
4579 | 0 | 0 | $errortext = "Internal error while processing parsed formula. "; | ||||
4580 | 0 | 0 | last; | ||||
4581 | } | ||||||
4582 | } | ||||||
4583 | 33477 | 69435 | while (@parsestack) { | ||||
4584 | 13498 | 100 | 34146 | if ($parsed_token_text->[ $parsestack[ @parsestack - 1 ] ] eq '(') { | |||
4585 | 122 | 180 | $errortext = "Missing close parenthesis."; | ||||
4586 | 122 | 183 | last; | ||||
4587 | } | ||||||
4588 | 13376 | 32042 | push @revpolish, pop @parsestack; | ||||
4589 | } | ||||||
4590 | |||||||
4591 | # # # # # # # | ||||||
4592 | # | ||||||
4593 | # Execute it | ||||||
4594 | # | ||||||
4595 | |||||||
4596 | # Operand values are hashes with {value} and {type} | ||||||
4597 | # Type can have these values (many are type and sub-type as two or more letters): | ||||||
4598 | # "tw", "th", "t", "n", "nt", "coord", "range", "start", "eErrorType", "b" (blank) | ||||||
4599 | # The value of a coord is in the form A57 or A57!sheetname | ||||||
4600 | # The value of a range is coord|coord|number where number starts at 0 and is | ||||||
4601 | # the offset of the next item to fetch if you are going through the range one by one | ||||||
4602 | # The number starts as a null string ("A1|B3|") | ||||||
4603 | # | ||||||
4604 | |||||||
4605 | 33477 | 39240 | my @operand; | ||||
4606 | |||||||
4607 | 33477 | 38459 | my ($value1, $value2, $tostype, $tostype2, $resulttype); | ||||
4608 | |||||||
4609 | 33477 | 83044 | for (my $i = 0 ; $i < scalar @revpolish ; $i++) { | ||||
4610 | 122552 | 100 | 232192 | if ($revpolish[$i] == $function_start) | |||
4611 | { # Remember the start of a function argument list | ||||||
4612 | 18891 | 52569 | push @operand, { type => "start" }; | ||||
4613 | 18891 | 50455 | next; | ||||
4614 | } | ||||||
4615 | |||||||
4616 | 103661 | 128621 | $ttype = $parsed_token_type->[ $revpolish[$i] ]; | ||||
4617 | 103661 | 134851 | $ttext = $parsed_token_text->[ $revpolish[$i] ]; | ||||
4618 | |||||||
4619 | 103661 | 100 | 260842 | if ($ttype == $token_num) { | |||
100 | |||||||
100 | |||||||
100 | |||||||
50 | |||||||
4620 | |||||||
4621 | # TODO t/date.t gives lots of warnings here. Work out why. | ||||||
4622 | 34 | 34 | 1449256 | no warnings; | |||
34 | 134 | ||||||
34 | 182595 | ||||||
4623 | 36713 | 391491 | push @operand, { type => "n", value => 0 + $ttext }; | ||||
4624 | } | ||||||
4625 | |||||||
4626 | elsif ($ttype == $token_coord) { | ||||||
4627 | 19263 | 36616 | $ttext =~ s/[^0-9A-Z]//g; | ||||
4628 | 19263 | 92239 | push @operand, { type => "coord", value => $ttext }; | ||||
4629 | } | ||||||
4630 | |||||||
4631 | elsif ($ttype == $token_string) { | ||||||
4632 | 6248 | 29946 | push @operand, { type => "t", value => $ttext }; | ||||
4633 | } | ||||||
4634 | |||||||
4635 | elsif ($ttype == $token_op) { | ||||||
4636 | 22668 | 50 | 46490 | if (@operand <= 0) { # Nothing on the stack... | |||
4637 | 0 | 0 | $errortext = "Missing operand. "; # remember error | ||||
4638 | 0 | 0 | push @operand, { type => "n", value => 0 }; # put something there | ||||
4639 | } | ||||||
4640 | |||||||
4641 | # Unary minus | ||||||
4642 | |||||||
4643 | 22668 | 100 | 130748 | if ($ttext eq 'M') { | |||
100 | |||||||
100 | |||||||
100 | |||||||
100 | |||||||
100 | |||||||
100 | |||||||
4644 | 2284 | 7842 | $value1 = | ||||
4645 | operand_as_number($sheetdata, \@operand, \$errortext, \$tostype); | ||||||
4646 | 2284 | 7740 | $resulttype = | ||||
4647 | lookup_result_type($tostype, $tostype, $typelookup{unaryminus}); | ||||||
4648 | 2284 | 12729 | push @operand, { type => $resulttype, value => -$value1 }; | ||||
4649 | } | ||||||
4650 | |||||||
4651 | # Unary plus | ||||||
4652 | |||||||
4653 | elsif ($ttext eq 'P') { | ||||||
4654 | 9 | 29 | $value1 = | ||||
4655 | operand_as_number($sheetdata, \@operand, \$errortext, \$tostype); | ||||||
4656 | 9 | 35 | $resulttype = | ||||
4657 | lookup_result_type($tostype, $tostype, $typelookup{unaryplus}); | ||||||
4658 | 9 | 57 | push @operand, { type => $resulttype, value => $value1 }; | ||||
4659 | } | ||||||
4660 | |||||||
4661 | # Unary % - percent, left associative | ||||||
4662 | |||||||
4663 | elsif ($ttext eq '%') { | ||||||
4664 | 252 | 735 | $value1 = | ||||
4665 | operand_as_number($sheetdata, \@operand, \$errortext, \$tostype); | ||||||
4666 | 252 | 798 | $resulttype = | ||||
4667 | lookup_result_type($tostype, $tostype, $typelookup{unarypercent}); | ||||||
4668 | 252 | 1405 | push @operand, { type => $resulttype, value => 0.01 * $value1 }; | ||||
4669 | } | ||||||
4670 | |||||||
4671 | # & - string concatenate | ||||||
4672 | |||||||
4673 | elsif ($ttext eq '&') { | ||||||
4674 | 378 | 50 | 953 | if (@operand == 1) { # Need at least two things on the stack... | |||
4675 | 0 | 0 | $errortext = "Missing operand. "; # remember error | ||||
4676 | 0 | 0 | push @operand, { type => "t", | ||||
4677 | value => "" }; # put something there as second operand | ||||||
4678 | } | ||||||
4679 | $value2 = | ||||||
4680 | 378 | 1199 | operand_as_text($sheetdata, \@operand, \$errortext, \$tostype2); | ||||
4681 | 378 | 1012 | $value1 = | ||||
4682 | operand_as_text($sheetdata, \@operand, \$errortext, \$tostype); | ||||||
4683 | 378 | 1309 | $resulttype = | ||||
4684 | lookup_result_type($tostype, $tostype2, $typelookup{concat}); | ||||||
4685 | 378 | 2566 | push @operand, { type => $resulttype, value => ($value1 . $value2) }; | ||||
4686 | } | ||||||
4687 | |||||||
4688 | # : - Range constructor | ||||||
4689 | |||||||
4690 | elsif ($ttext eq ':') { | ||||||
4691 | 1283 | 50 | 3485 | if (@operand == 1) { # Need at least two things on the stack... | |||
4692 | 0 | 0 | $errortext = "Missing operand. "; # remember error | ||||
4693 | 0 | 0 | push @operand, { type => "n", | ||||
4694 | value => 0 }; # put something there as second operand | ||||||
4695 | } | ||||||
4696 | $value1 = | ||||||
4697 | 1283 | 5178 | operands_as_range_on_sheet($sheetdata, \@operand, \$tostype, | ||||
4698 | \$errortext); # get coords even if use name on other sheet | ||||||
4699 | 1283 | 7261 | push @operand, { type => $tostype, | ||||
4700 | value => $value1 }; # push sheetname with range on that sheet | ||||||
4701 | } | ||||||
4702 | |||||||
4703 | # ! - sheetname!coord | ||||||
4704 | |||||||
4705 | elsif ($ttext eq '!') { | ||||||
4706 | 83 | 50 | 280 | if (@operand == 1) { # Need at least two things on the stack... | |||
4707 | 0 | 0 | $errortext = "Missing operand. "; # remember error | ||||
4708 | 0 | 0 | push @operand, { type => "e#REF!", | ||||
4709 | value => 0 }; # put something there as second operand | ||||||
4710 | } | ||||||
4711 | $value1 = | ||||||
4712 | 83 | 317 | operands_as_coord_on_sheet($sheetdata, \@operand, \$tostype, | ||||
4713 | \$errortext); # get coord even if name on other sheet | ||||||
4714 | 83 | 648 | push @operand, | ||||
4715 | { type => $tostype, value => | ||||||
4716 | $value1 }; # push sheetname with coord or range on that sheet | ||||||
4717 | } | ||||||
4718 | |||||||
4719 | # Comparison operators: < L = G > N (< <= = >= > <>) | ||||||
4720 | |||||||
4721 | elsif ($ttext =~ m/[ |
||||||
4722 | 2718 | 50 | 7104 | if (@operand == 1) { # Need at least two things on the stack... | |||
4723 | 0 | 0 | $errortext = "Missing operand. "; # remember error | ||||
4724 | 0 | 0 | push @operand, { type => "n", | ||||
4725 | value => 0 }; # put something there as second operand | ||||||
4726 | } | ||||||
4727 | $value2 = | ||||||
4728 | 2718 | 7859 | operand_value_and_type($sheetdata, \@operand, \$errortext, | ||||
4729 | \$tostype2); | ||||||
4730 | 2718 | 7526 | $value1 = | ||||
4731 | operand_value_and_type($sheetdata, \@operand, \$errortext, | ||||||
4732 | \$tostype); | ||||||
4733 | 2718 | 100 | 100 | 18006 | if (substr($tostype, 0, 1) eq "n" && substr($tostype2, 0, 1) eq "n") | ||
100 | |||||||
50 | |||||||
4734 | { # compare two numbers | ||||||
4735 | 2346 | 3164 | my $cond = 0; | ||||
4736 | 2346 | 50 | 10722 | if ($ttext eq "<") { $cond = $value1 < $value2 ? 1 : 0; } | |||
102 | 100 | 411 | |||||
100 | |||||||
100 | |||||||
100 | |||||||
100 | |||||||
50 | |||||||
4737 | 25 | 50 | 85 | elsif ($ttext eq "L") { $cond = $value1 <= $value2 ? 1 : 0; } | |||
4738 | 1987 | 100 | 4493 | elsif ($ttext eq "=") { $cond = $value1 == $value2 ? 1 : 0; } | |||
4739 | 23 | 50 | 62 | elsif ($ttext eq "G") { $cond = $value1 >= $value2 ? 1 : 0; } | |||
4740 | 148 | 100 | 514 | elsif ($ttext eq ">") { $cond = $value1 > $value2 ? 1 : 0; } | |||
4741 | 61 | 100 | 182 | elsif ($ttext eq "N") { $cond = $value1 != $value2 ? 1 : 0; } | |||
4742 | 2346 | 12252 | push @operand, { type => "nl", value => $cond }; | ||||
4743 | } elsif (substr($tostype, 0, 1) eq "e") { # error on left | ||||||
4744 | 146 | 859 | push @operand, { type => $tostype, value => 0 }; | ||||
4745 | } elsif (substr($tostype2, 0, 1) eq "e") { # error on right | ||||||
4746 | 0 | 0 | push @operand, { type => $tostype2, value => 0 }; | ||||
4747 | } else { # text maybe mixed with numbers or blank | ||||||
4748 | 226 | 100 | 625 | if (substr($tostype, 0, 1) eq "n") { | |||
4749 | 29 | 124 | $value1 = format_number_for_display($value1, "n", ""); | ||||
4750 | } | ||||||
4751 | 226 | 100 | 566 | if (substr($tostype2, 0, 1) eq "n") { | |||
4752 | 34 | 139 | $value2 = format_number_for_display($value2, "n", ""); | ||||
4753 | } | ||||||
4754 | 226 | 293 | my $cond = 0; | ||||
4755 | 226 | 329 | my $value1u8 = $value1; | ||||
4756 | 226 | 285 | my $value2u8 = $value2; | ||||
4757 | 226 | 782 | utf8::decode($value1u8); # handle UTF-8 | ||||
4758 | 226 | 394 | utf8::decode($value2u8); | ||||
4759 | 226 | 364 | $value1u8 = lc $value1u8; # ignore case | ||||
4760 | 226 | 5964 | $value2u8 = lc $value2u8; | ||||
4761 | 226 | 50 | 1049 | if ($ttext eq "<") { $cond = $value1u8 lt $value2u8 ? 1 : 0; } | |||
43 | 100 | 170 | |||||
50 | |||||||
100 | |||||||
50 | |||||||
100 | |||||||
50 | |||||||
4762 | 0 | 0 | 0 | elsif ($ttext eq "L") { $cond = $value1u8 le $value2u8 ? 1 : 0; } | |||
4763 | 106 | 100 | 211 | elsif ($ttext eq "=") { $cond = $value1u8 eq $value2u8 ? 1 : 0; } | |||
4764 | 0 | 0 | 0 | elsif ($ttext eq "G") { $cond = $value1u8 ge $value2u8 ? 1 : 0; } | |||
4765 | 20 | 50 | 59 | elsif ($ttext eq ">") { $cond = $value1u8 gt $value2u8 ? 1 : 0; } | |||
4766 | 57 | 50 | 148 | elsif ($ttext eq "N") { $cond = $value1u8 ne $value2u8 ? 1 : 0; } | |||
4767 | 226 | 1167 | push @operand, { type => "nl", value => $cond }; | ||||
4768 | } | ||||||
4769 | } | ||||||
4770 | |||||||
4771 | # Normal infix arithmethic operators: +, -. *, /, ^ | ||||||
4772 | |||||||
4773 | else { # what's left are the normal infix arithmetic operators | ||||||
4774 | 15661 | 100 | 32997 | if (@operand == 1) { # Need at least two things on the stack... | |||
4775 | 231 | 601 | $errortext = "Missing operand. "; # remember error | ||||
4776 | 231 | 771 | push @operand, { type => "n", | ||||
4777 | value => 0 }; # put something there as second operand | ||||||
4778 | } | ||||||
4779 | $value2 = | ||||||
4780 | 15661 | 39148 | operand_as_number($sheetdata, \@operand, \$errortext, \$tostype2); | ||||
4781 | 15661 | 38845 | $value1 = | ||||
4782 | operand_as_number($sheetdata, \@operand, \$errortext, \$tostype); | ||||||
4783 | 15661 | 100 | 55095 | if ($ttext eq '+') { | |||
100 | |||||||
100 | |||||||
100 | |||||||
50 | |||||||
4784 | 2397 | 6149 | $resulttype = | ||||
4785 | lookup_result_type($tostype, $tostype2, $typelookup{plus}); | ||||||
4786 | 2397 | 13551 | push @operand, { type => $resulttype, value => $value1 + $value2 }; | ||||
4787 | } elsif ($ttext eq '-') { | ||||||
4788 | 760 | 2483 | $resulttype = | ||||
4789 | lookup_result_type($tostype, $tostype2, $typelookup{plus}); | ||||||
4790 | 760 | 4537 | push @operand, { type => $resulttype, value => $value1 - $value2 }; | ||||
4791 | } elsif ($ttext eq '*') { | ||||||
4792 | 8831 | 23436 | $resulttype = | ||||
4793 | lookup_result_type($tostype, $tostype2, $typelookup{plus}); | ||||||
4794 | 8831 | 47963 | push @operand, { type => $resulttype, value => $value1 * $value2 }; | ||||
4795 | } elsif ($ttext eq '/') { | ||||||
4796 | 2961 | 100 | 6397 | if ($value2 != 0) { | |||
4797 | 2044 | 11872 | push @operand, { type => "n", | ||||
4798 | value => $value1 / $value2 }; # gives plain numeric result type | ||||||
4799 | } else { | ||||||
4800 | 917 | 4563 | push @operand, { type => "e#DIV/0!", value => 0 }; | ||||
4801 | } | ||||||
4802 | } elsif ($ttext eq '^') { | ||||||
4803 | 712 | 4219 | push @operand, { type => "n", | ||||
4804 | value => $value1**$value2 }; # gives plain numeric result type | ||||||
4805 | } | ||||||
4806 | } | ||||||
4807 | } | ||||||
4808 | |||||||
4809 | # function or name | ||||||
4810 | |||||||
4811 | elsif ($ttype == $token_name) { | ||||||
4812 | |||||||
4813 | # TODO fix cyclic dependency | ||||||
4814 | 18769 | 146744 | require Spreadsheet::Engine::Functions; | ||||
4815 | 18769 | 82602 | Spreadsheet::Engine::Functions::calculate_function($ttext, \@operand, | ||||
4816 | \$errortext, \%typelookup, $sheetdata); | ||||||
4817 | } | ||||||
4818 | |||||||
4819 | else { | ||||||
4820 | 0 | 0 | $errortext = "Unknown token $ttype ($ttext). "; | ||||
4821 | } | ||||||
4822 | } | ||||||
4823 | |||||||
4824 | # look at final value and handle special cases | ||||||
4825 | |||||||
4826 | 33477 | 64751 | my $value = $operand[0]->{value}; | ||||
4827 | 33477 | 34189 | my $valuetype; | ||||
4828 | 33477 | 50 | 83746 | $tostype = $operand[0]->{type} || ''; | |||
4829 | |||||||
4830 | 33477 | 100 | 75365 | if ($tostype eq "name") { # name - expand it | |||
4831 | 1 | 3 | $value = lc $value; | ||||
4832 | 1 | 5 | $value = lookup_name($sheetdata, $value, \$tostype, \$errortext); | ||||
4833 | } | ||||||
4834 | |||||||
4835 | 33477 | 100 | 62214 | if ($tostype eq "coord") | |||
4836 | { # the value is a coord reference, get its value and type | ||||||
4837 | 6975 | 17588 | $value = | ||||
4838 | operand_value_and_type($sheetdata, \@operand, \$errortext, \$tostype); | ||||||
4839 | 6975 | 50 | 17408 | $tostype = "n" if ($tostype eq "b"); | |||
4840 | } | ||||||
4841 | |||||||
4842 | 33477 | 100 | 65888 | if (scalar @operand > 1) { # something left - error | |||
4843 | 34 | 91 | $errortext .= "Error in formula."; | ||||
4844 | } | ||||||
4845 | |||||||
4846 | # set return type | ||||||
4847 | |||||||
4848 | 33477 | 47996 | $valuetype = $tostype; | ||||
4849 | |||||||
4850 | 33477 | 100 | 122307 | if (substr($tostype, 0, 1) eq "e") { # error value | |||
50 | |||||||
4851 | 1945 | 50 | 11999 | $errortext ||= substr($tostype, 1) || "Error value in formula"; | |||
66 | |||||||
4852 | } elsif ($tostype eq "range") { | ||||||
4853 | 0 | 0 | $value =~ m/^(.*)\|(.*)\|/; | ||||
4854 | 0 | 0 | $value = uc "$1:$2"; | ||||
4855 | 0 | 0 | 0 | if (!$allowrangereturn) { | |||
4856 | 0 | 0 | $errortext = "Formula results in range value: $value."; | ||||
4857 | } | ||||||
4858 | } | ||||||
4859 | |||||||
4860 | 33477 | 100 | 100 | 78604 | if ($errortext && substr($valuetype, 0, 1) ne "e") { | ||
4861 | 299 | 452 | $value = $errortext; | ||||
4862 | 299 | 414 | $valuetype = "e"; | ||||
4863 | } | ||||||
4864 | |||||||
4865 | # look for overflow | ||||||
4866 | |||||||
4867 | 33477 | 50 | 66 | 199618 | if (substr($tostype, 0, 1) eq "n" && defined $value && $value =~ m/1\.#INF/) | ||
66 | |||||||
4868 | { | ||||||
4869 | 0 | 0 | $value = 0; | ||||
4870 | 0 | 0 | $valuetype = "e#NUM!"; | ||||
4871 | 0 | 0 | $errortext = "Numeric overflow"; | ||||
4872 | } | ||||||
4873 | 33477 | 177975 | return ($value, $valuetype, $errortext); | ||||
4874 | } | ||||||
4875 | |||||||
4876 | =head2 operand_as_coord | ||||||
4877 | |||||||
4878 | $value = operand_as_coord(\%sheetdata, \@operand, \$errortext) | ||||||
4879 | |||||||
4880 | Gets top of stack and pops it. Returns coord value. All others are | ||||||
4881 | treated as an error. | ||||||
4882 | |||||||
4883 | =cut | ||||||
4884 | |||||||
4885 | sub operand_as_coord { | ||||||
4886 | |||||||
4887 | 1283 | 1283 | 1 | 2082 | my ($sheetdata, $operand, $errortext) = @_; | ||
4888 | |||||||
4889 | 1283 | 3811 | my $stacklen = scalar @$operand; | ||||
4890 | 1283 | 2951 | my $value = $operand->[ $stacklen - 1 ]->{value}; # get top of stack | ||||
4891 | 1283 | 2426 | my $tostype = $operand->[ $stacklen - 1 ]->{type}; | ||||
4892 | 1283 | 1678 | pop @$operand; # we have data - pop stack | ||||
4893 | |||||||
4894 | 1283 | 50 | 4049 | if ($tostype eq "name") { | |||
4895 | 0 | 0 | $value = uc $value; | ||||
4896 | 0 | 0 | $value = lookup_name($sheetdata, $value, \$tostype, $errortext); | ||||
4897 | } | ||||||
4898 | |||||||
4899 | 1283 | 100 | 2773 | if ($tostype eq "coord") { # value is a coord reference | |||
4900 | 1234 | 4339 | return $value; | ||||
4901 | } else { | ||||||
4902 | 49 | 106 | $$errortext = "Cell reference missing when expected."; | ||||
4903 | 49 | 128 | return 0; | ||||
4904 | } | ||||||
4905 | } | ||||||
4906 | |||||||
4907 | =head2 operands_as_coord_on_sheet | ||||||
4908 | |||||||
4909 | $value = operands_as_coord_on_sheet(\%sheetdata, \@operand, \$returntype, \$errortext) | ||||||
4910 | |||||||
4911 | Gets 2 at top of stack and pops them, treating them as sheetname!coord-or-name. | ||||||
4912 | Returns stack-style coord value (coord!sheetname, or coord!sheetname|coord|) and | ||||||
4913 | sets $returntype to coord or range. All others are treated as an error. | ||||||
4914 | |||||||
4915 | =cut | ||||||
4916 | |||||||
4917 | sub operands_as_coord_on_sheet { | ||||||
4918 | |||||||
4919 | 83 | 83 | 1 | 152 | my ($sheetdata, $operand, $returntype, $errortext) = @_; | ||
4920 | |||||||
4921 | 83 | 167 | my $stacklen = scalar @$operand; | ||||
4922 | 83 | 209 | my $value = | ||||
4923 | $operand->[ $stacklen - 1 ]->{value}; # get top of stack - coord or name | ||||||
4924 | 83 | 176 | my $tostype = $operand->[ $stacklen - 1 ]->{type}; | ||||
4925 | 83 | 124 | pop @$operand; # we have data - pop stack | ||||
4926 | |||||||
4927 | 83 | 309 | my $sheetname = | ||||
4928 | operand_as_sheetname($sheetdata, $operand, $errortext) | ||||||
4929 | ; # get sheetname as text | ||||||
4930 | 83 | 305 | my $othersheetdata = find_in_sheet_cache($sheetdata, $sheetname); | ||||
4931 | 83 | 50 | 227 | if ($othersheetdata->{loaderror}) { # this sheet is unavailable | |||
4932 | 83 | 121 | $$errortext = "Cell reference missing when expected."; | ||||
4933 | 83 | 125 | $$returntype = "e#REF!"; | ||||
4934 | 83 | 569 | return ""; | ||||
4935 | } | ||||||
4936 | |||||||
4937 | 0 | 0 | 0 | if ($tostype eq "name") { | |||
4938 | 0 | 0 | $value = uc $value; | ||||
4939 | 0 | 0 | $value = lookup_name($othersheetdata, $value, \$tostype, $errortext); | ||||
4940 | } | ||||||
4941 | 0 | 0 | $$returntype = $tostype; | ||||
4942 | 0 | 0 | 0 | if ($tostype eq "coord") { # value is a coord reference | |||
0 | |||||||
4943 | 0 | 0 | return "$value!$sheetname"; # return in the format as used on stack | ||||
4944 | } elsif ($tostype eq "range") { # value is a range reference | ||||||
4945 | 0 | 0 | my ($c1, $c2, $c3) = split (/\|/, $value, 3); | ||||
4946 | 0 | 0 | return "$c1!$sheetname|$c2|"; | ||||
4947 | } else { | ||||||
4948 | 0 | 0 | $$errortext = "Cell reference missing when expected."; | ||||
4949 | 0 | 0 | $$returntype = "e#REF!"; | ||||
4950 | 0 | 0 | return ""; | ||||
4951 | } | ||||||
4952 | } | ||||||
4953 | |||||||
4954 | =head2 operands_as_range_on_sheet | ||||||
4955 | |||||||
4956 | $value = operands_as_range_on_sheet(\%sheetdata, \@operand, \$returntype, \$errortext) | ||||||
4957 | |||||||
4958 | Gets 2 at top of stack and pops them, treating them as | ||||||
4959 | coord2-or-name:coord1. Name is evaluated on sheet of coord1. | ||||||
4960 | Returns stack-style range value (coord!sheetname|coord|) and sets | ||||||
4961 | $returntype to range. All others are treated as an error. | ||||||
4962 | |||||||
4963 | =cut | ||||||
4964 | |||||||
4965 | sub operands_as_range_on_sheet { | ||||||
4966 | |||||||
4967 | 1283 | 1283 | 1 | 2418 | my ($sheetdata, $operand, $returntype, $errortext) = @_; | ||
4968 | |||||||
4969 | 1283 | 1992 | my $stacklen = scalar @$operand; | ||||
4970 | 1283 | 3111 | my $value2 = | ||||
4971 | $operand->[ $stacklen - 1 ] | ||||||
4972 | ->{value}; # get top of stack - coord or name for "right" side | ||||||
4973 | 1283 | 2327 | my $tostype = $operand->[ $stacklen - 1 ]->{type}; | ||||
4974 | 1283 | 1813 | pop @$operand; # we have data - pop stack | ||||
4975 | |||||||
4976 | 1283 | 4790 | my $value1 = | ||||
4977 | operand_as_coord($sheetdata, $operand, $errortext); # get "left" coord | ||||||
4978 | 1283 | 100 | 3285 | if (!$value1) { # not a coord, which it must be | |||
4979 | 49 | 76 | $$returntype = "e#REF!"; | ||||
4980 | 49 | 125 | return ""; | ||||
4981 | } | ||||||
4982 | |||||||
4983 | 1234 | 2246 | my $othersheetdata = $sheetdata; | ||||
4984 | |||||||
4985 | 1234 | 50 | 3884 | if ($value1 =~ m/^.*!([^\|]+)$/) { # | |||
4986 | 0 | 0 | $othersheetdata = find_in_sheet_cache($sheetdata, $1); | ||||
4987 | 0 | 0 | 0 | if ($othersheetdata->{loaderror}) { # this sheet is unavailable | |||
4988 | 0 | 0 | $$errortext = "Cell reference missing when expected."; | ||||
4989 | 0 | 0 | $$returntype = "e#REF!"; | ||||
4990 | 0 | 0 | return ""; | ||||
4991 | } | ||||||
4992 | } | ||||||
4993 | |||||||
4994 | 1234 | 50 | 2964 | if ($tostype eq "name") { # coord:name is allowed, if name is just one cell | |||
4995 | 0 | 0 | $value2 = uc $value2; | ||||
4996 | 0 | 0 | $value2 = lookup_name($othersheetdata, $value2, \$tostype, $errortext); | ||||
4997 | } | ||||||
4998 | 1234 | 100 | 2720 | if ($tostype eq "coord") | |||
4999 | { # value is a coord reference, so return the combined range | ||||||
5000 | 1223 | 1955 | $$returntype = "range"; | ||||
5001 | 1223 | 4292 | return "$value1|$value2|"; # return in the format as used on stack | ||||
5002 | } else { # bad form | ||||||
5003 | 11 | 20 | $$errortext = "Cell reference missing when expected."; | ||||
5004 | 11 | 19 | $$returntype = "e#REF!"; | ||||
5005 | 11 | 27 | return ""; | ||||
5006 | } | ||||||
5007 | } | ||||||
5008 | |||||||
5009 | =head2 operand_as_sheetname | ||||||
5010 | |||||||
5011 | $value = operand_as_sheetname(\%sheetdata, \@operand, \$errortext) | ||||||
5012 | |||||||
5013 | Gets top of stack and pops it. | ||||||
5014 | Returns sheetname value. All others are treated as an error. | ||||||
5015 | Accepts text, cell reference, and named value which is one of those two. | ||||||
5016 | |||||||
5017 | =cut | ||||||
5018 | |||||||
5019 | sub operand_as_sheetname { | ||||||
5020 | |||||||
5021 | 83 | 83 | 1 | 130 | my ($sheetdata, $operand, $errortext) = @_; | ||
5022 | |||||||
5023 | 83 | 145 | my $stacklen = scalar @$operand; | ||||
5024 | 83 | 180 | my $value = $operand->[ $stacklen - 1 ]->{value}; # get top of stack | ||||
5025 | 83 | 157 | my $tostype = $operand->[ $stacklen - 1 ]->{type}; | ||||
5026 | 83 | 105 | pop @$operand; # we have data - pop stack | ||||
5027 | 83 | 100 | 252 | if ($tostype eq "name") { # either a named cell or a sheet name bare | |||
5028 | 17 | 30 | my $ignoreerror; | ||||
5029 | 17 | 46 | my $lookupname = | ||||
5030 | lookup_name($sheetdata, $value, \$tostype, \$ignoreerror); | ||||||
5031 | 17 | 50 | 45 | if (!$lookupname) | |||
5032 | { # not a known name - return bare name as the name value | ||||||
5033 | 17 | 55 | return $value; | ||||
5034 | } | ||||||
5035 | 0 | 0 | $value = $lookupname; # try this value and type | ||||
5036 | } | ||||||
5037 | 66 | 100 | 231 | if ($tostype eq "coord") | |||
5038 | { # value is a coord reference, follow it to find sheet name | ||||||
5039 | 21 | 262 | my $cellvtype = | ||||
5040 | $sheetdata->{valuetypes} | ||||||
5041 | ->{$value}; # get type of value in the cell it points to | ||||||
5042 | 21 | 66 | $value = $sheetdata->{datavalues}->{$value}; | ||||
5043 | 21 | 50 | 60 | $tostype = $cellvtype || "b"; | |||
5044 | } | ||||||
5045 | 66 | 50 | 220 | if (substr($tostype, 0, 1) eq "t") | |||
5046 | { # value is a string which could be a sheet name | ||||||
5047 | 0 | 0 | return $value; | ||||
5048 | } else { | ||||||
5049 | 66 | 118 | $$errortext = "Sheet name missing when expected."; | ||||
5050 | 66 | 192 | return ""; | ||||
5051 | } | ||||||
5052 | } | ||||||
5053 | |||||||
5054 | =head2 lookup_name | ||||||
5055 | |||||||
5056 | $value = lookup_name(\%sheetdata, $name, \$valuetype, \$errortext) | ||||||
5057 | |||||||
5058 | Returns value and type of a named value. | ||||||
5059 | Names are case insensitive. | ||||||
5060 | Names may have a definition which is a coord (A1), a range (A1:B7), or a formula (=OFFSET(A1,0,0,5,1)) | ||||||
5061 | |||||||
5062 | =cut | ||||||
5063 | |||||||
5064 | sub lookup_name { | ||||||
5065 | |||||||
5066 | 19127 | 19127 | 1 | 32462 | my ($sheetdata, $name, $valuetype, $errortext) = @_; | ||
5067 | |||||||
5068 | 19127 | 38579 | my $names = $sheetdata->{names}; | ||||
5069 | |||||||
5070 | 19127 | 100 | 44608 | if (defined $names->{ uc $name }) { # is name defined? | |||
5071 | |||||||
5072 | 399 | 872 | my $value = $names->{ uc $name }->{definition}; # yes | ||||
5073 | |||||||
5074 | 399 | 50 | 1090 | if (substr($value, 0, 1) eq "=") { # formula | |||
5075 | 0 | 0 | my $startedwalk; | ||||
5076 | 0 | 0 | 0 | if (!$sheetdata->{checknamecirc}) | |||
5077 | { # are we possibly walking the name tree? | ||||||
5078 | 0 | 0 | $sheetdata->{checknamecirc} = {}; # not yet | ||||
5079 | 0 | 0 | $startedwalk = 1; # remember we started it | ||||
5080 | } else { | ||||||
5081 | 0 | 0 | 0 | if ($sheetdata->{checknamecirc}->{$name}) { # circular reference | |||
5082 | 0 | 0 | $$valuetype = "e#NAME?"; | ||||
5083 | 0 | 0 | $$errortext = qq!Circular name reference to name "$name".!; | ||||
5084 | 0 | 0 | return ""; | ||||
5085 | } | ||||||
5086 | } | ||||||
5087 | 0 | 0 | $sheetdata->{checknamecirc}->{$name} = 1; | ||||
5088 | |||||||
5089 | 0 | 0 | my $parseinfo = parse_formula_into_tokens(substr($value, 1)); | ||||
5090 | 0 | 0 | ($value, $$valuetype, $$errortext) = | ||||
5091 | evaluate_parsed_formula($parseinfo, $sheetdata, 1) | ||||||
5092 | ; # parse formula, allowing range return | ||||||
5093 | |||||||
5094 | 0 | 0 | delete $sheetdata->{checknamecirc}->{$name}; # done with us | ||||
5095 | 0 | 0 | 0 | delete $sheetdata->{checknamecirc} if $startedwalk; # done with walk | |||
5096 | |||||||
5097 | 0 | 0 | 0 | if ($$valuetype ne "range") { | |||
5098 | 0 | 0 | return $value; | ||||
5099 | } | ||||||
5100 | } | ||||||
5101 | |||||||
5102 | 399 | 100 | 1911 | if ($value =~ m/^(.*)\:(.*)$/) { # range | |||
5103 | 396 | 548 | $$valuetype = "range"; | ||||
5104 | 396 | 1444 | $value = uc "$1|$2|"; | ||||
5105 | } else { | ||||||
5106 | 3 | 5 | $$valuetype = "coord"; | ||||
5107 | 3 | 4 | $value = uc $value; | ||||
5108 | } | ||||||
5109 | 399 | 971 | return $value; | ||||
5110 | } else { | ||||||
5111 | 18728 | 25866 | $$valuetype = "e#NAME?"; | ||||
5112 | 18728 | 35276 | $$errortext = qq!Unknown name "$name".!; | ||||
5113 | 18728 | 42882 | return ""; | ||||
5114 | } | ||||||
5115 | } | ||||||
5116 | |||||||
5117 | =head2 step_through_range_up | ||||||
5118 | |||||||
5119 | $value = step_through_range_up(\@operand, $rangevalue, \$operandtype) | ||||||
5120 | |||||||
5121 | Returns next coord in a range, keeping track on the operand stack. | ||||||
5122 | Goes from bottom right across and up to upper left. | ||||||
5123 | |||||||
5124 | =cut | ||||||
5125 | |||||||
5126 | sub step_through_range_up { | ||||||
5127 | |||||||
5128 | 0 | 0 | 1 | 0 | my ($operand, $value, $operandtype) = @_; | ||
5129 | |||||||
5130 | 0 | 0 | my ($value1, $value2, $sequence) = split (/\|/, $value); | ||||
5131 | 0 | 0 | my ($sheet1, $sheet2); | ||||
5132 | 0 | 0 | ($value1, $sheet1) = split (/!/, $value1); | ||||
5133 | 0 | 0 | 0 | $sheet1 = "!$sheet1" if $sheet1; | |||
5134 | 0 | 0 | ($value2, $sheet2) = split (/!/, $value2); | ||||
5135 | 0 | 0 | my ($c1, $r1) = coord_to_cr($value1); | ||||
5136 | 0 | 0 | my ($c2, $r2) = coord_to_cr($value2); | ||||
5137 | 0 | 0 | 0 | ($c2, $c1) = ($c1, $c2) if ($c1 > $c2); | |||
5138 | 0 | 0 | 0 | ($r2, $r1) = ($r1, $r2) if ($r1 > $r2); | |||
5139 | 0 | 0 | my $count; | ||||
5140 | 0 | 0 | 0 | $sequence = ($r2 - $r1 + 1) * ($c2 - $c1 + 1) - 1 | |||
5141 | if length($sequence) == 0; # start at the end | ||||||
5142 | |||||||
5143 | 0 | 0 | for (my $r = $r1 ; $r <= $r2 ; $r++) { | ||||
5144 | 0 | 0 | for (my $c = $c1 ; $c <= $c2 ; $c++) { | ||||
5145 | 0 | 0 | $count++; | ||||
5146 | 0 | 0 | 0 | if ($count > $sequence) { | |||
5147 | 0 | 0 | $sequence--; | ||||
5148 | 0 | 0 | 0 | push @$operand, | |||
5149 | { type => "range", value => "$value1$sheet1|$value2|$sequence" } | ||||||
5150 | unless $sequence < 0; | ||||||
5151 | 0 | 0 | $$operandtype = "coord"; | ||||
5152 | 0 | 0 | return cr_to_coord($c, $r) . $sheet1; | ||||
5153 | } | ||||||
5154 | } | ||||||
5155 | } | ||||||
5156 | } | ||||||
5157 | |||||||
5158 | =head2 step_through_range_down | ||||||
5159 | |||||||
5160 | $value = step_through_range_down(\@operand, $rangevalue, \$operandtype) | ||||||
5161 | |||||||
5162 | Returns next coord in a range, keeping track on the operand stack. | ||||||
5163 | Goes from upper left across and down to bottom right. | ||||||
5164 | |||||||
5165 | =cut | ||||||
5166 | |||||||
5167 | sub step_through_range_down { | ||||||
5168 | |||||||
5169 | 3165 | 3165 | 1 | 5005 | my ($operand, $value, $operandtype) = @_; | ||
5170 | |||||||
5171 | 3165 | 11729 | my ($v1, $v2, $sequence) = split (/\|/, $value); | ||||
5172 | 3165 | 100 | 8871 | $sequence ||= 0; | |||
5173 | |||||||
5174 | 3165 | 6854 | my ($value1, $sheet1) = split (/!/, $v1); | ||||
5175 | 3165 | 33 | 15891 | ($sheet1 &&= "!$sheet1") ||= ''; | |||
50 | |||||||
5176 | 3165 | 6734 | my ($value2, $sheet2) = split (/!/, $v2); | ||||
5177 | |||||||
5178 | 3165 | 7053 | my ($c1, $r1) = coord_to_cr($value1); | ||||
5179 | 3165 | 6584 | my ($c2, $r2) = coord_to_cr($value2); | ||||
5180 | 3165 | 50 | 8706 | ($c2, $c1) = ($c1, $c2) if ($c1 > $c2); | |||
5181 | 3165 | 50 | 12588 | ($r2, $r1) = ($r1, $r2) if ($r1 > $r2); | |||
5182 | |||||||
5183 | 3165 | 3766 | my $count = 0; | ||||
5184 | 3165 | 10138 | for (my $r = $r1 ; $r <= $r2 ; $r++) { | ||||
5185 | 8627 | 18724 | for (my $c = $c1 ; $c <= $c2 ; $c++) { | ||||
5186 | 8627 | 8721 | $count++; | ||||
5187 | 8627 | 100 | 1053847 | if ($count > $sequence) { | |||
5188 | 3165 | 100 | 66 | 18314 | push @$operand, | ||
5189 | { type => "range", value => "$value1$sheet1|$value2|$count" } | ||||||
5190 | unless ($r == $r2 && $c == $c2); | ||||||
5191 | 3165 | 5169 | $$operandtype = "coord"; | ||||
5192 | 3165 | 6670 | return cr_to_coord($c, $r) . $sheet1; | ||||
5193 | } | ||||||
5194 | } | ||||||
5195 | } | ||||||
5196 | } | ||||||
5197 | |||||||
5198 | =head2 col_to_number | ||||||
5199 | |||||||
5200 | $col = col_to_number($colname) | ||||||
5201 | |||||||
5202 | Turns B into 2. The default is 1. | ||||||
5203 | |||||||
5204 | =cut | ||||||
5205 | |||||||
5206 | sub col_to_number { | ||||||
5207 | 0 | 0 | 1 | 0 | my $coord = shift @_; | ||
5208 | 0 | 0 | $coord = lc($coord); | ||||
5209 | 0 | 0 | $coord =~ m/([a-z])([a-z])?/; | ||||
5210 | 0 | 0 | 0 | return 1 unless $1; | |||
5211 | 0 | 0 | my $col = ord($1) - ord('a') + 1; | ||||
5212 | 0 | 0 | 0 | $col = 26 * $col + ord($2) - ord('a') + 1 if $2; | |||
5213 | 0 | 0 | return $col; | ||||
5214 | } | ||||||
5215 | |||||||
5216 | =head2 number_to_col | ||||||
5217 | |||||||
5218 | $coord = number_to_col($col) | ||||||
5219 | |||||||
5220 | Turns 2 into B. The default is 1. | ||||||
5221 | |||||||
5222 | =cut | ||||||
5223 | |||||||
5224 | sub number_to_col { | ||||||
5225 | 0 | 0 | 1 | 0 | my $col = shift @_; | ||
5226 | 0 | 0 | 0 | $col = $col > 1 ? $col : 1; | |||
5227 | 0 | 0 | my $col_high = int(($col - 1) / 26); | ||||
5228 | 0 | 0 | my $col_low = ($col - 1) % 26; | ||||
5229 | 0 | 0 | my $coord = chr(ord('A') + $col_low); | ||||
5230 | 0 | 0 | 0 | $coord = chr(ord('A') + $col_high - 1) . $coord if $col_high; | |||
5231 | 0 | 0 | return $coord; | ||||
5232 | } | ||||||
5233 | |||||||
5234 | =head2 special_chars_markup | ||||||
5235 | |||||||
5236 | my $estring = special_chars_markup($string) | ||||||
5237 | |||||||
5238 | Returns $estring where &, <, >, " are HTML escaped ready for expand markup | ||||||
5239 | |||||||
5240 | =cut | ||||||
5241 | |||||||
5242 | sub special_chars_markup { | ||||||
5243 | 0 | 0 | 1 | 0 | my $string = shift @_; | ||
5244 | 0 | 0 | $string =~ s/&/{{amp}}amp;/g; | ||||
5245 | 0 | 0 | $string =~ s/{{amp}}lt;/g; | ||||
5246 | 0 | 0 | $string =~ s/>/{{amp}}gt;/g; | ||||
5247 | 0 | 0 | $string =~ s/"/{{amp}}quot;/g; | ||||
5248 | 0 | 0 | return $string; | ||||
5249 | } | ||||||
5250 | |||||||
5251 | =head2 url_encode | ||||||
5252 | |||||||
5253 | my $estring = url_encode($string) | ||||||
5254 | |||||||
5255 | Returns $estring with special chars URL encoded. | ||||||
5256 | |||||||
5257 | Based on Mastering Regular Expressions, Jeffrey E. F. Friedl, | ||||||
5258 | additional legal characters added | ||||||
5259 | |||||||
5260 | =cut | ||||||
5261 | |||||||
5262 | sub url_encode { | ||||||
5263 | 0 | 0 | 1 | 0 | my $string = shift @_; | ||
5264 | 0 | 0 | $string =~ s!([^a-zA-Z0-9_\-;/?:@=#.])!sprintf('%%%02X', ord($1))!ge; | ||||
0 | 0 | ||||||
5265 | 0 | 0 | $string =~ | ||||
5266 | s/%26/{{amp}}/gs; # let ampersands in URLs through -- convert to {{amp}} | ||||||
5267 | 0 | 0 | return $string; | ||||
5268 | } | ||||||
5269 | |||||||
5270 | =head2 url_encode_plain | ||||||
5271 | |||||||
5272 | my $estring = url_encode_plain($string) | ||||||
5273 | |||||||
5274 | Returns $estring with special chars URL encoded for sending to others by | ||||||
5275 | HTTP, not publishing. | ||||||
5276 | |||||||
5277 | Based on Mastering Regular Expressions, Jeffrey E. F. Friedl, additional | ||||||
5278 | legal characters added. | ||||||
5279 | |||||||
5280 | =cut | ||||||
5281 | |||||||
5282 | sub url_encode_plain { | ||||||
5283 | 0 | 0 | 1 | 0 | my $string = shift @_; | ||
5284 | 0 | 0 | $string =~ s!([^a-zA-Z0-9_\-/?:@=#.])!sprintf('%%%02X', ord($1))!ge; | ||||
0 | 0 | ||||||
5285 | 0 | 0 | return $string; | ||||
5286 | } | ||||||
5287 | |||||||
5288 | =head2 find_in_sheet_cache | ||||||
5289 | |||||||
5290 | my $othersheet_sheetdata = find_in_sheet_cache(\%sheetdata, $datafilename) | ||||||
5291 | |||||||
5292 | Load additional sheet's information for worksheet references as a sheetdata structure | ||||||
5293 | stored in $sheetdata->{sheetcache}->{sheets}->{$datafilename} if necessary. | ||||||
5294 | Return that structure as \%othersheet_sheetdata | ||||||
5295 | |||||||
5296 | =cut | ||||||
5297 | |||||||
5298 | sub find_in_sheet_cache { | ||||||
5299 | |||||||
5300 | # TODO have a way for applications to specify how this should work | ||||||
5301 | |||||||
5302 | 83 | 83 | 1 | 138 | my ($sheetdata, $datafilename) = @_; | ||
5303 | |||||||
5304 | 83 | 194 | my $sdsc = $sheetdata->{sheetcache}; | ||||
5305 | |||||||
5306 | 83 | 50 | 249 | if ($datafilename !~ m/^http:/i) { # not URL | |||
5307 | 83 | 162 | $datafilename = lc $datafilename; # lower case for consistency | ||||
5308 | } | ||||||
5309 | |||||||
5310 | 83 | 50 | 321 | if ($sdsc->{sheets}->{$datafilename}) { # already in cache | |||
5311 | 0 | 0 | return $sdsc->{sheets}->{$datafilename}; | ||||
5312 | } | ||||||
5313 | |||||||
5314 | 83 | 112 | my (@headerlines, @sheetlines, $loaderror); | ||||
5315 | |||||||
5316 | 83 | 122 | $loaderror = "Cross-sheet references are not yet supported"; | ||||
5317 | |||||||
5318 | # assume local pagename | ||||||
5319 | # my $editpath = get_page_published_datafile_path($sdsc->{params}, $sdsc->{hostinfo}, $sdsc->{sitename}, $datafilename); | ||||||
5320 | # $loaderror = load_page($editpath, \@headerlines, \@sheetlines); | ||||||
5321 | |||||||
5322 | 83 | 232 | $sdsc->{sheets}->{$datafilename} = {}; # start fresh | ||||
5323 | 83 | 333 | my $ok = parse_sheet_save(\@sheetlines, $sdsc->{sheets}->{$datafilename}); | ||||
5324 | |||||||
5325 | 83 | 50 | 372 | $sdsc->{sheets}->{$datafilename}->{loaderror} = $loaderror if $loaderror; | |||
5326 | |||||||
5327 | 83 | 339 | return $sdsc->{sheets}->{$datafilename}; | ||||
5328 | |||||||
5329 | } | ||||||
5330 | |||||||
5331 | 1; | ||||||
5332 | |||||||
5333 | __END__ |