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