lib/Excel/Template/Format.pm

   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 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 #}
  33
  34 {
  35     my @_boolean_formats = qw(
  36         bold italic locked hidden font_outline font_shadow font_strikeout
  37         text_wrap text_justlast shrink is_merged
  38     );
  39
  40     my @_integer_formats = qw(
  41         size underline rotation indent pattern border
  42         bottom top left right
  43     );
  44
  45     my @_string_formats = qw(
  46         num_format font color align valign bg_color fg_color border_color
  47         bottom_color top_color left_color right_color
  48     );
  49
  50     my @_fake_slots = qw(
  51         is_merged
  52     );
  53
  54     sub _params_to_key
  55     {
  56         my %params = @_;
  57         $params{lc $_} = delete $params{$_} for keys %params;
  58
  59         my @parts = (
  60             (map { $params{$_} ? 1 : '' } @_boolean_formats),
  61             (map { $params{$_} ? $params{$_} + 0 : '' } @_integer_formats),
  62             (map { $params{$_} || '' } @_string_formats),
  63         );
  64
  65         return join( "\n", @parts );
  66     }
  67
  68     sub _key_to_params
  69     {
  70         my ($key) = @_;
  71
  72         my @key_parts = split /\n/, $key;
  73
  74         my @boolean_parts = splice @key_parts, 0, scalar( @_boolean_formats );
  75         my @integer_parts = splice @key_parts, 0, scalar( @_integer_formats );
  76         my @string_parts  = splice @key_parts, 0, scalar( @_string_formats );
  77
  78         my %params;
  79         $params{ $_boolean_formats[$_] } = ~~1
  80             for grep { $boolean_parts[$_] } 0 .. $#_boolean_formats;
  81
  82         $params{ $_integer_formats[$_] } = $integer_parts[$_]
  83             for grep { defined $integer_parts[$_] && length $integer_parts[$_] } 0 .. $#_integer_formats;
  84
  85         $params{ $_string_formats[$_] } = $string_parts[$_]
  86             for grep { $string_parts[$_] } 0 .. $#_string_formats;
  87
  88         return %params;
  89     }
  90
  91     sub copy
  92     {
  93         my $self = shift;
  94         my ($context, $old_fmt, %properties) = @_;
  95
  96         # This is a key used for non-format book-keeping.
  97         delete $properties{ ELEMENTS };
  98
  99         defined(my $key = _retrieve_key($self, $old_fmt))
 100             || die "Internal Error: Cannot find key for format '$old_fmt'!\n";
 101
 102         my %params = _key_to_params($key);
 103         PROPERTY:
 104         while ( my ($prop, $value) = each %properties )
 105         {
 106             $prop = lc $prop;
 107             foreach (@_boolean_formats)
 108             {
 109                 if ($prop eq $_) {
 110                     $params{$_} = ($value && $value !~ /false/i);
 111                     next PROPERTY;
 112                 }
 113             }
 114             foreach (@_integer_formats, @_string_formats)
 115             {
 116                 if ($prop eq $_) {
 117                     $params{$_} = $value;
 118                     next PROPERTY;
 119                 }
 120             }
 121
 122             warn "Property '$prop' is unrecognized\n" if $^W;
 123         }
 124
 125         my $new_key = _params_to_key(%params);
 126
 127         my $format = _retrieve_format($self, $new_key);
 128         return $format if $format;
 129
 130         delete $params{$_} for @_fake_slots;
 131
 132         $format = $context->{XLS}->add_format(%params);
 133         _assign($self, $new_key, $format);
 134         return $format;
 135     }
 136 }
 137
 138 sub blank_format
 139 {
 140     my $self = shift;
 141     my ($context) = @_;
 142
 143     my $blank_key = _params_to_key();
 144
 145     my $format = _retrieve_format($self, $blank_key);
 146     return $format if $format;
 147
 148     $format = $context->{XLS}->add_format;
 149     _assign($self, $blank_key, $format);
 150     return $format;
 151 }
 152
 153 1;
 154 __END__
 155
 156 =head1 NAME
 157
 158 Excel::Template::Format - Excel::Template::Format
 159
 160 =head1 PURPOSE
 161
 162 Helper class for FORMAT
 163
 164 =head1 NODE NAME
 165
 166 None
 167
 168 =head1 INHERITANCE
 169
 170 None
 171
 172 =head1 ATTRIBUTES
 173
 174 None
 175
 176 =head1 CHILDREN
 177
 178 None
 179
 180 =head1 EFFECTS
 181
 182 None
 183
 184 =head1 DEPENDENCIES
 185
 186 None
 187
 188 =head1 METHODS
 189
 190 =head2 blank_format
 191
 192 Provides a blank format for use
 193
 194 =head2 copy
 195
 196 Clones an existing format, so that a new format can be built from it
 197
 198 =head1 AUTHOR
 199
 200 Rob Kinyon (rob.kinyon@gmail.com)
 201
 202 =head1 SEE ALSO
 203
 204 FORMAT
 205
 206 =cut