The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Spreadsheet::Template::Writer::Excel;
our $AUTHORITY = 'cpan:DOY';
$Spreadsheet::Template::Writer::Excel::VERSION = '0.05';
use Moose::Role;

use Class::Load 'load_class';
use List::Util 'first';

with 'Spreadsheet::Template::Writer';

requires 'excel_class';

has excel => (
    is      => 'ro',
    isa     => 'Object',
    lazy    => 1,
    default => sub {
        my $self = shift;
        load_class($self->excel_class);
        $self->excel_class->new($self->_fh);
    },
);

has _fh => (
    is      => 'ro',
    isa     => 'FileHandle',
    lazy    => 1,
    default => sub {
        my $self = shift;
        open my $fh, '>', $self->_output
            or die "Failed to open filehandle: $!";
        binmode $fh;
        return $fh;
    },
);

has _output => (
    is      => 'ro',
    isa     => 'ScalarRef[Maybe[Str]]',
    default => sub { \(my $str) },
);

has _colors => (
    is      => 'ro',
    isa     => 'HashRef[Int]',
    default => sub {
        {
            black   => 8,
            blue    => 12,
            brown   => 16,
            cyan    => 15,
            gray    => 23,
            green   => 17,
            lime    => 11,
            magenta => 14,
            navy    => 18,
            orange  => 53,
            pink    => 33,
            purple  => 20,
            red     => 10,
            silver  => 22,
            white   => 9,
            yellow  => 13,

        }
    },
);

has _formats => (
    is      => 'ro',
    isa     => 'HashRef',
    default => sub { {} },
);

sub write {
    my $self = shift;
    my ($data) = @_;

    $self->_write_workbook($data);

    $self->excel->close;
    return ${ $self->_output };
}

sub _write_workbook {
    my $self = shift;
    my ($data) = @_;

    # XXX no way to write default cell properties

    if (exists $data->{properties}) {
        $self->excel->set_properties(%{ $data->{properties} });
    }

    for my $sheet (@{ $data->{worksheets} }) {
        $self->_write_worksheet($sheet);
    }

    if (exists $data->{selected}) {
        $self->excel->sheets($data->{selected})->activate;
    }
}

sub _write_worksheet {
    my $self = shift;
    my ($data) = @_;

    my $sheet = $self->excel->add_worksheet(
        exists $data->{name} ? ($data->{name}) : ()
    );

    if (exists $data->{tab_color}) {
        $sheet->set_tab_color($self->_color($data->{tab_color}));
    }

    if (exists $data->{zoom}) {
        $sheet->set_zoom($data->{zoom});
    }

    if (exists $data->{hidden}) {
        # XXX this won't work on the first worksheet, since you can't hide
        # active worksheets - need to restructure things a bit to fix this
        $sheet->hide;
    }

    if (exists $data->{selection}) {
        $sheet->set_selection(@{ $data->{selection} });
    }

    if (exists $data->{freeze}) {
        $sheet->freeze_panes(@{ $data->{freeze} });
    }

    if (exists $data->{split}) {
        $sheet->split_panes(@{ $data->{split} });
    }

    if (exists $data->{column_widths}) {
        for my $i (0..$#{ $data->{column_widths} }) {
            # XXX hidden columns?
            $sheet->set_column($i, $i, $data->{column_widths}[$i]);
        }
    }

    if (exists $data->{row_heights}) {
        for my $i (0..$#{ $data->{row_heights} }) {
            # XXX hidden rows?
            $sheet->set_row($i, $data->{row_heights}[$i]);
        }
    }

    for my $row (0..$#{ $data->{cells} }) {
        for my $col (0..$#{ $data->{cells}[$row] }) {
            $self->_write_cell($data->{cells}[$row][$col], $sheet, $row, $col);
        }
    }

    if (exists $data->{merge}) {
        for my $merge (@{ $data->{merge} }) {
            $self->_write_merge($merge, $sheet);
        }
    }

    if (exists $data->{autofilter}) {
        for my $autofilter (@{ $data->{autofilter} }) {
            $sheet->autofilter(
                $autofilter->[0][0],
                $autofilter->[0][1],
                $autofilter->[1][0],
                $autofilter->[1][1],
            );
        }
    }
}

sub _write_cell {
    my $self = shift;
    my ($data, $sheet, $row, $col) = @_;

    my $write_method = 'write';
    if (exists $data->{type}) {
        $write_method = "write_$data->{type}";
    }

    my $format;
    if (exists $data->{format}) {
        $format = $self->_munge_format($data->{format});
    }

    if (defined $data->{formula}) {
        $sheet->write_formula(
            $row, $col,
            $data->{formula},
            (defined $format ? ($format) : (undef)),
            (defined $data->{contents}
                ? ($data->{contents})
                : ()),
        );
    }
    else {
        $sheet->$write_method(
            $row, $col,
            $data->{contents},
            (defined $format ? ($format) : ()),
        );
    }
}

sub _write_merge {
    my $self = shift;
    my ($data, $sheet) = @_;

    my $format;
    if (exists $data->{format}) {
        $format = $self->_munge_format($data->{format});
    }

    if (exists $data->{formula}) {
        $sheet->merge_range_type(
            'formula',
            @{ $data->{range}[0] },
            @{ $data->{range}[1] },
            $data->{formula},
            (defined $format ? ($format) : (undef)),
            (defined $data->{contents}
                ? ($data->{contents})
                : ()),
        );
    }
    else {
        $sheet->merge_range_type(
            $data->{type},
            @{ $data->{range}[0] },
            @{ $data->{range}[1] },
            $data->{contents},
            (defined $format ? ($format) : ()),
        );
    }
}

sub _munge_format {
    my $self = shift;
    my ($format) = @_;

    my %border = (
        none                => 0,
        thin                => 1,
        medium              => 2,
        dashed              => 3,
        dotted              => 4,
        thick               => 5,
        double              => 6,
        hair                => 7,
        medium_dashed       => 8,
        dash_dot            => 9,
        medium_dash_dot     => 10,
        dash_dot_dot        => 11,
        medium_dash_dot_dot => 12,
        slant_dash_dot      => 13,
    );

    my $properties = { %$format };

    if (my $border = delete $properties->{border}) {
        $properties = {
            left   => $border->[0],
            right  => $border->[1],
            top    => $border->[2],
            bottom => $border->[3],
            %$properties,
        };
    }

    if (my $border_color = delete $properties->{border_color}) {
        $properties = {
            left_color   => $border_color->[0],
            right_color  => $border_color->[1],
            top_color    => $border_color->[2],
            bottom_color => $border_color->[3],
            %$properties,
        };
    }

    $properties = {
        map {
            my $v = $properties->{$_};
            $_ => JSON::is_bool($v) ? ($v ? 1 : 0)
                : $_ eq 'left'      ? $border{$v}
                : $_ eq 'right'     ? $border{$v}
                : $_ eq 'top'       ? $border{$v}
                : $_ eq 'bottom'    ? $border{$v}
                : $_ =~ /color/     ? $self->_color($v)
                :                     $v
        } keys %$properties
    };

    return $self->_format($properties);
}

sub _color {
    my $self = shift;
    my ($color) = @_;

    return 64 if !defined($color);

    if (exists $self->_colors->{$color}) {
        return $self->_colors->{$color};
    }
    else {
        my $hex = qr/[0-9a-fA-F]/;
        my ($r, $g, $b) = $color =~ /^#($hex$hex)($hex$hex)($hex$hex)$/;

        my %used_colors = reverse %{ $self->_colors };
        my $new_idx = first { !exists $used_colors{$_} } 8..63;
        die "too many colors" unless defined $new_idx;

        $self->excel->set_custom_color(
            $new_idx,
            map { oct("0x$_") } $r, $g, $b
        );
        $self->_colors->{$color} = $new_idx;

        return $new_idx;
    }
}

sub _format {
    my $self = shift;
    my ($format_properties) = @_;

    my %pattern = (
        none             => 0,
        solid            => 1,
        medium_gray      => 2,
        dark_gray        => 3,
        light_gray       => 4,
        dark_horizontal  => 5,
        dark_vertical    => 6,
        dark_down        => 7,
        dark_up          => 8,
        dark_grid        => 9,
        dark_trellis     => 10,
        light_horizontal => 11,
        light_vertical   => 12,
        light_down       => 13,
        light_up         => 14,
        light_grid       => 15,
        light_trellis    => 16,
        gray_125         => 17,
        gray_0625        => 18,
    );

    if (exists $format_properties->{pattern}) {
        $format_properties->{pattern} = $pattern{$format_properties->{pattern}}
            unless $format_properties->{pattern} =~ /^\d+$/;
    }

    my $key = JSON->new->canonical->encode($format_properties);
    if (exists $self->_formats->{$key}) {
        return $self->_formats->{$key};
    }
    else {
        my $format = $self->excel->add_format(%$format_properties);
        $self->_formats->{$key} = $format;
        return $format;
    }
}

no Moose::Role;

=begin Pod::Coverage

  write

=end Pod::Coverage

=cut

1;