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 {
  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
  38     );
  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
  51     {
  52         my %params = @_;
  53         $params{lc $_} = delete $params{$_} for keys %params;
  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 );
  62     }
  63
  64     sub _key_to_params
  65     {
  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
  74         my %params;
  75         $params{ $_boolean_formats[$_] } = !!1
  76             for grep { $boolean_parts[$_] } 0 .. $#_boolean_formats;
  77
  78         $params{ $_integer_formats[$_] } = $integer_parts[$_]
  79             for grep { defined $integer_parts[$_] } 0 .. $#_integer_formats;
  80
  81         $params{ $_string_formats[$_] } = $string_parts[$_]
  82             for grep { $string_parts[$_] } 0 .. $#_string_formats;
  83
  84         return %params;
  85     }
  86
  87     sub copy
  88     {
  89         shift;
  90         my ($context, $old_fmt, %properties) = @_;
  91
  92         # This is a key used for non-format book-keeping.
  93         delete $properties{ ELEMENTS };
  94
  95         defined(my $key = _retrieve_key($old_fmt))
  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             }
 117
 118             warn "Property '$prop' is unrecognized\n" if $^W;
 119         }
 120
 121         my $new_key = _params_to_key(%params);
 122
 123         my $format = _retrieve_format($new_key);
 124         return $format if $format;
 125
 126         $format = $context->{XLS}->add_format(%params);
 127         _assign($new_key, $format);
 128         return $format;
 129     }
 130 }
 131
 132 sub blank_format
 133 {
 134     shift;
 135     my ($context) = @_;
 136
 137     my $blank_key = _params_to_key();
 138
 139     my $format = _retrieve_format($blank_key);
 140     return $format if $format;
 141
 142     $format = $context->{XLS}->add_format;
 143     _assign($blank_key, $format);
 144     return $format;
 145 }
 146
 147 1;
 148 __END__
 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