1package Spreadsheet::WriteExcelXML::Format;
2
3###############################################################################
4#
5# Format - A class for defining Excel formatting.
6#
7#
8# Used in conjunction with Spreadsheet::WriteExcelXML
9#
10# Copyright 2000-2010, John McNamara, jmcnamara@cpan.org
11#
12# Documentation after __END__
13#
14
15use Exporter;
16use strict;
17use Carp;
18
19
20
21
22
23
24
25use vars qw($AUTOLOAD $VERSION @ISA);
26@ISA = qw(Exporter);
27
28$VERSION = '0.15';
29
30###############################################################################
31#
32# new()
33#
34# Constructor
35#
36sub new {
37
38    my $class  = shift;
39
40    my $self   = {
41                    _xf_index       => shift || 0,
42                    _palette        => shift,
43
44                    _font_index     => 0,
45                    _font           => 'Arial',
46                    _size           => 10,
47                    _bold           => 0,
48                    _italic         => 0,
49                    _color          => 0x0,
50                    _underline      => 0,
51                    _font_strikeout => 0,
52                    _font_outline   => 0,
53                    _font_shadow    => 0,
54                    _font_script    => 0,
55                    _font_family    => 0,
56                    _font_charset   => 0,
57
58                    _num_format     => undef,
59
60                    _hidden         => 0,
61                    _locked         => 1,
62
63                    _text_h_align   => 0,
64                    _text_wrap      => 0,
65                    _text_v_align   => -1,
66                    _text_justlast  => 0,
67                    _rotation       => 0,
68                    _text_vertical  => 0,
69
70                    _fg_color       => 0x00,
71                    _bg_color       => 0x00,
72
73                    _pattern        => 0,
74
75                    _bottom         => 0,
76                    _top            => 0,
77                    _left           => 0,
78                    _right          => 0,
79
80                    _bottom_color   => 0x0,
81                    _top_color      => 0x0,
82                    _left_color     => 0x0,
83                    _right_color    => 0x0,
84
85                    _indent         => 0,
86                    _shrink         => 0,
87                    _merge_range    => 0,
88                    _reading_order  => 0,
89
90                    _diag_type      => 0,
91                    _diag_color     => 0x0,
92                    _diag_border    => 0,
93
94                    _just_distrib   => 0,
95
96                 };
97
98    bless  $self, $class;
99
100    # Set properties passed to Workbook::add_format()
101    $self->set_properties(@_) if @_;
102
103    return $self;
104}
105
106
107###############################################################################
108#
109# copy($format)
110#
111# Copy the attributes of another Spreadsheet::WriteExcelXML::Format object.
112#
113sub copy {
114    my $self  = shift;
115    my $other = $_[0];
116
117
118    return unless defined $other;
119    return unless (ref($self) eq ref($other));
120
121
122    my $xf      = $self->{_xf_index}; # Store XF index assigned by Workbook.pm
123    my $palette = $self->{_palette};  # Store palette assigned by Workbook.pm
124    %$self = %$other;                 # Copy properties
125    $self->{_xf_index} = $xf;         # Restore XF index
126    $self->{_palette}  = $palette;    # Restore palette
127}
128
129
130###############################################################################
131#
132# convert_to_html_color()
133#
134# Convert from an Excel internal colour index to a Html style #RRGGBB index
135# based on the default or user defined values in the Workbook palette.
136#
137sub convert_to_html_color {
138
139    my $self     = shift;
140    my $index    = $_[0];
141
142    return 0 unless $index;
143
144    $index -=8; # Adjust colour index
145
146    # _palette is a reference to the colour palette in the Workbook module
147    my @rgb = @{${$self->{_palette}}->[$index]}[0,1,2];
148
149    return sprintf "#%02X%02X%02X", @rgb;
150}
151
152
153###############################################################################
154#
155# get_align_properties()
156#
157# Return properties for an Excel XML <Alignment> element.
158#
159# Excels handling of the vertical align "Bottom" property is different from
160# other properties. It is on by default if any non-vertical property is set.
161# Therefore we set the undefined _text_v_align value to -1 so that we can
162# detect if it has been set by the user. If it hasn't been set then we supply
163# the default "Bottom" value.
164#
165#
166sub get_align_properties {
167
168    my $self  = shift;
169
170    my @align; # Attributes to return
171
172    # Check if any alignment options in the format have been changed.
173    my $changed = (
174                    $self->{_text_h_align}   != 0  ||
175                    $self->{_text_v_align}   != -1 ||
176                    $self->{_indent}         != 0  ||
177                    $self->{_rotation}       != 0  ||
178                    $self->{_text_vertical}  != 0  ||
179                    $self->{_text_wrap}      != 0  ||
180                    $self->{_shrink}         != 0  ||
181                    $self->{_reading_order}  != 0) ? 1 : 0;
182
183
184    return unless $changed;
185
186    # Excel sets 'ss:Vertical="Bottom"' even when it is the default.
187    $self->{_text_v_align} = 2 if $self->{_text_v_align} == -1;
188
189
190    # Check for properties that are mutually exclusive.
191    $self->{_rotation}      = 0 if $self->{_text_vertical};
192    $self->{_shrink}        = 0 if $self->{_text_wrap};
193    $self->{_shrink}        = 0 if $self->{_text_h_align} == 4; # Fill
194    $self->{_shrink}        = 0 if $self->{_text_h_align} == 5; # Justify
195    $self->{_shrink}        = 0 if $self->{_text_h_align} == 7; # Distributed
196    $self->{_just_distrib}  = 0 if $self->{_text_h_align} != 7; # Distributed TODO
197
198
199    push @align, 'ss:Horizontal', 'Left'        if $self->{_text_h_align} == 1;
200    push @align, 'ss:Horizontal', 'Center'      if $self->{_text_h_align} == 2;
201    push @align, 'ss:Horizontal', 'Right'       if $self->{_text_h_align} == 3;
202    push @align, 'ss:Horizontal', 'Fill'        if $self->{_text_h_align} == 4;
203    push @align, 'ss:Horizontal', 'Justify'     if $self->{_text_h_align} == 5;
204    push @align, 'ss:Horizontal', 'CenterAcrossSelection'
205                                                if $self->{_text_h_align} == 6;
206    push @align, 'ss:Horizontal', 'Distributed' if $self->{_text_h_align} == 7;
207
208    push @align, 'ss:Vertical',   'Top'         if $self->{_text_v_align} == 0;
209    push @align, 'ss:Vertical',   'Center'      if $self->{_text_v_align} == 1;
210    push @align, 'ss:Vertical',   'Bottom'      if $self->{_text_v_align} == 2;
211    push @align, 'ss:Vertical',   'Justify'     if $self->{_text_v_align} == 3;
212    push @align, 'ss:Vertical',   'Distributed' if $self->{_text_v_align} == 4;
213
214    push @align, 'ss:Indent',      $self->{_indent}   if $self->{_indent};
215    push @align, 'ss:Rotate',      $self->{_rotation} if $self->{_rotation};
216
217    push @align, 'ss:VerticalText',1                if $self->{_text_vertical};
218    push @align, 'ss:WrapText',    1                if $self->{_text_wrap};
219    push @align, 'ss:ShrinkToFit', 1                if $self->{_shrink};
220
221    # 'Context' is default property for ReadingOrder.
222    push @align, 'ss:ReadingOrder','LeftToRight' if $self->{_reading_order}==1;
223    push @align, 'ss:ReadingOrder','RightToLeft' if $self->{_reading_order}==2;
224
225
226    # TODO
227    #    ss:Horizontal="JustifyDistributed" ss:Vertical="Bottom"
228
229    return @align;
230}
231
232
233###############################################################################
234#
235# get_border_properties()
236#
237# Return properties for an Excel XML <Border> element.
238#
239sub get_border_properties {
240
241    my $self  = shift;
242
243    my @border; # Attributes to return
244
245
246    my %linetypes =(
247                     1 => ['ss:LineStyle' => 'Continuous',   'ss:Weight' => 1],
248                     2 => ['ss:LineStyle' => 'Continuous',   'ss:Weight' => 2],
249                     3 => ['ss:LineStyle' => 'Dash',         'ss:Weight' => 1],
250                     4 => ['ss:LineStyle' => 'Dot',          'ss:Weight' => 1],
251                     5 => ['ss:LineStyle' => 'Continuous',   'ss:Weight' => 3],
252                     6 => ['ss:LineStyle' => 'Double',       'ss:Weight' => 3],
253                     7 => ['ss:LineStyle' => 'Continuous'                    ],
254                     8 => ['ss:LineStyle' => 'Dash',         'ss:Weight' => 2],
255                     9 => ['ss:LineStyle' => 'DashDot',      'ss:Weight' => 1],
256                    10 => ['ss:LineStyle' => 'DashDot',      'ss:Weight' => 2],
257                    11 => ['ss:LineStyle' => 'DashDotDot',   'ss:Weight' => 1],
258                    12 => ['ss:LineStyle' => 'DashDotDot',   'ss:Weight' => 2],
259                    13 => ['ss:LineStyle' => 'SlantDashDot', 'ss:Weight' => 2],
260                   );
261
262
263    for my $position ('_bottom', '_left', '_right', '_top') {
264
265        (my $type = $position)  =~ s/^_//;
266        my @attribs             = ('ss:Position', ucfirst $type);
267        my $position_color      = $position . '_color';
268
269        if (exists $linetypes{$self->{$position}}) {
270
271            push @attribs, @{$linetypes{$self->{$position}}};
272
273            if (my $color = $self->{$position_color}) {
274                $color = $self->convert_to_html_color($color);
275                push @attribs, 'ss:Color', $color;
276            }
277
278            push @border, [@attribs];
279        }
280    }
281
282
283    # Handle diagonal borders. Note that in Excel it is only possible to have
284    # one line type and one colour when both diagonals are in use.
285    if (my $diag_type = $self->{_diag_type}) {
286
287        # Set a default diagonal border style if none was specified.
288        $self->{_diag_border} = 1 if not $self->{_diag_border};
289
290
291        my @attribs = @{$linetypes{$self->{_diag_border}}};
292
293        if (my $color = $self->{_diag_color}) {
294            $color = $self->convert_to_html_color($color);
295            push @attribs, 'ss:Color', $color;
296        }
297
298        if ($diag_type == 1 or $diag_type == 3) {
299            push @border, ["ss:Position", "DiagonalLeft",  @attribs];
300        }
301
302        if ($diag_type == 2 or $diag_type == 3) {
303            push @border, ["ss:Position", "DiagonalRight", @attribs];
304        }
305    }
306
307    return @border;
308}
309
310
311###############################################################################
312#
313# get_font_properties()
314#
315# Return properties for an Excel XML <Font> element.
316#
317sub get_font_properties {
318
319    my $self = shift;
320
321    my @font; # Attributes to return
322
323    my $color =  $self->convert_to_html_color($self->{_color});
324
325
326    push @font, 'ss:FontName', $self->{_font}     if $self->{_font}  ne 'Arial';
327    push @font, 'ss:Size',     $self->{_size}     if $self->{_size}  != 10;
328    push @font, 'ss:Color',    $color             if $self->{_color};
329    push @font, 'ss:Bold',     1                  if $self->{_bold};
330    push @font, 'ss:Italic',   1                  if $self->{_italic};
331
332    push @font, 'ss:StrikeThrough', 1             if $self->{_font_strikeout};
333    push @font, 'ss:Outline',       1             if $self->{_font_outline};
334    push @font, 'ss:Shadow',        1             if $self->{_font_shadow};
335
336    push @font, 'ss:VerticalAlign', 'Superscript' if $self->{_font_script} == 1;
337    push @font, 'ss:VerticalAlign', 'Subscript'   if $self->{_font_script} == 2;
338
339    push @font, 'ss:Underline', 'Single'          if $self->{_underline} == 1;
340    push @font, 'ss:Underline', 'Double'          if $self->{_underline} == 2;
341    push @font, 'ss:Underline', 'SingleAccounting'if $self->{_underline} == 33;
342    push @font, 'ss:Underline', 'DoubleAccounting'if $self->{_underline} == 34;
343
344    push @font, 'x:Family',  $self->{_font_family}   if $self->{_font_family};
345    push @font, 'x:CharSet', $self->{_font_charset}  if $self->{_font_charset};
346
347    return @font;
348}
349
350
351###############################################################################
352#
353# get_interior_properties()
354#
355# Return properties for an Excel XML <Interior> element.
356#
357sub get_interior_properties {
358
359    my $self  = shift;
360
361    # Return undef if the background and foreground colours haven't been set
362    # and the pattern hasn't been set or if it has only been set to solid.
363    # Other patterns will be handled with the default colours.
364    #
365    return if $self->{_fg_color} == 0x00  and
366              $self->{_bg_color} == 0x00  and
367              $self->{_pattern}  <= 0x01;
368
369
370    # Note for XML:
371    #               ss:Color        = _bg_color
372    #               ss:PatternColor = _fg_color
373
374
375    # The following logical statements take care of special cases in relation
376    # to cell colours and patterns:
377    # 1. For a solid fill (_pattern == 1) Excel reverses the role of foreground
378    #    and background colours.
379    # 2. If the user specifies a foreground or background colour without a
380    #    pattern they probably wanted a solid fill, so we fill in the defaults.
381    #
382    if ($self->{_pattern} <= 0x01) {
383        if ($self->{_bg_color}) {
384            return  'ss:Color',
385                    $self->convert_to_html_color($self->{_bg_color}),
386                    'ss:Pattern',
387                    'Solid';
388        }
389        else {
390            return  'ss:Color',
391                    $self->convert_to_html_color($self->{_fg_color}),
392                    'ss:Pattern',
393                    'Solid';
394        }
395    }
396
397
398    # Set default colours if they haven't been set.
399    $self->{_bg_color} = 0x09 if $self->{_bg_color} == 0x00; # 0x09 = white
400    $self->{_fg_color} = 0x08 if $self->{_fg_color} == 0x00; # 0x08 = black
401
402    my %patterns = (
403                     1 => 'Solid',
404                     2 => 'Gray50',
405                     3 => 'Gray75',
406                     4 => 'Gray25',
407                     5 => 'HorzStripe',
408                     6 => 'VertStripe',
409                     7 => 'ReverseDiagStripe',
410                     8 => 'DiagStripe',
411                     9 => 'DiagCross',
412                    10 => 'ThickDiagCross',
413                    11 => 'ThinHorzStripe',
414                    12 => 'ThinVertStripe',
415                    13 => 'ThinReverseDiagStripe',
416                    14 => 'ThinDiagStripe',
417                    15 => 'ThinHorzCross',
418                    16 => 'ThinDiagCross',
419                    17 => 'Gray125',
420                    18 => 'Gray0625',
421                );
422
423    return unless exists $patterns{$self->{_pattern}};
424
425    return  'ss:Color',
426            $self->convert_to_html_color($self->{_bg_color}),
427            'ss:Pattern',
428            $patterns{$self->{_pattern}},
429            'ss:PatternColor',
430            $self->convert_to_html_color($self->{_fg_color});
431}
432
433
434###############################################################################
435#
436# get_num_format_properties()
437#
438# Return properties for an Excel XML <NumberFormat> element.
439#
440sub get_num_format_properties {
441
442    my $self = shift;
443
444    return unless defined $self->{_num_format};
445
446
447    # This hash is here mainly to cater for Spreadsheet::WriteExcel programs
448    # and Excel files that use the in-built format codes. ExcelXML users
449    # should specify the format explicitly.
450    #
451    my %num_format = (
452                    1  => '0',
453                    2  => 'Fixed',
454                    3  => '#,##0',
455                    4  => 'Standard',
456                    5  => '$#,##0;\-$#,##0',
457                    6  => '$#,##0;[Red]\-$#,##0',
458                    7  => '$#,##0.00;\-$#,##0.00',
459                    8  => 'Currency',
460                    9  => '0%',
461                    10 => 'Percent',
462                    11 => 'Scientific',
463                    12 => '#\ ?/?',
464                    13 => '#\ ??/??',
465                    14 => 'Short Date',
466                    15 => 'Medium Date',
467                    16 => 'dd\-mmm',
468                    17 => 'mmm\-yy',
469                    18 => 'Medium Time',
470                    19 => 'Long Time',
471                    20 => 'Short Time',
472                    21 => 'hh:mm:ss',
473                    22 => 'General Date',
474                    37 => '#,##0;\-#,##0',
475                    38 => '#,##0;[Red]\-#,##0',
476                    39 => '#,##0.00;\-#,##0.00',
477                    40 => '#,##0.00;[Red]\-#,##0.00',
478                    41 => '_-* #,##0_-;\-* #,##0_-;_-* "-"_-;_-@_-',
479                    42 => '_-$* #,##0_-;\-$* #,##0_-;_-$* "-"_-;_-@_-',
480                    43 => '_-* #,##0.00_-;\-* #,##0.00_-;_-* "-"??_-;_-@_-',
481                    44 => '_-$* #,##0.00_-;\-$* #,##0.00_-;_-$* "-"??_-;_-@_-',
482                    45 => 'mm:ss',
483                    46 => '[h]:mm:ss',
484                    47 => 'mm:ss.0',
485                    48 => '##0.0E+0',
486                    49 => '@',
487            );
488
489    my $num_format;
490
491    # Num_format is either a built-in code or a user specified string.
492    if (exists $num_format{$self->{_num_format}}) {
493        $num_format = $num_format{$self->{_num_format}};
494    }
495    else {
496        $num_format = $self->{_num_format};
497    }
498
499    return 'ss:Format', $num_format;
500}
501
502
503###############################################################################
504#
505# get_protection_properties()
506#
507# Return properties for an Excel XML <Protection> element.
508#
509sub get_protection_properties {
510
511    my $self = shift;
512
513    my @attribs; # Attributes to return
514
515    push @attribs, 'x:HideFormula', 1 if     $self->{_hidden};
516    push @attribs, 'ss:Protected',  0 if not $self->{_locked};
517
518    return @attribs;
519}
520
521
522###############################################################################
523#
524# get_xf_index()
525#
526# Returns the index used by Worksheet->_XF()
527#
528sub get_xf_index {
529    my $self   = shift;
530
531    return $self->{_xf_index};
532}
533
534
535###############################################################################
536#
537# _get_color()
538#
539# Used in conjunction with the set_xxx_color methods to convert a color
540# string into a number. Color range is 0..63 but we will restrict it
541# to 8..63 to comply with Gnumeric. Colors 0..7 are repeated in 8..15.
542#
543sub _get_color {
544
545    my %colors = (
546                    aqua    => 0x0F,
547                    cyan    => 0x0F,
548                    black   => 0x08,
549                    blue    => 0x0C,
550                    brown   => 0x10,
551                    magenta => 0x0E,
552                    fuchsia => 0x0E,
553                    gray    => 0x17,
554                    grey    => 0x17,
555                    green   => 0x11,
556                    lime    => 0x0B,
557                    navy    => 0x12,
558                    orange  => 0x35,
559                    purple  => 0x14,
560                    red     => 0x0A,
561                    silver  => 0x16,
562                    white   => 0x09,
563                    yellow  => 0x0D,
564                 );
565
566    # Return the default color if undef,
567    return 0x00 unless defined $_[0];
568
569    # or the color string converted to an integer,
570    return $colors{lc($_[0])} if exists $colors{lc($_[0])};
571
572    # or the default color if string is unrecognised,
573    return 0x00 if ($_[0] =~ m/\D/);
574
575    # or an index < 8 mapped into the correct range,
576    return $_[0] + 8 if $_[0] < 8;
577
578    # or the default color if arg is outside range,
579    return 0x00 if $_[0] > 63;
580
581    # or an integer in the valid range
582    return $_[0];
583}
584
585
586###############################################################################
587#
588# set_align()
589#
590# Set cell alignment.
591#
592sub set_align {
593
594    my $self     = shift;
595    my $location = $_[0];
596
597    return if not defined $location;  # No default
598    return if $location =~ m/\d/;     # Ignore numbers
599
600    $location = lc($location);
601
602    $self->set_text_h_align(1) if ($location eq 'left');
603    $self->set_text_h_align(2) if ($location eq 'centre');
604    $self->set_text_h_align(2) if ($location eq 'center');
605    $self->set_text_h_align(3) if ($location eq 'right');
606    $self->set_text_h_align(4) if ($location eq 'fill');
607    $self->set_text_h_align(5) if ($location eq 'justify');
608    $self->set_text_h_align(6) if ($location eq 'center_across');
609    $self->set_text_h_align(6) if ($location eq 'centre_across');
610    $self->set_text_h_align(6) if ($location eq 'merge');        # S:WE name
611    $self->set_text_h_align(7) if ($location eq 'distributed');
612    $self->set_text_h_align(7) if ($location eq 'equal_space');  # ParseExcel
613
614
615    $self->set_text_v_align(0) if ($location eq 'top');
616    $self->set_text_v_align(1) if ($location eq 'vcentre');
617    $self->set_text_v_align(1) if ($location eq 'vcenter');
618    $self->set_text_v_align(2) if ($location eq 'bottom');
619    $self->set_text_v_align(3) if ($location eq 'vjustify');
620    $self->set_text_v_align(4) if ($location eq 'vdistributed');
621    $self->set_text_v_align(4) if ($location eq 'vequal_space'); # ParseExcel
622}
623
624
625###############################################################################
626#
627# set_valign()
628#
629# Set vertical cell alignment. This is required by the set_properties() method
630# to differentiate between the vertical and horizontal properties.
631#
632sub set_valign {
633
634    my $self = shift;
635    $self->set_align(@_);
636}
637
638
639###############################################################################
640#
641# set_center_across()
642#
643# Implements the Excel5 style "merge".
644#
645sub set_center_across {
646
647    my $self     = shift;
648
649    $self->set_text_h_align(6);
650}
651
652
653###############################################################################
654#
655# set_merge()
656#
657# This was the way to implement a merge in Excel5. However it should have been
658# called "center_across" and not "merge".
659# This is now deprecated. Use set_center_across() or better merge_range().
660#
661#
662sub set_merge {
663
664    my $self     = shift;
665
666    $self->set_text_h_align(6);
667}
668
669
670###############################################################################
671#
672# set_bold()
673#
674# Unlike the binary format in Spreadsheet::WriteExcel bold cannot have a
675# "weight". In the XML format it is either on or off.
676#
677sub set_bold {
678
679    my $self = shift;
680    my $bold = shift;
681
682    $bold = 1 if not defined $bold;
683
684    $self->{_bold} = $bold ? 1 : 0;
685}
686
687
688###############################################################################
689#
690# set_border($style)
691#
692# Set cells borders to the same style
693#
694sub set_border {
695
696    my $self  = shift;
697    my $style = $_[0];
698
699    $self->set_bottom($style);
700    $self->set_top($style);
701    $self->set_left($style);
702    $self->set_right($style);
703}
704
705
706###############################################################################
707#
708# set_border_color($color)
709#
710# Set cells border to the same color
711#
712sub set_border_color {
713
714    my $self  = shift;
715    my $color = $_[0];
716
717    $self->set_bottom_color($color);
718    $self->set_top_color($color);
719    $self->set_left_color($color);
720    $self->set_right_color($color);
721}
722
723
724###############################################################################
725#
726# set_rotation($angle)
727#
728# Set the rotation angle of the text. An alignment property.
729#
730sub set_rotation {
731
732    my $self     = shift;
733    my $rotation = $_[0];
734
735    # Argument should be a number
736    return if $rotation !~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/;
737
738    # The arg type can be a double but the Excel dialog only allows integers.
739    $rotation = int $rotation;
740
741    if ($rotation == 270) {
742        # Special case inherited from the S::WE interface.
743        $self->{_text_vertical} = 1;
744        $self->{_rotation}      = 0;
745        return
746    }
747    elsif ($rotation < -90 or $rotation > 90) {
748        carp "Rotation $rotation outside range: -90 <= angle <= 90";
749        $self->{_rotation} = 0;
750        return;
751    }
752
753    # Rotation and vertical text are mutually exclusive
754    $self->{_text_vertical} = 0;
755    $self->{_rotation}      = $rotation;
756}
757
758
759###############################################################################
760#
761# set_properties()
762#
763# Convert hashes of properties to method calls.
764#
765sub set_properties {
766
767    my $self = shift;
768
769    while (@_) {
770        my $key   = shift @_;
771        my $value = shift @_;
772
773        # Strip leading "-" from Tk style properties eg. -color => 'red'.
774        $key =~ s/^-//;
775
776
777        # Make sure method names are alphanumeric characters only, in case
778        # tainted data is passed to the eval().
779        #
780        die "Unknown method: \$self->set_$key\n" if $key =~ /\W/;
781
782
783        # Evaling $value as a string gets around the problem of some
784        # numerical format strings being evaluated as numbers, for example
785        # "00000" for a zip code.
786        #
787        if (defined $value) {
788            eval "\$self->set_$key('$value')";
789        }
790        else {
791            eval "\$self->set_$key(undef)";
792        }
793
794        die $@ if $@; # Re-throw the eval error.
795    }
796}
797
798
799###############################################################################
800#
801# AUTOLOAD. Deus ex machina.
802#
803# Dynamically create set methods that aren't already defined.
804#
805sub AUTOLOAD {
806
807    my $self = shift;
808
809    # Ignore calls to DESTROY
810    return if $AUTOLOAD =~ /::DESTROY$/;
811
812    # Check for a valid method names, ie. "set_xxx_yyy".
813    $AUTOLOAD =~ /.*::set(\w+)/ or die "Unknown method: $AUTOLOAD\n";
814
815    # Match the attribute, ie. "_xxx_yyy".
816    my $attribute = $1;
817
818    # Check that the attribute exists
819    exists $self->{$attribute}  or die "Unknown method: $AUTOLOAD\n";
820
821    # The attribute value
822    my $value;
823
824
825    # There are two types of set methods: set_property() and
826    # set_property_color(). When a method is AUTOLOADED we store a new anonymous
827    # sub in the appropriate slot in the symbol table. The speeds up subsequent
828    # calls to the same method.
829    #
830    no strict 'refs'; # To allow symbol table hackery
831
832    if ($AUTOLOAD =~ /.*::set\w+color$/) {
833        # For "set_property_color" methods
834        $value =  _get_color($_[0]);
835
836        *{$AUTOLOAD} = sub {
837                             my $self  = shift;
838
839                             $self->{$attribute} = _get_color($_[0]);
840                           };
841    }
842    else {
843
844        $value = $_[0];
845        $value = 1 if not defined $value; # The default value is always 1
846
847        *{$AUTOLOAD} = sub {
848                             my $self  = shift;
849                             my $value = shift;
850
851                             $value = 1 if not defined $value;
852                             $self->{$attribute} = $value;
853                           };
854    }
855
856
857    $self->{$attribute} = $value;
858}
859
860
8611;
862
863
864__END__
865
866
867=head1 NAME
868
869Format - A class for defining Excel formatting.
870
871=head1 SYNOPSIS
872
873See the documentation for Spreadsheet::WriteExcelXML
874
875=head1 DESCRIPTION
876
877This module is used in conjunction with Spreadsheet::WriteExcelXML.
878
879=head1 AUTHOR
880
881John McNamara jmcnamara@cpan.org
882
883=head1 PATENT LICENSE
884
885Software programs that read or write files that comply with the Microsoft specifications for the Office Schemas must include the following notice:
886
887"This product may incorporate intellectual property owned by Microsoft Corporation. The terms and conditions upon which Microsoft is licensing such intellectual property may be found at http://msdn.microsoft.com/library/en-us/odcXMLRef/html/odcXMLRefLegalNotice.asp."
888
889=head1 COPYRIGHT
890
891� MM-MMXI, John McNamara.
892
893All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.
894