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 { length $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         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         }
 115
 116         my $new_key = _params_to_key(%params);
 117
 118         my $format = _retrieve_format($new_key);
 119         return $format if $format;
 120
 121         $format = $context->{XLS}->add_format(%params);
 122         _assign($new_key, $format);
 123         return $format;
 124     }
 125 }
 126
 127 sub blank_format
 128 {
 129     shift;
 130     my ($context) = @_;
 131
 132     my $blank_key = _params_to_key();
 133
 134     my $format = _retrieve_format($blank_key);
 135     return $format if $format;
 136
 137     $format = $context->{XLS}->add_format;
 138     _assign($blank_key, $format);
 139     return $format;
 140 }
 141
 142 1;
 143 __END__