Commit | Line | Data |
d0eafc11 |
1 | package Excel::Template::Format; |
2 | |
3 | use strict; |
4 | |
5 | # This is the format repository. Spreadsheet::WriteExcel does not cache the |
6 | # known formats. So, it is very possible to continually add the same format |
7 | # over and over until you run out of RAM or addressability in the XLS file. In |
8 | # real life, less than 10-20 formats are used, and they're re-used in various |
9 | # places in the file. This provides a way of keeping track of already-allocated |
10 | # formats and making new formats based on old ones. |
11 | |
12 | { |
c09684ff |
13 | my %_Formats; |
14 | |
15 | sub _assign { $_Formats{$_[0]} = $_[1]; $_Formats{$_[1]} = $_[0] } |
16 | # my $key = shift; |
17 | # my $format = shift; |
18 | # $_Formats{$key} = $format; |
19 | # $_Formats{$format} = $key; |
20 | # } |
21 | |
22 | sub _retrieve_key { $_Formats{ $_[0] } } |
23 | # my $format = shift; |
24 | # return $_Formats{$format}; |
25 | # } |
26 | |
27 | *_retrieve_format = \&_retrieve_key; |
28 | # sub _retrieve_format { |
29 | # my $key = shift; |
30 | # return $_Formats{$key}; |
31 | # } |
32 | } |
33 | |
34 | { |
35 | my @_boolean_formats = qw( |
36 | bold italic locked hidden font_outline font_shadow font_strikeout |
37 | text_wrap text_justlast shrink |
d0eafc11 |
38 | ); |
c09684ff |
39 | |
40 | my @_integer_formats = qw( |
41 | size num_format underline rotation indent pattern border |
42 | bottom top left right |
43 | ); |
44 | |
45 | my @_string_formats = qw( |
46 | font color align valign bg_color fg_color border_color |
47 | bottom_color top_color left_color right_color |
48 | ); |
49 | |
50 | sub _params_to_key |
d0eafc11 |
51 | { |
52 | my %params = @_; |
53 | $params{lc $_} = delete $params{$_} for keys %params; |
c09684ff |
54 | |
55 | my @parts = ( |
56 | (map { !! $params{$_} } @_boolean_formats), |
57 | (map { $params{$_} ? $params{$_} + 0 : '' } @_integer_formats), |
58 | (map { $params{$_} || '' } @_string_formats), |
59 | ); |
60 | |
61 | return join( "\n", @parts ); |
d0eafc11 |
62 | } |
c09684ff |
63 | |
64 | sub _key_to_params |
d0eafc11 |
65 | { |
c09684ff |
66 | my ($key) = @_; |
67 | |
68 | my @key_parts = split /\n/, $key; |
69 | |
70 | my @boolean_parts = splice @key_parts, 0, scalar( @_boolean_formats ); |
71 | my @integer_parts = splice @key_parts, 0, scalar( @_integer_formats ); |
72 | my @string_parts = splice @key_parts, 0, scalar( @_string_formats ); |
73 | |
d0eafc11 |
74 | my %params; |
c09684ff |
75 | $params{ $_boolean_formats[$_] } = !!1 |
76 | for grep { $boolean_parts[$_] } 0 .. $#_boolean_formats; |
d0eafc11 |
77 | |
c09684ff |
78 | $params{ $_integer_formats[$_] } = $integer_parts[$_] |
79 | for grep { length $integer_parts[$_] } 0 .. $#_integer_formats; |
80 | |
81 | $params{ $_string_formats[$_] } = $string_parts[$_] |
82 | for grep { $string_parts[$_] } 0 .. $#_string_formats; |
d0eafc11 |
83 | |
c09684ff |
84 | return %params; |
d0eafc11 |
85 | } |
86 | |
c09684ff |
87 | sub copy |
88 | { |
89 | shift; |
90 | my ($context, $old_fmt, %properties) = @_; |
d0eafc11 |
91 | |
c09684ff |
92 | defined(my $key = _retrieve_key($old_fmt)) |
93 | || die "Internal Error: Cannot find key for format '$old_fmt'!\n"; |
94 | |
95 | my %params = _key_to_params($key); |
96 | PROPERTY: |
97 | while ( my ($prop, $value) = each %properties ) |
98 | { |
99 | $prop = lc $prop; |
100 | foreach (@_boolean_formats) |
101 | { |
102 | if ($prop eq $_) { |
103 | $params{$_} = ($value && $value !~ /false/i); |
104 | next PROPERTY; |
105 | } |
106 | } |
107 | foreach (@_integer_formats, @_string_formats) |
108 | { |
109 | if ($prop eq $_) { |
110 | $params{$_} = $value; |
111 | next PROPERTY; |
112 | } |
113 | } |
114 | } |
d0eafc11 |
115 | |
c09684ff |
116 | my $new_key = _params_to_key(%params); |
d0eafc11 |
117 | |
c09684ff |
118 | my $format = _retrieve_format($new_key); |
119 | return $format if $format; |
d0eafc11 |
120 | |
c09684ff |
121 | $format = $context->{XLS}->add_format(%params); |
122 | _assign($new_key, $format); |
123 | return $format; |
124 | } |
d0eafc11 |
125 | } |
126 | |
c09684ff |
127 | sub blank_format |
d0eafc11 |
128 | { |
129 | shift; |
c09684ff |
130 | my ($context) = @_; |
d0eafc11 |
131 | |
c09684ff |
132 | my $blank_key = _params_to_key(); |
d0eafc11 |
133 | |
c09684ff |
134 | my $format = _retrieve_format($blank_key); |
d0eafc11 |
135 | return $format if $format; |
136 | |
c09684ff |
137 | $format = $context->{XLS}->add_format; |
138 | _assign($blank_key, $format); |
139 | return $format; |
d0eafc11 |
140 | } |
141 | |
142 | 1; |
143 | __END__ |