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 | |
9ee3aea0 |
12 | sub new { bless {}, shift } |
13 | |
14 | sub _assign { $_[0]{$_[1]} = $_[2]; $_[0]{$_[2]} = $_[1] } |
15 | # my $self = shift; |
16 | # my ($key, $format) = @_; |
17 | # $self->{$key} = $format; |
18 | # $self->{$format} = $key; |
19 | #} |
20 | |
21 | sub _retrieve_key { $_[0]{ $_[1] } } |
22 | # my $self = shift; |
23 | # my ($format) = @_; |
24 | # return $self->{$format}; |
25 | #} |
26 | |
27 | *_retrieve_format = \&_retrieve_key; |
28 | #sub _retrieve_format { |
29 | # my $self = shift; |
30 | # my ($key) = @_; |
31 | # return $self->{$key}; |
32 | #} |
c09684ff |
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 = ( |
d5382a2d |
56 | (map { $params{$_} ? 1 : '' } @_boolean_formats), |
c09684ff |
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; |
d5382a2d |
75 | $params{ $_boolean_formats[$_] } = ~~1 |
c09684ff |
76 | for grep { $boolean_parts[$_] } 0 .. $#_boolean_formats; |
d0eafc11 |
77 | |
c09684ff |
78 | $params{ $_integer_formats[$_] } = $integer_parts[$_] |
d5382a2d |
79 | for grep { defined $integer_parts[$_] && length $integer_parts[$_] } 0 .. $#_integer_formats; |
c09684ff |
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 | { |
9ee3aea0 |
89 | my $self = shift; |
c09684ff |
90 | my ($context, $old_fmt, %properties) = @_; |
d0eafc11 |
91 | |
b6bc5a5d |
92 | # This is a key used for non-format book-keeping. |
93 | delete $properties{ ELEMENTS }; |
94 | |
9ee3aea0 |
95 | defined(my $key = _retrieve_key($self, $old_fmt)) |
c09684ff |
96 | || die "Internal Error: Cannot find key for format '$old_fmt'!\n"; |
97 | |
98 | my %params = _key_to_params($key); |
99 | PROPERTY: |
100 | while ( my ($prop, $value) = each %properties ) |
101 | { |
102 | $prop = lc $prop; |
103 | foreach (@_boolean_formats) |
104 | { |
105 | if ($prop eq $_) { |
106 | $params{$_} = ($value && $value !~ /false/i); |
107 | next PROPERTY; |
108 | } |
109 | } |
110 | foreach (@_integer_formats, @_string_formats) |
111 | { |
112 | if ($prop eq $_) { |
113 | $params{$_} = $value; |
114 | next PROPERTY; |
115 | } |
116 | } |
b6bc5a5d |
117 | |
dee1f239 |
118 | warn "Property '$prop' is unrecognized\n" if $^W; |
c09684ff |
119 | } |
d0eafc11 |
120 | |
c09684ff |
121 | my $new_key = _params_to_key(%params); |
d0eafc11 |
122 | |
9ee3aea0 |
123 | my $format = _retrieve_format($self, $new_key); |
c09684ff |
124 | return $format if $format; |
d0eafc11 |
125 | |
c09684ff |
126 | $format = $context->{XLS}->add_format(%params); |
9ee3aea0 |
127 | _assign($self, $new_key, $format); |
c09684ff |
128 | return $format; |
129 | } |
d0eafc11 |
130 | } |
131 | |
c09684ff |
132 | sub blank_format |
d0eafc11 |
133 | { |
9ee3aea0 |
134 | my $self = shift; |
c09684ff |
135 | my ($context) = @_; |
d0eafc11 |
136 | |
c09684ff |
137 | my $blank_key = _params_to_key(); |
d0eafc11 |
138 | |
9ee3aea0 |
139 | my $format = _retrieve_format($self, $blank_key); |
d0eafc11 |
140 | return $format if $format; |
141 | |
c09684ff |
142 | $format = $context->{XLS}->add_format; |
9ee3aea0 |
143 | _assign($self, $blank_key, $format); |
c09684ff |
144 | return $format; |
d0eafc11 |
145 | } |
146 | |
147 | 1; |
148 | __END__ |
6dd4c89d |
149 | |
150 | =head1 NAME |
151 | |
152 | Excel::Template::Format - Excel::Template::Format |
153 | |
154 | =head1 PURPOSE |
155 | |
156 | Helper class for FORMAT |
157 | |
158 | =head1 NODE NAME |
159 | |
160 | None |
161 | |
162 | =head1 INHERITANCE |
163 | |
164 | None |
165 | |
166 | =head1 ATTRIBUTES |
167 | |
168 | None |
169 | |
170 | =head1 CHILDREN |
171 | |
172 | None |
173 | |
174 | =head1 EFFECTS |
175 | |
176 | None |
177 | |
178 | =head1 DEPENDENCIES |
179 | |
180 | None |
181 | |
182 | =head1 METHODS |
183 | |
184 | =head2 blank_format |
185 | |
186 | Provides a blank format for use |
187 | |
188 | =head2 copy |
189 | |
190 | Clones an existing format, so that a new format can be built from it |
191 | |
192 | =head1 AUTHOR |
193 | |
194 | Rob Kinyon (rob.kinyon@gmail.com) |
195 | |
196 | =head1 SEE ALSO |
197 | |
198 | FORMAT |
199 | |
200 | =cut |