| Filename | /home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Spreadsheet/ParseExcel/Utility.pm |
| Statements | Executed 13 statements in 3.20ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 9µs | 10µs | Spreadsheet::ParseExcel::Utility::BEGIN@19 |
| 1 | 1 | 1 | 4µs | 21µs | Spreadsheet::ParseExcel::Utility::BEGIN@23 |
| 1 | 1 | 1 | 3µs | 16µs | Spreadsheet::ParseExcel::Utility::BEGIN@20 |
| 0 | 0 | 0 | 0s | 0s | Spreadsheet::ParseExcel::Utility::AddComma |
| 0 | 0 | 0 | 0s | 0s | Spreadsheet::ParseExcel::Utility::ExcelFmt |
| 0 | 0 | 0 | 0s | 0s | Spreadsheet::ParseExcel::Utility::ExcelLocaltime |
| 0 | 0 | 0 | 0s | 0s | Spreadsheet::ParseExcel::Utility::LeapYear |
| 0 | 0 | 0 | 0s | 0s | Spreadsheet::ParseExcel::Utility::LocaltimeExcel |
| 0 | 0 | 0 | 0s | 0s | Spreadsheet::ParseExcel::Utility::MakeE |
| 0 | 0 | 0 | 0s | 0s | Spreadsheet::ParseExcel::Utility::MakeFraction |
| 0 | 0 | 0 | 0s | 0s | Spreadsheet::ParseExcel::Utility::col2int |
| 0 | 0 | 0 | 0s | 0s | Spreadsheet::ParseExcel::Utility::int2col |
| 0 | 0 | 0 | 0s | 0s | Spreadsheet::ParseExcel::Utility::sheetRef |
| 0 | 0 | 0 | 0s | 0s | Spreadsheet::ParseExcel::Utility::xls2csv |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Spreadsheet::ParseExcel::Utility; | ||||
| 2 | |||||
| 3 | ############################################################################### | ||||
| 4 | # | ||||
| 5 | # Spreadsheet::ParseExcel::Utility - Utility functions for ParseExcel. | ||||
| 6 | # | ||||
| 7 | # Used in conjunction with Spreadsheet::ParseExcel. | ||||
| 8 | # | ||||
| 9 | # Copyright (c) 2014 Douglas Wilson | ||||
| 10 | # Copyright (c) 2009-2013 John McNamara | ||||
| 11 | # Copyright (c) 2006-2008 Gabor Szabo | ||||
| 12 | # Copyright (c) 2000-2006 Kawai Takanori | ||||
| 13 | # | ||||
| 14 | # perltidy with standard settings. | ||||
| 15 | # | ||||
| 16 | # Documentation after __END__ | ||||
| 17 | # | ||||
| 18 | |||||
| 19 | 2 | 16µs | 2 | 11µs | # spent 10µs (9+1) within Spreadsheet::ParseExcel::Utility::BEGIN@19 which was called:
# once (9µs+1µs) by Spreadsheet::ParseExcel::FmtDefault::BEGIN@22 at line 19 # spent 10µs making 1 call to Spreadsheet::ParseExcel::Utility::BEGIN@19
# spent 1µs making 1 call to strict::import |
| 20 | 2 | 17µs | 2 | 28µs | # spent 16µs (3+12) within Spreadsheet::ParseExcel::Utility::BEGIN@20 which was called:
# once (3µs+12µs) by Spreadsheet::ParseExcel::FmtDefault::BEGIN@22 at line 20 # spent 16µs making 1 call to Spreadsheet::ParseExcel::Utility::BEGIN@20
# spent 12µs making 1 call to warnings::import |
| 21 | |||||
| 22 | 1 | 500ns | require Exporter; | ||
| 23 | 2 | 3.15ms | 2 | 38µs | # spent 21µs (4+17) within Spreadsheet::ParseExcel::Utility::BEGIN@23 which was called:
# once (4µs+17µs) by Spreadsheet::ParseExcel::FmtDefault::BEGIN@22 at line 23 # spent 21µs making 1 call to Spreadsheet::ParseExcel::Utility::BEGIN@23
# spent 17µs making 1 call to vars::import |
| 24 | 1 | 5µs | @ISA = qw(Exporter); | ||
| 25 | 1 | 700ns | @EXPORT_OK = qw(ExcelFmt LocaltimeExcel ExcelLocaltime | ||
| 26 | col2int int2col sheetRef xls2csv); | ||||
| 27 | |||||
| 28 | 1 | 200ns | our $VERSION = '0.66'; | ||
| 29 | |||||
| 30 | 1 | 5µs | 1 | 2µs | my $qrNUMBER = qr/(^[+-]?\d+(\.\d+)?$)|(^[+-]?\d+\.?(\d*)[eE][+-](\d+))$/; # spent 2µs making 1 call to CORE::qr |
| 31 | |||||
| 32 | ############################################################################### | ||||
| 33 | # | ||||
| 34 | # ExcelFmt() | ||||
| 35 | # | ||||
| 36 | # This function takes an Excel style number format and converts a number into | ||||
| 37 | # that format. for example: 'hh:mm:ss AM/PM' + 0.01023148 = '12:14:44 AM'. | ||||
| 38 | # | ||||
| 39 | # It does this with a type of templating mechanism. The format string is parsed | ||||
| 40 | # to identify tokens that need to be replaced and their position within the | ||||
| 41 | # string is recorded. These can be thought of as placeholders. The number is | ||||
| 42 | # then converted to the required formats and substituted into the placeholders. | ||||
| 43 | # | ||||
| 44 | # Interested parties should refer to the Excel documentation on cell formats for | ||||
| 45 | # more information: http://office.microsoft.com/en-us/excel/HP051995001033.aspx | ||||
| 46 | # The Microsoft documentation for the Excel Binary File Format, [MS-XLS].pdf, | ||||
| 47 | # also contains a ABNF grammar for number format strings. | ||||
| 48 | # | ||||
| 49 | # Maintainers notes: | ||||
| 50 | # ================== | ||||
| 51 | # | ||||
| 52 | # Note on format subsections: | ||||
| 53 | # A format string can contain 4 possible sub-sections separated by semi-colons: | ||||
| 54 | # Positive numbers, negative numbers, zero values, and text. | ||||
| 55 | # For example: _(* #,##0_);_(* (#,##0);_(* "-"_);_(@_) | ||||
| 56 | # | ||||
| 57 | # Note on conditional formats. | ||||
| 58 | # A number format in Excel can have a conditional expression such as: | ||||
| 59 | # [>9999999](000)000-0000;000-0000 | ||||
| 60 | # This is equivalent to the following in Perl: | ||||
| 61 | # $format = $number > 9999999 ? '(000)000-0000' : '000-0000'; | ||||
| 62 | # Nested conditionals are also possible but we don't support them. | ||||
| 63 | # | ||||
| 64 | # Efficiency: The excessive use of substr() isn't very efficient. However, | ||||
| 65 | # it probably doesn't merit rewriting this function with a parser or regular | ||||
| 66 | # expressions and \G. | ||||
| 67 | # | ||||
| 68 | # TODO: I think the single quote handling may not be required. Check. | ||||
| 69 | # | ||||
| 70 | sub ExcelFmt { | ||||
| 71 | |||||
| 72 | my ( $format_str, $number, $is_1904, $number_type, $want_subformats ) = @_; | ||||
| 73 | |||||
| 74 | # Return text strings without further formatting. | ||||
| 75 | return $number unless $number =~ $qrNUMBER; | ||||
| 76 | |||||
| 77 | # Handle OpenOffice.org GENERAL format. | ||||
| 78 | $format_str = '@' if uc($format_str) eq "GENERAL"; | ||||
| 79 | |||||
| 80 | # Check for a conditional at the start of the format. See notes above. | ||||
| 81 | my $conditional_op; | ||||
| 82 | my $conditional_value; | ||||
| 83 | if ( $format_str =~ /^\[([<>=]+)([^\]]+)\](.*)$/ ) { | ||||
| 84 | $conditional_op = $1; | ||||
| 85 | $conditional_value = $2; | ||||
| 86 | $format_str = $3; | ||||
| 87 | } | ||||
| 88 | |||||
| 89 | # Ignore the underscore token which is used to indicate a padding space. | ||||
| 90 | $format_str =~ s/_/ /g; | ||||
| 91 | |||||
| 92 | # Split the format string into 4 possible sub-sections: positive numbers, | ||||
| 93 | # negative numbers, zero values, and text. See notes above. | ||||
| 94 | my @formats; | ||||
| 95 | my $section = 0; | ||||
| 96 | my $double_quote = 0; | ||||
| 97 | my $single_quote = 0; | ||||
| 98 | |||||
| 99 | # Initial parsing of the format string to remove escape characters. This | ||||
| 100 | # also handles quoted strings. See note about single quotes above. | ||||
| 101 | CHARACTER: | ||||
| 102 | for my $char ( split //, $format_str ) { | ||||
| 103 | |||||
| 104 | if ( $double_quote or $single_quote ) { | ||||
| 105 | $formats[$section] .= $char; | ||||
| 106 | $double_quote = 0 if $char eq '"'; | ||||
| 107 | $single_quote = 0; | ||||
| 108 | next CHARACTER; | ||||
| 109 | } | ||||
| 110 | |||||
| 111 | if ( $char eq ';' ) { | ||||
| 112 | $section++; | ||||
| 113 | next CHARACTER; | ||||
| 114 | } | ||||
| 115 | elsif ( $char eq '"' ) { | ||||
| 116 | $double_quote = 1; | ||||
| 117 | } | ||||
| 118 | elsif ( $char eq '!' ) { | ||||
| 119 | $single_quote = 1; | ||||
| 120 | } | ||||
| 121 | elsif ( $char eq '\\' ) { | ||||
| 122 | $single_quote = 1; | ||||
| 123 | } | ||||
| 124 | elsif ( $char eq '(' ) { | ||||
| 125 | next CHARACTER; # Ignore. | ||||
| 126 | } | ||||
| 127 | elsif ( $char eq ')' ) { | ||||
| 128 | next CHARACTER; # Ignore. | ||||
| 129 | } | ||||
| 130 | |||||
| 131 | # Convert upper case OpenOffice.org date/time formats to lowercase.. | ||||
| 132 | $char = lc($char) if $char =~ /[DMYHS]/; | ||||
| 133 | |||||
| 134 | $formats[$section] .= $char; | ||||
| 135 | } | ||||
| 136 | |||||
| 137 | # Select the appropriate format from the 4 possible sub-sections: | ||||
| 138 | # positive numbers, negative numbers, zero values, and text. | ||||
| 139 | # We ignore the Text section since non-numeric values are returned | ||||
| 140 | # unformatted at the start of the function. | ||||
| 141 | my $format; | ||||
| 142 | $section = 0; | ||||
| 143 | |||||
| 144 | if ( @formats == 1 ) { | ||||
| 145 | $section = 0; | ||||
| 146 | } | ||||
| 147 | elsif ( @formats == 2 ) { | ||||
| 148 | if ( $number < 0 ) { | ||||
| 149 | $section = 1; | ||||
| 150 | } | ||||
| 151 | else { | ||||
| 152 | $section = 0; | ||||
| 153 | } | ||||
| 154 | } | ||||
| 155 | elsif ( @formats == 3 ) { | ||||
| 156 | if ( $number == 0 ) { | ||||
| 157 | $section = 2; | ||||
| 158 | } | ||||
| 159 | elsif ( $number < 0 ) { | ||||
| 160 | $section = 1; | ||||
| 161 | } | ||||
| 162 | else { | ||||
| 163 | $section = 0; | ||||
| 164 | } | ||||
| 165 | } | ||||
| 166 | else { | ||||
| 167 | $section = 0; | ||||
| 168 | } | ||||
| 169 | |||||
| 170 | # Override the previous choice if the format is conditional. | ||||
| 171 | if ($conditional_op) { | ||||
| 172 | if ($conditional_op eq '>') { | ||||
| 173 | $section = $number > $conditional_value ? 0 : 1; | ||||
| 174 | } elsif ($conditional_op eq '>=') { | ||||
| 175 | $section = $number >= $conditional_value ? 0 : 1; | ||||
| 176 | } elsif ($conditional_op eq '<') { | ||||
| 177 | $section = $number < $conditional_value ? 0 : 1; | ||||
| 178 | } elsif ($conditional_op eq '<=') { | ||||
| 179 | $section = $number <= $conditional_value ? 0 : 1; | ||||
| 180 | } elsif ($conditional_op eq '=') { | ||||
| 181 | $section = $number == $conditional_value ? 0 : 1; | ||||
| 182 | } elsif ($conditional_op eq '==') { | ||||
| 183 | $section = $number == $conditional_value ? 0 : 1; | ||||
| 184 | } elsif ($conditional_op eq '<>') { | ||||
| 185 | $section = $number != $conditional_value ? 0 : 1; | ||||
| 186 | } | ||||
| 187 | } | ||||
| 188 | # We now have the required format. | ||||
| 189 | $format = $formats[$section]; | ||||
| 190 | |||||
| 191 | # The format string can contain one of the following colours: | ||||
| 192 | # [Black] [Blue] [Cyan] [Green] [Magenta] [Red] [White] [Yellow] | ||||
| 193 | # or the string [ColorX] where x is a colour index from 1 to 56. | ||||
| 194 | # We don't use the colour but we return it to the caller. | ||||
| 195 | # | ||||
| 196 | my $color = ''; | ||||
| 197 | if ( $format =~ s/^(\[[A-Za-z]{3,}(\d{1,2})?\])// ) { | ||||
| 198 | $color = $1; | ||||
| 199 | } | ||||
| 200 | |||||
| 201 | # Remove the locale, such as [$-409], from the format string. | ||||
| 202 | my $locale = ''; | ||||
| 203 | if ( $format =~ s/^(\[\$?-F?\d+\])// ) { | ||||
| 204 | $locale = $1; | ||||
| 205 | } | ||||
| 206 | |||||
| 207 | # Replace currency locale, such as [$$-409], with $ in the format string. | ||||
| 208 | # See the RT#60547 test cases in 21_number_format_user.t. | ||||
| 209 | if ( $format =~ s/(\[\$([^-]+)(-\d+)?\])/$2/s ) { | ||||
| 210 | $locale = $1; | ||||
| 211 | } | ||||
| 212 | |||||
| 213 | |||||
| 214 | # Remove leading # from '# ?/?', '# ??/??' fraction formats. | ||||
| 215 | $format =~ s{# \?}{?}g; | ||||
| 216 | |||||
| 217 | # Parse the format string and create an AoA of placeholders that contain | ||||
| 218 | # the parts of the string to be replaced. The format of the information | ||||
| 219 | # stored is: [ $token, $start_pos, $end_pos, $option_info ]. | ||||
| 220 | # | ||||
| 221 | my $format_mode = ''; # Either: '', 'number', 'date' | ||||
| 222 | my $pos = 0; # Character position within format string. | ||||
| 223 | my @placeholders = (); # Arefs with parts of the format to be replaced. | ||||
| 224 | my $token = ''; # The actual format extracted from the total str. | ||||
| 225 | my $start_pos; # A position variable. Initial parser position. | ||||
| 226 | my $token_start = -1; # A position variable. | ||||
| 227 | my $decimal_pos = -1; # Position of the punctuation char "." or ",". | ||||
| 228 | my $comma_count = 0; # Count of the commas in the format. | ||||
| 229 | my $is_fraction = 0; # Number format is a fraction. | ||||
| 230 | my $is_currency = 0; # Number format is a currency. | ||||
| 231 | my $is_percent = 0; # Number format is a percentage. | ||||
| 232 | my $is_12_hour = 0; # Time format is using 12 hour clock. | ||||
| 233 | my $seen_dot = 0; # Treat only the first "." as the decimal point. | ||||
| 234 | |||||
| 235 | # Parse the format. | ||||
| 236 | PARSER: | ||||
| 237 | while ( $pos < length $format ) { | ||||
| 238 | $start_pos = $pos; | ||||
| 239 | my $char = substr( $format, $pos, 1 ); | ||||
| 240 | |||||
| 241 | # Ignore control format characters such as '#0+-.?eE,%'. However, | ||||
| 242 | # only ignore '.' if it is the first one encountered. RT 45502. | ||||
| 243 | if ( ( !$seen_dot && $char !~ /[#0\+\-\.\?eE\,\%]/ ) | ||||
| 244 | || $char !~ /[#0\+\-\?eE\,\%]/ ) | ||||
| 245 | { | ||||
| 246 | |||||
| 247 | if ( $token_start != -1 ) { | ||||
| 248 | push @placeholders, | ||||
| 249 | [ | ||||
| 250 | substr( $format, $token_start, $pos - $token_start ), | ||||
| 251 | $decimal_pos, $pos - $token_start | ||||
| 252 | ]; | ||||
| 253 | $token_start = -1; | ||||
| 254 | } | ||||
| 255 | } | ||||
| 256 | |||||
| 257 | # Processing for quoted strings within the format. See notes above. | ||||
| 258 | if ( $char eq '"' ) { | ||||
| 259 | $double_quote = $double_quote ? 0 : 1; | ||||
| 260 | $pos++; | ||||
| 261 | next PARSER; | ||||
| 262 | } | ||||
| 263 | elsif ( $char eq '!' ) { | ||||
| 264 | $single_quote = 1; | ||||
| 265 | $pos++; | ||||
| 266 | next PARSER; | ||||
| 267 | } | ||||
| 268 | elsif ( $char eq '\\' ) { | ||||
| 269 | if ( $single_quote != 1 ) { | ||||
| 270 | $single_quote = 1; | ||||
| 271 | $pos++; | ||||
| 272 | next PARSER; | ||||
| 273 | } | ||||
| 274 | } | ||||
| 275 | |||||
| 276 | if ( ( defined($double_quote) and ($double_quote) ) | ||||
| 277 | or ( defined($single_quote) and ($single_quote) ) | ||||
| 278 | or ( $seen_dot && $char eq '.' ) ) | ||||
| 279 | { | ||||
| 280 | $single_quote = 0; | ||||
| 281 | if ( | ||||
| 282 | ( $format_mode ne 'date' ) | ||||
| 283 | and ( ( substr( $format, $pos, 2 ) eq "\x81\xA2" ) | ||||
| 284 | || ( substr( $format, $pos, 2 ) eq "\x81\xA3" ) | ||||
| 285 | || ( substr( $format, $pos, 2 ) eq "\xA2\xA4" ) | ||||
| 286 | || ( substr( $format, $pos, 2 ) eq "\xA2\xA5" ) ) | ||||
| 287 | ) | ||||
| 288 | { | ||||
| 289 | |||||
| 290 | # The above matches are currency symbols. | ||||
| 291 | push @placeholders, | ||||
| 292 | [ substr( $format, $pos, 2 ), length($token), 2 ]; | ||||
| 293 | $is_currency = 1; | ||||
| 294 | $pos += 2; | ||||
| 295 | } | ||||
| 296 | else { | ||||
| 297 | $pos++; | ||||
| 298 | } | ||||
| 299 | } | ||||
| 300 | elsif ( | ||||
| 301 | ( $char =~ /[#0\+\.\?eE\,\%]/ ) | ||||
| 302 | || ( ( $format_mode ne 'date' ) | ||||
| 303 | and ( ( $char eq '-' ) || ( $char eq '(' ) || ( $char eq ')' ) ) | ||||
| 304 | ) | ||||
| 305 | ) | ||||
| 306 | { | ||||
| 307 | $format_mode = 'number' unless $format_mode; | ||||
| 308 | if ( substr( $format, $pos, 1 ) =~ /[#0]/ ) { | ||||
| 309 | if ( | ||||
| 310 | substr( $format, $pos ) =~ | ||||
| 311 | /^([#0]+[\.]?[0#]*[eE][\+\-][0#]+)/ ) | ||||
| 312 | { | ||||
| 313 | push @placeholders, [ $1, $pos, length($1) ]; | ||||
| 314 | $pos += length($1); | ||||
| 315 | } | ||||
| 316 | else { | ||||
| 317 | if ( $token_start == -1 ) { | ||||
| 318 | $token_start = $pos; | ||||
| 319 | $decimal_pos = length($token); | ||||
| 320 | } | ||||
| 321 | } | ||||
| 322 | } | ||||
| 323 | elsif ( substr( $format, $pos, 1 ) eq '?' ) { | ||||
| 324 | |||||
| 325 | # Look for a fraction format like ?/? or ??/?? | ||||
| 326 | if ( $token_start != -1 ) { | ||||
| 327 | push @placeholders, | ||||
| 328 | [ | ||||
| 329 | substr( | ||||
| 330 | $format, $token_start, $pos - $token_start + 1 | ||||
| 331 | ), | ||||
| 332 | $decimal_pos, | ||||
| 333 | $pos - $token_start + 1 | ||||
| 334 | ]; | ||||
| 335 | } | ||||
| 336 | $token_start = $pos; | ||||
| 337 | |||||
| 338 | # Find the end of the fraction format. | ||||
| 339 | FRACTION: | ||||
| 340 | while ( $pos < length($format) ) { | ||||
| 341 | if ( substr( $format, $pos, 1 ) eq '/' ) { | ||||
| 342 | $is_fraction = 1; | ||||
| 343 | } | ||||
| 344 | elsif ( substr( $format, $pos, 1 ) eq '?' ) { | ||||
| 345 | $pos++; | ||||
| 346 | next FRACTION; | ||||
| 347 | } | ||||
| 348 | else { | ||||
| 349 | if ( $is_fraction | ||||
| 350 | && ( substr( $format, $pos, 1 ) =~ /[0-9]/ ) ) | ||||
| 351 | { | ||||
| 352 | |||||
| 353 | # TODO: Could invert if() logic and remove this. | ||||
| 354 | $pos++; | ||||
| 355 | next FRACTION; | ||||
| 356 | } | ||||
| 357 | else { | ||||
| 358 | last FRACTION; | ||||
| 359 | } | ||||
| 360 | } | ||||
| 361 | $pos++; | ||||
| 362 | } | ||||
| 363 | $pos--; | ||||
| 364 | |||||
| 365 | push @placeholders, | ||||
| 366 | [ | ||||
| 367 | substr( $format, $token_start, $pos - $token_start + 1 ), | ||||
| 368 | length($token), $pos - $token_start + 1 | ||||
| 369 | ]; | ||||
| 370 | $token_start = -1; | ||||
| 371 | } | ||||
| 372 | elsif ( substr( $format, $pos, 3 ) =~ /^[eE][\+\-][0#]$/ ) { | ||||
| 373 | if ( substr( $format, $pos ) =~ /([eE][\+\-][0#]+)/ ) { | ||||
| 374 | push @placeholders, [ $1, $pos, length($1) ]; | ||||
| 375 | $pos += length($1); | ||||
| 376 | } | ||||
| 377 | $token_start = -1; | ||||
| 378 | } | ||||
| 379 | else { | ||||
| 380 | if ( $token_start != -1 ) { | ||||
| 381 | push @placeholders, | ||||
| 382 | [ | ||||
| 383 | substr( $format, $token_start, $pos - $token_start ), | ||||
| 384 | $decimal_pos, $pos - $token_start | ||||
| 385 | ]; | ||||
| 386 | $token_start = -1; | ||||
| 387 | } | ||||
| 388 | if ( substr( $format, $pos, 1 ) =~ /[\+\-]/ ) { | ||||
| 389 | push @placeholders, | ||||
| 390 | [ substr( $format, $pos, 1 ), length($token), 1 ]; | ||||
| 391 | $is_currency = 1; | ||||
| 392 | } | ||||
| 393 | elsif ( substr( $format, $pos, 1 ) eq '.' ) { | ||||
| 394 | push @placeholders, | ||||
| 395 | [ substr( $format, $pos, 1 ), length($token), 1 ]; | ||||
| 396 | $seen_dot = 1; | ||||
| 397 | } | ||||
| 398 | elsif ( substr( $format, $pos, 1 ) eq ',' ) { | ||||
| 399 | $comma_count++; | ||||
| 400 | push @placeholders, | ||||
| 401 | [ substr( $format, $pos, 1 ), length($token), 1 ]; | ||||
| 402 | } | ||||
| 403 | elsif ( substr( $format, $pos, 1 ) eq '%' ) { | ||||
| 404 | $is_percent = 1; | ||||
| 405 | } | ||||
| 406 | elsif (( substr( $format, $pos, 1 ) eq '(' ) | ||||
| 407 | || ( substr( $format, $pos, 1 ) eq ')' ) ) | ||||
| 408 | { | ||||
| 409 | push @placeholders, | ||||
| 410 | [ substr( $format, $pos, 1 ), length($token), 1 ]; | ||||
| 411 | $is_currency = 1; | ||||
| 412 | } | ||||
| 413 | } | ||||
| 414 | $pos++; | ||||
| 415 | } | ||||
| 416 | elsif ( $char =~ /[ymdhsapg]/i ) { | ||||
| 417 | $format_mode = 'date' unless $format_mode; | ||||
| 418 | if ( substr( $format, $pos, 5 ) =~ /am\/pm/i ) { | ||||
| 419 | push @placeholders, [ 'am/pm', length($token), 5 ]; | ||||
| 420 | $is_12_hour = 1; | ||||
| 421 | $pos += 5; | ||||
| 422 | } | ||||
| 423 | elsif ( substr( $format, $pos, 3 ) =~ /a\/p/i ) { | ||||
| 424 | push @placeholders, [ 'a/p', length($token), 3 ]; | ||||
| 425 | $is_12_hour = 1; | ||||
| 426 | $pos += 3; | ||||
| 427 | } | ||||
| 428 | elsif ( substr( $format, $pos, 5 ) eq 'mmmmm' ) { | ||||
| 429 | push @placeholders, [ 'mmmmm', length($token), 5 ]; | ||||
| 430 | $pos += 5; | ||||
| 431 | } | ||||
| 432 | elsif (( substr( $format, $pos, 4 ) eq 'mmmm' ) | ||||
| 433 | || ( substr( $format, $pos, 4 ) eq 'dddd' ) | ||||
| 434 | || ( substr( $format, $pos, 4 ) eq 'yyyy' ) | ||||
| 435 | || ( substr( $format, $pos, 4 ) eq 'ggge' ) ) | ||||
| 436 | { | ||||
| 437 | push @placeholders, | ||||
| 438 | [ substr( $format, $pos, 4 ), length($token), 4 ]; | ||||
| 439 | $pos += 4; | ||||
| 440 | } | ||||
| 441 | elsif (( substr( $format, $pos, 3 ) eq 'ddd' ) | ||||
| 442 | || ( substr( $format, $pos, 3 ) eq 'mmm' ) | ||||
| 443 | || ( substr( $format, $pos, 3 ) eq 'yyy' ) ) | ||||
| 444 | { | ||||
| 445 | push @placeholders, | ||||
| 446 | [ substr( $format, $pos, 3 ), length($token), 3 ]; | ||||
| 447 | $pos += 3; | ||||
| 448 | } | ||||
| 449 | elsif (( substr( $format, $pos, 2 ) eq 'yy' ) | ||||
| 450 | || ( substr( $format, $pos, 2 ) eq 'mm' ) | ||||
| 451 | || ( substr( $format, $pos, 2 ) eq 'dd' ) | ||||
| 452 | || ( substr( $format, $pos, 2 ) eq 'hh' ) | ||||
| 453 | || ( substr( $format, $pos, 2 ) eq 'ss' ) | ||||
| 454 | || ( substr( $format, $pos, 2 ) eq 'ge' ) ) | ||||
| 455 | { | ||||
| 456 | if ( | ||||
| 457 | ( substr( $format, $pos, 2 ) eq 'mm' ) | ||||
| 458 | && (@placeholders) | ||||
| 459 | && ( ( $placeholders[-1]->[0] eq 'h' ) | ||||
| 460 | or ( $placeholders[-1]->[0] eq 'hh' ) ) | ||||
| 461 | ) | ||||
| 462 | { | ||||
| 463 | |||||
| 464 | # For this case 'm' is minutes not months. | ||||
| 465 | push @placeholders, [ 'mm', length($token), 2, 'minutes' ]; | ||||
| 466 | } | ||||
| 467 | else { | ||||
| 468 | push @placeholders, | ||||
| 469 | [ substr( $format, $pos, 2 ), length($token), 2 ]; | ||||
| 470 | } | ||||
| 471 | if ( ( substr( $format, $pos, 2 ) eq 'ss' ) | ||||
| 472 | && ( @placeholders > 1 ) ) | ||||
| 473 | { | ||||
| 474 | if ( ( $placeholders[-2]->[0] eq 'm' ) | ||||
| 475 | || ( $placeholders[-2]->[0] eq 'mm' ) ) | ||||
| 476 | { | ||||
| 477 | |||||
| 478 | # For this case 'm' is minutes not months. | ||||
| 479 | push( @{ $placeholders[-2] }, 'minutes' ); | ||||
| 480 | } | ||||
| 481 | } | ||||
| 482 | $pos += 2; | ||||
| 483 | } | ||||
| 484 | elsif (( substr( $format, $pos, 1 ) eq 'm' ) | ||||
| 485 | || ( substr( $format, $pos, 1 ) eq 'd' ) | ||||
| 486 | || ( substr( $format, $pos, 1 ) eq 'h' ) | ||||
| 487 | || ( substr( $format, $pos, 1 ) eq 's' ) ) | ||||
| 488 | { | ||||
| 489 | if ( | ||||
| 490 | ( substr( $format, $pos, 1 ) eq 'm' ) | ||||
| 491 | && (@placeholders) | ||||
| 492 | && ( ( $placeholders[-1]->[0] eq 'h' ) | ||||
| 493 | or ( $placeholders[-1]->[0] eq 'hh' ) ) | ||||
| 494 | ) | ||||
| 495 | { | ||||
| 496 | |||||
| 497 | # For this case 'm' is minutes not months. | ||||
| 498 | push @placeholders, [ 'm', length($token), 1, 'minutes' ]; | ||||
| 499 | } | ||||
| 500 | else { | ||||
| 501 | push @placeholders, | ||||
| 502 | [ substr( $format, $pos, 1 ), length($token), 1 ]; | ||||
| 503 | } | ||||
| 504 | if ( ( substr( $format, $pos, 1 ) eq 's' ) | ||||
| 505 | && ( @placeholders > 1 ) ) | ||||
| 506 | { | ||||
| 507 | if ( ( $placeholders[-2]->[0] eq 'm' ) | ||||
| 508 | || ( $placeholders[-2]->[0] eq 'mm' ) ) | ||||
| 509 | { | ||||
| 510 | |||||
| 511 | # For this case 'm' is minutes not months. | ||||
| 512 | push( @{ $placeholders[-2] }, 'minutes' ); | ||||
| 513 | } | ||||
| 514 | } | ||||
| 515 | $pos += 1; | ||||
| 516 | } | ||||
| 517 | } | ||||
| 518 | elsif ( ( substr( $format, $pos, 3 ) eq '[h]' ) ) { | ||||
| 519 | $format_mode = 'date' unless $format_mode; | ||||
| 520 | push @placeholders, [ '[h]', length($token), 3 ]; | ||||
| 521 | $pos += 3; | ||||
| 522 | } | ||||
| 523 | elsif ( ( substr( $format, $pos, 4 ) eq '[mm]' ) ) { | ||||
| 524 | $format_mode = 'date' unless $format_mode; | ||||
| 525 | push @placeholders, [ '[mm]', length($token), 4 ]; | ||||
| 526 | $pos += 4; | ||||
| 527 | } | ||||
| 528 | elsif ( $char eq '@' ) { | ||||
| 529 | push @placeholders, [ '@', length($token), 1 ]; | ||||
| 530 | $pos++; | ||||
| 531 | } | ||||
| 532 | elsif ( $char eq '*' ) { | ||||
| 533 | push @placeholders, | ||||
| 534 | [ substr( $format, $pos, 1 ), length($token), 1 ]; | ||||
| 535 | } | ||||
| 536 | else { | ||||
| 537 | $pos++; | ||||
| 538 | } | ||||
| 539 | $pos++ if ( $pos == $start_pos ); #No Format match | ||||
| 540 | $token .= substr( $format, $start_pos, $pos - $start_pos ); | ||||
| 541 | |||||
| 542 | } # End of parsing. | ||||
| 543 | |||||
| 544 | # Copy the located format string to a result string that we will perform | ||||
| 545 | # the substitutions on and return to the user. | ||||
| 546 | my $result = $token; | ||||
| 547 | |||||
| 548 | # Add a placeholder between the decimal/comma and end of the token, if any. | ||||
| 549 | if ( $token_start != -1 ) { | ||||
| 550 | push @placeholders, | ||||
| 551 | [ | ||||
| 552 | substr( $format, $token_start, $pos - $token_start + 1 ), | ||||
| 553 | $decimal_pos, $pos - $token_start + 1 | ||||
| 554 | ]; | ||||
| 555 | } | ||||
| 556 | |||||
| 557 | # | ||||
| 558 | # In the next sections we process date, number and text formats. We take a | ||||
| 559 | # format such as yyyy/mm/dd and replace it with something like 2008/12/25. | ||||
| 560 | # | ||||
| 561 | if ( ( $format_mode eq 'date' ) && ( $number =~ $qrNUMBER ) ) { | ||||
| 562 | |||||
| 563 | # The maximum allowable date in Excel is 9999-12-31T23:59:59.000 which | ||||
| 564 | # equates to 2958465.999+ in the 1900 epoch and 2957003.999+ in the | ||||
| 565 | # 1904 epoch. We use 0 as the minimum in both epochs. The 1904 system | ||||
| 566 | # actually supports negative numbers but that isn't worth the effort. | ||||
| 567 | my $min_date = 0; | ||||
| 568 | my $max_date = 2958466; | ||||
| 569 | $max_date = 2957004 if $is_1904; | ||||
| 570 | |||||
| 571 | if ( $number < $min_date || $number >= $max_date ) { | ||||
| 572 | return $number; # Return unformatted number. | ||||
| 573 | } | ||||
| 574 | |||||
| 575 | # Process date formats. | ||||
| 576 | my @time = ExcelLocaltime( $number, $is_1904 ); | ||||
| 577 | |||||
| 578 | # 0 1 2 3 4 5 6 7 | ||||
| 579 | my ( $sec, $min, $hour, $day, $month, $year, $wday, $msec ) = @time; | ||||
| 580 | |||||
| 581 | $month++; # localtime() zero indexed month. | ||||
| 582 | $year += 1900; # localtime() year. | ||||
| 583 | |||||
| 584 | my @full_month_name = qw( | ||||
| 585 | None January February March April May June July | ||||
| 586 | August September October November December | ||||
| 587 | ); | ||||
| 588 | my @short_month_name = qw( | ||||
| 589 | None Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec | ||||
| 590 | ); | ||||
| 591 | my @full_day_name = qw( | ||||
| 592 | Sunday Monday Tuesday Wednesday Thursday Friday Saturday | ||||
| 593 | ); | ||||
| 594 | my @short_day_name = qw( | ||||
| 595 | Sun Mon Tue Wed Thu Fri Sat | ||||
| 596 | ); | ||||
| 597 | |||||
| 598 | # Replace the placeholders in the template such as yyyy mm dd with | ||||
| 599 | # actual numbers or strings. | ||||
| 600 | my $replacement; | ||||
| 601 | for my $placeholder ( reverse @placeholders ) { | ||||
| 602 | |||||
| 603 | if ( $placeholder->[-1] eq 'minutes' ) { | ||||
| 604 | |||||
| 605 | # For this case 'm/mm' is minutes not months. | ||||
| 606 | if ( $placeholder->[0] eq 'mm' ) { | ||||
| 607 | $replacement = sprintf( "%02d", $min ); | ||||
| 608 | } | ||||
| 609 | else { | ||||
| 610 | $replacement = sprintf( "%d", $min ); | ||||
| 611 | } | ||||
| 612 | } | ||||
| 613 | elsif ( $placeholder->[0] eq 'yyyy' ) { | ||||
| 614 | |||||
| 615 | # 4 digit Year. 2000 -> 2000. | ||||
| 616 | $replacement = sprintf( '%04d', $year ); | ||||
| 617 | } | ||||
| 618 | elsif ( $placeholder->[0] eq 'yy' ) { | ||||
| 619 | |||||
| 620 | # 2 digit Year. 2000 -> 00. | ||||
| 621 | $replacement = sprintf( '%02d', $year % 100 ); | ||||
| 622 | } | ||||
| 623 | elsif ( $placeholder->[0] eq 'mmmmm' ) { | ||||
| 624 | |||||
| 625 | # First character of the month name. 1 -> J. | ||||
| 626 | $replacement = substr( $short_month_name[$month], 0, 1 ); | ||||
| 627 | } | ||||
| 628 | elsif ( $placeholder->[0] eq 'mmmm' ) { | ||||
| 629 | |||||
| 630 | # Full month name. 1 -> January. | ||||
| 631 | $replacement = $full_month_name[$month]; | ||||
| 632 | } | ||||
| 633 | elsif ( $placeholder->[0] eq 'mmm' ) { | ||||
| 634 | |||||
| 635 | # Short month name. 1 -> Jan. | ||||
| 636 | $replacement = $short_month_name[$month]; | ||||
| 637 | } | ||||
| 638 | elsif ( $placeholder->[0] eq 'mm' ) { | ||||
| 639 | |||||
| 640 | # 2 digit month. 1 -> 01. | ||||
| 641 | $replacement = sprintf( '%02d', $month ); | ||||
| 642 | } | ||||
| 643 | elsif ( $placeholder->[0] eq 'm' ) { | ||||
| 644 | |||||
| 645 | # 1 digit month. 1 -> 1. | ||||
| 646 | $replacement = sprintf( '%d', $month ); | ||||
| 647 | } | ||||
| 648 | elsif ( $placeholder->[0] eq 'dddd' ) { | ||||
| 649 | |||||
| 650 | # Full day name. Wednesday (for example.) | ||||
| 651 | $replacement = $full_day_name[$wday]; | ||||
| 652 | } | ||||
| 653 | elsif ( $placeholder->[0] eq 'ddd' ) { | ||||
| 654 | |||||
| 655 | # Short day name. Wed (for example.) | ||||
| 656 | $replacement = $short_day_name[$wday]; | ||||
| 657 | } | ||||
| 658 | elsif ( $placeholder->[0] eq 'dd' ) { | ||||
| 659 | |||||
| 660 | # 2 digit day. 1 -> 01. | ||||
| 661 | $replacement = sprintf( '%02d', $day ); | ||||
| 662 | } | ||||
| 663 | elsif ( $placeholder->[0] eq 'd' ) { | ||||
| 664 | |||||
| 665 | # 1 digit day. 1 -> 1. | ||||
| 666 | $replacement = sprintf( '%d', $day ); | ||||
| 667 | } | ||||
| 668 | elsif ( $placeholder->[0] eq 'hh' ) { | ||||
| 669 | |||||
| 670 | # 2 digit hour. | ||||
| 671 | if ($is_12_hour) { | ||||
| 672 | my $hour_tmp = $hour % 12; | ||||
| 673 | $hour_tmp = 12 if $hour % 12 == 0; | ||||
| 674 | $replacement = sprintf( '%d', $hour_tmp ); | ||||
| 675 | } | ||||
| 676 | else { | ||||
| 677 | $replacement = sprintf( '%02d', $hour ); | ||||
| 678 | } | ||||
| 679 | } | ||||
| 680 | elsif ( $placeholder->[0] eq 'h' ) { | ||||
| 681 | |||||
| 682 | # 1 digit hour. | ||||
| 683 | if ($is_12_hour) { | ||||
| 684 | my $hour_tmp = $hour % 12; | ||||
| 685 | $hour_tmp = 12 if $hour % 12 == 0; | ||||
| 686 | $replacement = sprintf( '%2d', $hour_tmp ); | ||||
| 687 | } | ||||
| 688 | else { | ||||
| 689 | $replacement = sprintf( '%d', $hour ); | ||||
| 690 | } | ||||
| 691 | } | ||||
| 692 | elsif ( $placeholder->[0] eq 'ss' ) { | ||||
| 693 | |||||
| 694 | # 2 digit seconds. | ||||
| 695 | $replacement = sprintf( '%02d', $sec ); | ||||
| 696 | } | ||||
| 697 | elsif ( $placeholder->[0] eq 's' ) { | ||||
| 698 | |||||
| 699 | # 1 digit seconds. | ||||
| 700 | $replacement = sprintf( '%d', $sec ); | ||||
| 701 | } | ||||
| 702 | elsif ( $placeholder->[0] eq 'am/pm' ) { | ||||
| 703 | |||||
| 704 | # AM/PM. | ||||
| 705 | $replacement = ( $hour >= 12 ) ? 'PM' : 'AM'; | ||||
| 706 | } | ||||
| 707 | elsif ( $placeholder->[0] eq 'a/p' ) { | ||||
| 708 | |||||
| 709 | # AM/PM. | ||||
| 710 | $replacement = ( $hour >= 12 ) ? 'P' : 'A'; | ||||
| 711 | } | ||||
| 712 | elsif ( $placeholder->[0] eq '.' ) { | ||||
| 713 | |||||
| 714 | # Decimal point for seconds. | ||||
| 715 | $replacement = '.'; | ||||
| 716 | } | ||||
| 717 | elsif ( $placeholder->[0] =~ /(^0+$)/ ) { | ||||
| 718 | |||||
| 719 | # Milliseconds. For example h:ss.000. | ||||
| 720 | my $length = length($1); | ||||
| 721 | $replacement = | ||||
| 722 | substr( sprintf( "%.${length}f", $msec / 1000 ), 2, $length ); | ||||
| 723 | } | ||||
| 724 | elsif ( $placeholder->[0] eq '[h]' ) { | ||||
| 725 | |||||
| 726 | # Hours modulus 24. 25 displays as 25 not as 1. | ||||
| 727 | $replacement = sprintf( '%d', int($number) * 24 + $hour ); | ||||
| 728 | } | ||||
| 729 | elsif ( $placeholder->[0] eq '[mm]' ) { | ||||
| 730 | |||||
| 731 | # Mins modulus 60. 72 displays as 72 not as 12. | ||||
| 732 | $replacement = | ||||
| 733 | sprintf( '%d', ( int($number) * 24 + $hour ) * 60 + $min ); | ||||
| 734 | } | ||||
| 735 | elsif ( $placeholder->[0] eq 'ge' ) { | ||||
| 736 | require Spreadsheet::ParseExcel::FmtJapan; | ||||
| 737 | # Japanese Nengo (aka Gengo) in initialism (abbr. name) | ||||
| 738 | $replacement = | ||||
| 739 | Spreadsheet::ParseExcel::FmtJapan::CnvNengo( abbr_name => @time ); | ||||
| 740 | } | ||||
| 741 | elsif ( $placeholder->[0] eq 'ggge' ) { | ||||
| 742 | require Spreadsheet::ParseExcel::FmtJapan; | ||||
| 743 | # Japanese Nengo (aka Gengo) in Kanji (full name) | ||||
| 744 | $replacement = | ||||
| 745 | Spreadsheet::ParseExcel::FmtJapan::CnvNengo( name => @time ); | ||||
| 746 | } | ||||
| 747 | elsif ( $placeholder->[0] eq '@' ) { | ||||
| 748 | |||||
| 749 | # Text format. | ||||
| 750 | $replacement = $number; | ||||
| 751 | } | ||||
| 752 | elsif ( $placeholder->[0] eq ',' ) { | ||||
| 753 | next; | ||||
| 754 | } | ||||
| 755 | |||||
| 756 | # Substitute the replacement string back into the template. | ||||
| 757 | substr( $result, $placeholder->[1], $placeholder->[2], | ||||
| 758 | $replacement ); | ||||
| 759 | } | ||||
| 760 | } | ||||
| 761 | elsif ( ( $format_mode eq 'number' ) && ( $number =~ $qrNUMBER ) ) { | ||||
| 762 | |||||
| 763 | # Process non date formats. | ||||
| 764 | if (@placeholders) { | ||||
| 765 | while ( $placeholders[-1]->[0] eq ',' ) { | ||||
| 766 | $comma_count--; | ||||
| 767 | substr( | ||||
| 768 | $result, | ||||
| 769 | $placeholders[-1]->[1], | ||||
| 770 | $placeholders[-1]->[2], '' | ||||
| 771 | ); | ||||
| 772 | $number /= 1000; | ||||
| 773 | pop @placeholders; | ||||
| 774 | } | ||||
| 775 | |||||
| 776 | my $number_format = join( '', map { $_->[0] } @placeholders ); | ||||
| 777 | my $number_result; | ||||
| 778 | my $str_length = 0; | ||||
| 779 | my $engineering = 0; | ||||
| 780 | my $is_decimal = 0; | ||||
| 781 | my $is_integer = 0; | ||||
| 782 | my $after_decimal = undef; | ||||
| 783 | |||||
| 784 | for my $token ( split //, $number_format ) { | ||||
| 785 | if ( $token eq '.' ) { | ||||
| 786 | $str_length++; | ||||
| 787 | $is_decimal = 1; | ||||
| 788 | } | ||||
| 789 | elsif ( ( $token eq 'E' ) || ( $token eq 'e' ) ) { | ||||
| 790 | $engineering = 1; | ||||
| 791 | } | ||||
| 792 | elsif ( $token eq '0' ) { | ||||
| 793 | $str_length++; | ||||
| 794 | $after_decimal++ if $is_decimal; | ||||
| 795 | $is_integer = 1; | ||||
| 796 | } | ||||
| 797 | elsif ( $token eq '#' ) { | ||||
| 798 | $after_decimal++ if $is_decimal; | ||||
| 799 | $is_integer = 1; | ||||
| 800 | } | ||||
| 801 | elsif ( $token eq '?' ) { | ||||
| 802 | $after_decimal++ if $is_decimal; | ||||
| 803 | } | ||||
| 804 | } | ||||
| 805 | |||||
| 806 | $number *= 100.0 if $is_percent; | ||||
| 807 | |||||
| 808 | my $data = ($is_currency) ? abs($number) : $number + 0; | ||||
| 809 | |||||
| 810 | if ($is_fraction) { | ||||
| 811 | $number_result = sprintf( "%0${str_length}d", int($data) ); | ||||
| 812 | } | ||||
| 813 | else { | ||||
| 814 | if ($is_decimal) { | ||||
| 815 | |||||
| 816 | if ( defined $after_decimal ) { | ||||
| 817 | $number_result = | ||||
| 818 | sprintf "%0${str_length}.${after_decimal}f", $data; | ||||
| 819 | } | ||||
| 820 | else { | ||||
| 821 | $number_result = sprintf "%0${str_length}f", $data; | ||||
| 822 | } | ||||
| 823 | |||||
| 824 | # Fix for Perl and sprintf not rounding up like Excel. | ||||
| 825 | # http://rt.cpan.org/Public/Bug/Display.html?id=45626 | ||||
| 826 | if ( $data =~ /^${number_result}5/ ) { | ||||
| 827 | $number_result = | ||||
| 828 | sprintf "%0${str_length}.${after_decimal}f", | ||||
| 829 | $data . '1'; | ||||
| 830 | } | ||||
| 831 | } | ||||
| 832 | else { | ||||
| 833 | $number_result = sprintf( "%0${str_length}.0f", $data ); | ||||
| 834 | } | ||||
| 835 | } | ||||
| 836 | |||||
| 837 | $number_result = AddComma($number_result) if $comma_count > 0; | ||||
| 838 | |||||
| 839 | my $number_length = length($number_result); | ||||
| 840 | my $decimal_pos = -1; | ||||
| 841 | my $replacement; | ||||
| 842 | |||||
| 843 | for ( my $i = @placeholders - 1 ; $i >= 0 ; $i-- ) { | ||||
| 844 | my $placeholder = $placeholders[$i]; | ||||
| 845 | |||||
| 846 | if ( $placeholder->[0] =~ | ||||
| 847 | /([#0]*)([\.]?)([0#]*)([eE])([\+\-])([0#]+)/ ) | ||||
| 848 | { | ||||
| 849 | substr( $result, $placeholder->[1], $placeholder->[2], | ||||
| 850 | MakeE( $placeholder->[0], $number ) ); | ||||
| 851 | } | ||||
| 852 | elsif ( $placeholder->[0] =~ /\// ) { | ||||
| 853 | substr( $result, $placeholder->[1], $placeholder->[2], | ||||
| 854 | MakeFraction( $placeholder->[0], $number, $is_integer ) | ||||
| 855 | ); | ||||
| 856 | } | ||||
| 857 | elsif ( $placeholder->[0] eq '.' ) { | ||||
| 858 | $number_length--; | ||||
| 859 | $decimal_pos = $number_length; | ||||
| 860 | } | ||||
| 861 | elsif ( $placeholder->[0] eq '+' ) { | ||||
| 862 | substr( $result, $placeholder->[1], $placeholder->[2], | ||||
| 863 | ( $number > 0 ) | ||||
| 864 | ? '+' | ||||
| 865 | : ( ( $number == 0 ) ? '+' : '-' ) ); | ||||
| 866 | } | ||||
| 867 | elsif ( $placeholder->[0] eq '-' ) { | ||||
| 868 | substr( $result, $placeholder->[1], $placeholder->[2], | ||||
| 869 | ( $number > 0 ) | ||||
| 870 | ? '' | ||||
| 871 | : ( ( $number == 0 ) ? '' : '-' ) ); | ||||
| 872 | } | ||||
| 873 | elsif ( $placeholder->[0] eq '@' ) { | ||||
| 874 | substr( $result, $placeholder->[1], $placeholder->[2], | ||||
| 875 | $number ); | ||||
| 876 | } | ||||
| 877 | elsif ( $placeholder->[0] eq '*' ) { | ||||
| 878 | substr( $result, $placeholder->[1], $placeholder->[2], '' ); | ||||
| 879 | } | ||||
| 880 | elsif (( $placeholder->[0] eq "\xA2\xA4" ) | ||||
| 881 | or ( $placeholder->[0] eq "\xA2\xA5" ) | ||||
| 882 | or ( $placeholder->[0] eq "\x81\xA2" ) | ||||
| 883 | or ( $placeholder->[0] eq "\x81\xA3" ) ) | ||||
| 884 | { | ||||
| 885 | substr( | ||||
| 886 | $result, $placeholder->[1], | ||||
| 887 | $placeholder->[2], $placeholder->[0] | ||||
| 888 | ); | ||||
| 889 | } | ||||
| 890 | elsif (( $placeholder->[0] eq '(' ) | ||||
| 891 | or ( $placeholder->[0] eq ')' ) ) | ||||
| 892 | { | ||||
| 893 | substr( | ||||
| 894 | $result, $placeholder->[1], | ||||
| 895 | $placeholder->[2], $placeholder->[0] | ||||
| 896 | ); | ||||
| 897 | } | ||||
| 898 | else { | ||||
| 899 | if ( $number_length > 0 ) { | ||||
| 900 | if ( $i <= 0 ) { | ||||
| 901 | $replacement = | ||||
| 902 | substr( $number_result, 0, $number_length ); | ||||
| 903 | $number_length = 0; | ||||
| 904 | } | ||||
| 905 | else { | ||||
| 906 | my $real_part_length = length( $placeholder->[0] ); | ||||
| 907 | if ( $decimal_pos >= 0 ) { | ||||
| 908 | my $format = $placeholder->[0]; | ||||
| 909 | $format =~ s/^#+//; | ||||
| 910 | $real_part_length = length $format; | ||||
| 911 | $real_part_length = | ||||
| 912 | ( $number_length <= $real_part_length ) | ||||
| 913 | ? $number_length | ||||
| 914 | : $real_part_length; | ||||
| 915 | } | ||||
| 916 | else { | ||||
| 917 | $real_part_length = | ||||
| 918 | ( $number_length <= $real_part_length ) | ||||
| 919 | ? $number_length | ||||
| 920 | : $real_part_length; | ||||
| 921 | } | ||||
| 922 | $replacement = | ||||
| 923 | substr( $number_result, | ||||
| 924 | $number_length - $real_part_length, | ||||
| 925 | $real_part_length ); | ||||
| 926 | $number_length -= $real_part_length; | ||||
| 927 | } | ||||
| 928 | } | ||||
| 929 | else { | ||||
| 930 | $replacement = ''; | ||||
| 931 | } | ||||
| 932 | substr( $result, $placeholder->[1], $placeholder->[2], | ||||
| 933 | "\x00" . $replacement ); | ||||
| 934 | } | ||||
| 935 | } | ||||
| 936 | $replacement = | ||||
| 937 | ( $number_length > 0 ) | ||||
| 938 | ? substr( $number_result, 0, $number_length ) | ||||
| 939 | : ''; | ||||
| 940 | $result =~ s/\x00/$replacement/; | ||||
| 941 | $result =~ s/\x00//g; | ||||
| 942 | } | ||||
| 943 | } | ||||
| 944 | else { | ||||
| 945 | |||||
| 946 | # Process text formats | ||||
| 947 | my $is_text = 0; | ||||
| 948 | for ( my $i = @placeholders - 1 ; $i >= 0 ; $i-- ) { | ||||
| 949 | my $placeholder = $placeholders[$i]; | ||||
| 950 | if ( $placeholder->[0] eq '@' ) { | ||||
| 951 | substr( $result, $placeholder->[1], $placeholder->[2], | ||||
| 952 | $number ); | ||||
| 953 | $is_text++; | ||||
| 954 | } | ||||
| 955 | else { | ||||
| 956 | substr( $result, $placeholder->[1], $placeholder->[2], '' ); | ||||
| 957 | } | ||||
| 958 | } | ||||
| 959 | |||||
| 960 | $result = $number unless $is_text; | ||||
| 961 | |||||
| 962 | } # End of placeholder substitutions. | ||||
| 963 | |||||
| 964 | # Trim the leading and trailing whitespace from the results. | ||||
| 965 | $result =~ s/^\s+//; | ||||
| 966 | $result =~ s/\s+$//; | ||||
| 967 | |||||
| 968 | # Fix for negative currency. | ||||
| 969 | $result =~ s/^\$\-/\-\$/; | ||||
| 970 | $result =~ s/^\$ \-/\-\$ /; | ||||
| 971 | |||||
| 972 | # Return color and locale strings if required. | ||||
| 973 | if ($want_subformats) { | ||||
| 974 | return ( $result, $color, $locale ); | ||||
| 975 | } | ||||
| 976 | else { | ||||
| 977 | return $result; | ||||
| 978 | } | ||||
| 979 | } | ||||
| 980 | |||||
| 981 | #------------------------------------------------------------------------------ | ||||
| 982 | # AddComma (for Spreadsheet::ParseExcel::Utility) | ||||
| 983 | #------------------------------------------------------------------------------ | ||||
| 984 | sub AddComma { | ||||
| 985 | my ($sNum) = @_; | ||||
| 986 | |||||
| 987 | if ( $sNum =~ /^([^\d]*)(\d\d\d\d+)(\.*.*)$/ ) { | ||||
| 988 | my ( $sPre, $sObj, $sAft ) = ( $1, $2, $3 ); | ||||
| 989 | for ( my $i = length($sObj) - 3 ; $i > 0 ; $i -= 3 ) { | ||||
| 990 | substr( $sObj, $i, 0, ',' ); | ||||
| 991 | } | ||||
| 992 | return $sPre . $sObj . $sAft; | ||||
| 993 | } | ||||
| 994 | else { | ||||
| 995 | return $sNum; | ||||
| 996 | } | ||||
| 997 | } | ||||
| 998 | |||||
| 999 | #------------------------------------------------------------------------------ | ||||
| 1000 | # MakeFraction (for Spreadsheet::ParseExcel::Utility) | ||||
| 1001 | #------------------------------------------------------------------------------ | ||||
| 1002 | sub MakeFraction { | ||||
| 1003 | my ( $sFmt, $iData, $iFlg ) = @_; | ||||
| 1004 | my $iBunbo; | ||||
| 1005 | my $iShou; | ||||
| 1006 | |||||
| 1007 | #1. Init | ||||
| 1008 | # print "FLG: $iFlg\n"; | ||||
| 1009 | if ($iFlg) { | ||||
| 1010 | $iShou = $iData - int($iData); | ||||
| 1011 | return '' if ( $iShou == 0 ); | ||||
| 1012 | } | ||||
| 1013 | else { | ||||
| 1014 | $iShou = $iData; | ||||
| 1015 | } | ||||
| 1016 | $iShou = abs($iShou); | ||||
| 1017 | my $sSWk; | ||||
| 1018 | |||||
| 1019 | #2.Calc BUNBO | ||||
| 1020 | #2.1 BUNBO defined | ||||
| 1021 | if ( $sFmt =~ /\/(\d+)$/ ) { | ||||
| 1022 | $iBunbo = $1; | ||||
| 1023 | return sprintf( "%d/%d", $iShou * $iBunbo, $iBunbo ); | ||||
| 1024 | } | ||||
| 1025 | else { | ||||
| 1026 | |||||
| 1027 | #2.2 Calc BUNBO | ||||
| 1028 | $sFmt =~ /\/(\?+)$/; | ||||
| 1029 | my $iKeta = length($1); | ||||
| 1030 | my $iSWk = 1; | ||||
| 1031 | my $sSWk = ''; | ||||
| 1032 | my $iBunsi; | ||||
| 1033 | for ( my $iBunbo = 2 ; $iBunbo < 10**$iKeta ; $iBunbo++ ) { | ||||
| 1034 | $iBunsi = int( $iShou * $iBunbo + 0.5 ); | ||||
| 1035 | my $iCmp = abs( $iShou - ( $iBunsi / $iBunbo ) ); | ||||
| 1036 | if ( $iCmp < $iSWk ) { | ||||
| 1037 | $iSWk = $iCmp; | ||||
| 1038 | $sSWk = sprintf( "%d/%d", $iBunsi, $iBunbo ); | ||||
| 1039 | last if ( $iSWk == 0 ); | ||||
| 1040 | } | ||||
| 1041 | } | ||||
| 1042 | return $sSWk; | ||||
| 1043 | } | ||||
| 1044 | } | ||||
| 1045 | |||||
| 1046 | #------------------------------------------------------------------------------ | ||||
| 1047 | # MakeE (for Spreadsheet::ParseExcel::Utility) | ||||
| 1048 | #------------------------------------------------------------------------------ | ||||
| 1049 | sub MakeE { | ||||
| 1050 | my ( $sFmt, $iData ) = @_; | ||||
| 1051 | |||||
| 1052 | $sFmt =~ /(([#0]*)[\.]?[#0]*)([eE])([\+\-][0#]+)/; | ||||
| 1053 | my ( $sKari, $iKeta, $sE, $sSisu ) = ( $1, length($2), $3, $4 ); | ||||
| 1054 | $iKeta = 1 if ( $iKeta <= 0 ); | ||||
| 1055 | |||||
| 1056 | my $iLog10 = 0; | ||||
| 1057 | $iLog10 = ( $iData == 0 ) ? 0 : ( log( abs($iData) ) / log(10) ); | ||||
| 1058 | $iLog10 = ( | ||||
| 1059 | int( $iLog10 / $iKeta ) + | ||||
| 1060 | ( ( ( $iLog10 - int( $iLog10 / $iKeta ) ) < 0 ) ? -1 : 0 ) ) * $iKeta; | ||||
| 1061 | |||||
| 1062 | my $sUe = ExcelFmt( $sKari, $iData * ( 10**( $iLog10 * -1 ) ), 0 ); | ||||
| 1063 | my $sShita = ExcelFmt( $sSisu, $iLog10, 0 ); | ||||
| 1064 | return $sUe . $sE . $sShita; | ||||
| 1065 | } | ||||
| 1066 | |||||
| 1067 | #------------------------------------------------------------------------------ | ||||
| 1068 | # LeapYear (for Spreadsheet::ParseExcel::Utility) | ||||
| 1069 | #------------------------------------------------------------------------------ | ||||
| 1070 | sub LeapYear { | ||||
| 1071 | my ($iYear) = @_; | ||||
| 1072 | return 1 if ( $iYear == 1900 ); #Special for Excel | ||||
| 1073 | return ( ( ( $iYear % 4 ) == 0 ) | ||||
| 1074 | && ( ( $iYear % 100 ) || ( $iYear % 400 ) == 0 ) ) | ||||
| 1075 | ? 1 | ||||
| 1076 | : 0; | ||||
| 1077 | } | ||||
| 1078 | |||||
| 1079 | #------------------------------------------------------------------------------ | ||||
| 1080 | # LocaltimeExcel (for Spreadsheet::ParseExcel::Utility) | ||||
| 1081 | #------------------------------------------------------------------------------ | ||||
| 1082 | sub LocaltimeExcel { | ||||
| 1083 | my ( $iSec, $iMin, $iHour, $iDay, $iMon, $iYear, $iwDay, $iMSec, $flg1904 ) | ||||
| 1084 | = @_; | ||||
| 1085 | |||||
| 1086 | #0. Init | ||||
| 1087 | $iMon++; | ||||
| 1088 | $iYear += 1900; | ||||
| 1089 | |||||
| 1090 | #1. Calc Time | ||||
| 1091 | my $iTime; | ||||
| 1092 | $iTime = $iHour; | ||||
| 1093 | $iTime *= 60; | ||||
| 1094 | $iTime += $iMin; | ||||
| 1095 | $iTime *= 60; | ||||
| 1096 | $iTime += $iSec; | ||||
| 1097 | $iTime += $iMSec / 1000.0 if ( defined($iMSec) ); | ||||
| 1098 | $iTime /= 86400.0; #3600*24(1day in seconds) | ||||
| 1099 | my $iY; | ||||
| 1100 | my $iYDays; | ||||
| 1101 | |||||
| 1102 | #2. Calc Days | ||||
| 1103 | if ($flg1904) { | ||||
| 1104 | $iY = 1904; | ||||
| 1105 | $iTime--; #Start from Jan 1st | ||||
| 1106 | $iYDays = 366; | ||||
| 1107 | } | ||||
| 1108 | else { | ||||
| 1109 | $iY = 1900; | ||||
| 1110 | $iYDays = 366; #In Excel 1900 is leap year (That's not TRUE!) | ||||
| 1111 | } | ||||
| 1112 | while ( $iY < $iYear ) { | ||||
| 1113 | $iTime += $iYDays; | ||||
| 1114 | $iY++; | ||||
| 1115 | $iYDays = ( LeapYear($iY) ) ? 366 : 365; | ||||
| 1116 | } | ||||
| 1117 | for ( my $iM = 1 ; $iM < $iMon ; $iM++ ) { | ||||
| 1118 | if ( $iM == 1 | ||||
| 1119 | || $iM == 3 | ||||
| 1120 | || $iM == 5 | ||||
| 1121 | || $iM == 7 | ||||
| 1122 | || $iM == 8 | ||||
| 1123 | || $iM == 10 | ||||
| 1124 | || $iM == 12 ) | ||||
| 1125 | { | ||||
| 1126 | $iTime += 31; | ||||
| 1127 | } | ||||
| 1128 | elsif ( $iM == 4 || $iM == 6 || $iM == 9 || $iM == 11 ) { | ||||
| 1129 | $iTime += 30; | ||||
| 1130 | } | ||||
| 1131 | elsif ( $iM == 2 ) { | ||||
| 1132 | $iTime += ( LeapYear($iYear) ) ? 29 : 28; | ||||
| 1133 | } | ||||
| 1134 | } | ||||
| 1135 | $iTime += $iDay; | ||||
| 1136 | return $iTime; | ||||
| 1137 | } | ||||
| 1138 | |||||
| 1139 | 1 | 800ns | my @month_days = qw( | ||
| 1140 | 0 31 28 31 30 31 30 31 31 30 31 30 31 | ||||
| 1141 | ); | ||||
| 1142 | |||||
| 1143 | #------------------------------------------------------------------------------ | ||||
| 1144 | # ExcelLocaltime (for Spreadsheet::ParseExcel::Utility) | ||||
| 1145 | #------------------------------------------------------------------------------ | ||||
| 1146 | sub ExcelLocaltime { | ||||
| 1147 | |||||
| 1148 | my ( $dObj, $flg1904 ) = @_; | ||||
| 1149 | my ( $iSec, $iMin, $iHour, $iDay, $iMon, $iYear, $iwDay, $iMSec ); | ||||
| 1150 | my ( $iDt, $iTime, $iYDays, $iMD ); | ||||
| 1151 | |||||
| 1152 | $iDt = int($dObj); | ||||
| 1153 | $iTime = $dObj - $iDt; | ||||
| 1154 | |||||
| 1155 | #1. Calc Days | ||||
| 1156 | if ($flg1904) { | ||||
| 1157 | $iYear = 1904; | ||||
| 1158 | $iDt++; #Start from Jan 1st | ||||
| 1159 | $iYDays = 366; | ||||
| 1160 | $iwDay = ( ( $iDt + 4 ) % 7 ); | ||||
| 1161 | } | ||||
| 1162 | else { | ||||
| 1163 | $iYear = 1900; | ||||
| 1164 | $iYDays = 366; #In Excel 1900 is leap year (That's not TRUE!) | ||||
| 1165 | $iwDay = ( ( $iDt + 6 ) % 7 ); | ||||
| 1166 | } | ||||
| 1167 | while ( $iDt > $iYDays ) { | ||||
| 1168 | $iDt -= $iYDays; | ||||
| 1169 | $iYear++; | ||||
| 1170 | $iYDays = | ||||
| 1171 | ( ( ( $iYear % 4 ) == 0 ) | ||||
| 1172 | && ( ( $iYear % 100 ) || ( $iYear % 400 ) == 0 ) ) ? 366 : 365; | ||||
| 1173 | } | ||||
| 1174 | $iYear -= 1900; # Localtime year is relative to 1900. | ||||
| 1175 | |||||
| 1176 | for ( $iMon = 1 ; $iMon <= 12 ; $iMon++ ) { | ||||
| 1177 | $iMD = $month_days[$iMon]; | ||||
| 1178 | $iMD++ if $iMon == 2 and $iYear % 4 == 0; | ||||
| 1179 | |||||
| 1180 | last if ( $iDt <= $iMD ); | ||||
| 1181 | $iDt -= $iMD; | ||||
| 1182 | } | ||||
| 1183 | |||||
| 1184 | #2. Calc Time | ||||
| 1185 | $iDay = $iDt; | ||||
| 1186 | $iTime += ( 0.0005 / 86400.0 ); | ||||
| 1187 | if ($iTime >= 1.0) | ||||
| 1188 | { | ||||
| 1189 | $iTime -= int($iTime); | ||||
| 1190 | $iwDay = ($iwDay == 6) ? 0 : $iwDay + 1; | ||||
| 1191 | if ($iDay == $iMD) | ||||
| 1192 | { | ||||
| 1193 | if ($iMon == 12) | ||||
| 1194 | { | ||||
| 1195 | $iMon = 1; | ||||
| 1196 | $iYear++; | ||||
| 1197 | } | ||||
| 1198 | else | ||||
| 1199 | { | ||||
| 1200 | $iMon++; | ||||
| 1201 | } | ||||
| 1202 | $iDay = 1; | ||||
| 1203 | } | ||||
| 1204 | else | ||||
| 1205 | { | ||||
| 1206 | $iDay++; | ||||
| 1207 | } | ||||
| 1208 | } | ||||
| 1209 | |||||
| 1210 | # Localtime month is 0 based. | ||||
| 1211 | $iMon -= 1; | ||||
| 1212 | $iTime *= 24.0; | ||||
| 1213 | $iHour = int($iTime); | ||||
| 1214 | $iTime -= $iHour; | ||||
| 1215 | $iTime *= 60.0; | ||||
| 1216 | $iMin = int($iTime); | ||||
| 1217 | $iTime -= $iMin; | ||||
| 1218 | $iTime *= 60.0; | ||||
| 1219 | $iSec = int($iTime); | ||||
| 1220 | $iTime -= $iSec; | ||||
| 1221 | $iTime *= 1000.0; | ||||
| 1222 | $iMSec = int($iTime); | ||||
| 1223 | |||||
| 1224 | return ( $iSec, $iMin, $iHour, $iDay, $iMon, $iYear, $iwDay, $iMSec ); | ||||
| 1225 | } | ||||
| 1226 | |||||
| 1227 | # ----------------------------------------------------------------------------- | ||||
| 1228 | # col2int (for Spreadsheet::ParseExcel::Utility) | ||||
| 1229 | #------------------------------------------------------------------------------ | ||||
| 1230 | # converts a excel row letter into an int for use in an array | ||||
| 1231 | sub col2int { | ||||
| 1232 | my $result = 0; | ||||
| 1233 | my $str = shift; | ||||
| 1234 | my $incr = 0; | ||||
| 1235 | |||||
| 1236 | for ( my $i = length($str) ; $i > 0 ; $i-- ) { | ||||
| 1237 | my $char = substr( $str, $i - 1 ); | ||||
| 1238 | my $curr += ord( lc($char) ) - ord('a') + 1; | ||||
| 1239 | $curr *= $incr if ($incr); | ||||
| 1240 | $result += $curr; | ||||
| 1241 | $incr += 26; | ||||
| 1242 | } | ||||
| 1243 | |||||
| 1244 | # this is one out as we range 0..x-1 not 1..x | ||||
| 1245 | $result--; | ||||
| 1246 | |||||
| 1247 | return $result; | ||||
| 1248 | } | ||||
| 1249 | |||||
| 1250 | # ----------------------------------------------------------------------------- | ||||
| 1251 | # int2col (for Spreadsheet::ParseExcel::Utility) | ||||
| 1252 | #------------------------------------------------------------------------------ | ||||
| 1253 | ### int2col | ||||
| 1254 | # convert a column number into column letters | ||||
| 1255 | # @note this is quite a brute force coarse method | ||||
| 1256 | # does not manage values over 701 (ZZ) | ||||
| 1257 | # @arg number, to convert | ||||
| 1258 | # @returns string, column name | ||||
| 1259 | # | ||||
| 1260 | sub int2col { | ||||
| 1261 | my $out = ""; | ||||
| 1262 | my $val = shift; | ||||
| 1263 | |||||
| 1264 | do { | ||||
| 1265 | $out .= chr( ( $val % 26 ) + ord('A') ); | ||||
| 1266 | $val = int( $val / 26 ) - 1; | ||||
| 1267 | } while ( $val >= 0 ); | ||||
| 1268 | |||||
| 1269 | return scalar reverse $out; | ||||
| 1270 | } | ||||
| 1271 | |||||
| 1272 | # ----------------------------------------------------------------------------- | ||||
| 1273 | # sheetRef (for Spreadsheet::ParseExcel::Utility) | ||||
| 1274 | #------------------------------------------------------------------------------ | ||||
| 1275 | # ----------------------------------------------------------------------------- | ||||
| 1276 | ### sheetRef | ||||
| 1277 | # convert an excel letter-number address into a useful array address | ||||
| 1278 | # @note that also Excel uses X-Y notation, we normally use Y-X in arrays | ||||
| 1279 | # @args $str, excel coord eg. A2 | ||||
| 1280 | # @returns an array - 2 elements - column, row, or undefined | ||||
| 1281 | # | ||||
| 1282 | sub sheetRef { | ||||
| 1283 | my $str = shift; | ||||
| 1284 | my @ret; | ||||
| 1285 | |||||
| 1286 | $str =~ m/^(\D+)(\d+)$/; | ||||
| 1287 | |||||
| 1288 | if ( $1 && $2 ) { | ||||
| 1289 | push( @ret, $2 - 1, col2int($1) ); | ||||
| 1290 | } | ||||
| 1291 | if ( $ret[0] < 0 ) { | ||||
| 1292 | undef @ret; | ||||
| 1293 | } | ||||
| 1294 | |||||
| 1295 | return @ret; | ||||
| 1296 | } | ||||
| 1297 | |||||
| 1298 | # ----------------------------------------------------------------------------- | ||||
| 1299 | # xls2csv (for Spreadsheet::ParseExcel::Utility) | ||||
| 1300 | #------------------------------------------------------------------------------ | ||||
| 1301 | ### xls2csv | ||||
| 1302 | # convert a chunk of an excel file into csv text chunk | ||||
| 1303 | # @args $param, sheet-colrow:colrow (1-A1:B2 or A1:B2 for sheet 1 | ||||
| 1304 | # @args $rotate, 0 or 1 decides if output should be rotated or not | ||||
| 1305 | # @returns string containing a chunk of csv | ||||
| 1306 | # | ||||
| 1307 | sub xls2csv { | ||||
| 1308 | my ( $filename, $regions, $rotate ) = @_; | ||||
| 1309 | my $sheet = 0; | ||||
| 1310 | |||||
| 1311 | # We need Text::CSV_XS for proper CSV handling. | ||||
| 1312 | require Text::CSV_XS; | ||||
| 1313 | |||||
| 1314 | # extract any sheet number from the region string | ||||
| 1315 | $regions =~ m/^(\d+)-(.*)/; | ||||
| 1316 | |||||
| 1317 | if ($2) { | ||||
| 1318 | $sheet = $1 - 1; | ||||
| 1319 | $regions = $2; | ||||
| 1320 | } | ||||
| 1321 | |||||
| 1322 | # now extract the start and end regions | ||||
| 1323 | $regions =~ m/(.*):(.*)/; | ||||
| 1324 | |||||
| 1325 | if ( !$1 || !$2 ) { | ||||
| 1326 | print STDERR "Bad Params"; | ||||
| 1327 | return ""; | ||||
| 1328 | } | ||||
| 1329 | |||||
| 1330 | my @start = sheetRef($1); | ||||
| 1331 | my @end = sheetRef($2); | ||||
| 1332 | if ( !@start ) { | ||||
| 1333 | print STDERR "Bad coorinates - $1"; | ||||
| 1334 | return ""; | ||||
| 1335 | } | ||||
| 1336 | if ( !@end ) { | ||||
| 1337 | print STDERR "Bad coorinates - $2"; | ||||
| 1338 | return ""; | ||||
| 1339 | } | ||||
| 1340 | |||||
| 1341 | if ( $start[1] > $end[1] ) { | ||||
| 1342 | print STDERR "Bad COLUMN ordering\n"; | ||||
| 1343 | print STDERR "Start column " . int2col( $start[1] ); | ||||
| 1344 | print STDERR " after end column " . int2col( $end[1] ) . "\n"; | ||||
| 1345 | return ""; | ||||
| 1346 | } | ||||
| 1347 | if ( $start[0] > $end[0] ) { | ||||
| 1348 | print STDERR "Bad ROW ordering\n"; | ||||
| 1349 | print STDERR "Start row " . ( $start[0] + 1 ); | ||||
| 1350 | print STDERR " after end row " . ( $end[0] + 1 ) . "\n"; | ||||
| 1351 | exit; | ||||
| 1352 | } | ||||
| 1353 | |||||
| 1354 | # start the excel object now | ||||
| 1355 | my $oExcel = new Spreadsheet::ParseExcel; | ||||
| 1356 | my $oBook = $oExcel->Parse($filename); | ||||
| 1357 | |||||
| 1358 | # open the sheet | ||||
| 1359 | my $oWkS = $oBook->{Worksheet}[$sheet]; | ||||
| 1360 | |||||
| 1361 | # now check that the region exists in the file | ||||
| 1362 | # if not truncate to the possible region | ||||
| 1363 | # output a warning msg | ||||
| 1364 | if ( $start[1] < $oWkS->{MinCol} ) { | ||||
| 1365 | print STDERR int2col( $start[1] ) | ||||
| 1366 | . " < min col " | ||||
| 1367 | . int2col( $oWkS->{MinCol} ) | ||||
| 1368 | . " Resetting\n"; | ||||
| 1369 | $start[1] = $oWkS->{MinCol}; | ||||
| 1370 | } | ||||
| 1371 | if ( $end[1] > $oWkS->{MaxCol} ) { | ||||
| 1372 | print STDERR int2col( $end[1] ) | ||||
| 1373 | . " > max col " | ||||
| 1374 | . int2col( $oWkS->{MaxCol} ) | ||||
| 1375 | . " Resetting\n"; | ||||
| 1376 | $end[1] = $oWkS->{MaxCol}; | ||||
| 1377 | } | ||||
| 1378 | if ( $start[0] < $oWkS->{MinRow} ) { | ||||
| 1379 | print STDERR "" | ||||
| 1380 | . ( $start[0] + 1 ) | ||||
| 1381 | . " < min row " | ||||
| 1382 | . ( $oWkS->{MinRow} + 1 ) | ||||
| 1383 | . " Resetting\n"; | ||||
| 1384 | $start[0] = $oWkS->{MinCol}; | ||||
| 1385 | } | ||||
| 1386 | if ( $end[0] > $oWkS->{MaxRow} ) { | ||||
| 1387 | print STDERR "" | ||||
| 1388 | . ( $end[0] + 1 ) | ||||
| 1389 | . " > max row " | ||||
| 1390 | . ( $oWkS->{MaxRow} + 1 ) | ||||
| 1391 | . " Resetting\n"; | ||||
| 1392 | $end[0] = $oWkS->{MaxRow}; | ||||
| 1393 | |||||
| 1394 | } | ||||
| 1395 | |||||
| 1396 | my $x1 = $start[1]; | ||||
| 1397 | my $y1 = $start[0]; | ||||
| 1398 | my $x2 = $end[1]; | ||||
| 1399 | my $y2 = $end[0]; | ||||
| 1400 | |||||
| 1401 | my @cell_data; | ||||
| 1402 | my $row = 0; | ||||
| 1403 | |||||
| 1404 | if ( !$rotate ) { | ||||
| 1405 | for ( my $y = $y1 ; $y <= $y2 ; $y++ ) { | ||||
| 1406 | for ( my $x = $x1 ; $x <= $x2 ; $x++ ) { | ||||
| 1407 | my $cell = $oWkS->{Cells}[$y][$x]; | ||||
| 1408 | |||||
| 1409 | my $value; | ||||
| 1410 | if ( defined $cell ) { | ||||
| 1411 | $value .= $cell->value(); | ||||
| 1412 | } | ||||
| 1413 | else { | ||||
| 1414 | $value = ''; | ||||
| 1415 | } | ||||
| 1416 | |||||
| 1417 | push @{ $cell_data[$row] }, $value; | ||||
| 1418 | } | ||||
| 1419 | $row++; | ||||
| 1420 | } | ||||
| 1421 | } | ||||
| 1422 | else { | ||||
| 1423 | for ( my $x = $x1 ; $x <= $x2 ; $x++ ) { | ||||
| 1424 | for ( my $y = $y1 ; $y <= $y2 ; $y++ ) { | ||||
| 1425 | my $cell = $oWkS->{Cells}[$y][$x]; | ||||
| 1426 | |||||
| 1427 | my $value; | ||||
| 1428 | if ( defined $cell ) { | ||||
| 1429 | $value .= $cell->value(); | ||||
| 1430 | } | ||||
| 1431 | else { | ||||
| 1432 | $value = ''; | ||||
| 1433 | } | ||||
| 1434 | |||||
| 1435 | push @{ $cell_data[$row] }, $value; | ||||
| 1436 | } | ||||
| 1437 | $row++; | ||||
| 1438 | } | ||||
| 1439 | } | ||||
| 1440 | |||||
| 1441 | # Create the CSV output string. | ||||
| 1442 | my $csv = Text::CSV_XS->new( { binary => 1, eol => $/ } ); | ||||
| 1443 | my $output = ""; | ||||
| 1444 | |||||
| 1445 | for my $row (@cell_data) { | ||||
| 1446 | $csv->combine(@$row); | ||||
| 1447 | $output .= $csv->string(); | ||||
| 1448 | } | ||||
| 1449 | |||||
| 1450 | return $output; | ||||
| 1451 | } | ||||
| 1452 | |||||
| 1453 | 1 | 4µs | 1; | ||
| 1454 | |||||
| 1455 | __END__ |