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