• Files
• Commits
• Log
• Graph
• Stats

package Local::WriteExcel;

#==============================================================================
# creates xls or xlsx file, provides Spreadsheet::WriteExcel::Simple methods
# write_row(), write_bold_row(), data() & save()
# returns data for use in email attachments and/or saves file to disk
# limited to single worksheet for xlsx file TODO: support multiple worksheets
#==============================================================================

use Spreadsheet::WriteExcel::Simple; # for xls files
use Excel::Writer::XLSX; # for xlsx files
use Data::Printer;
use IO::Scalar;
use IO::All;
use Moo;

use feature 'say';

# supported file types:
my @exts = qw(xls xlsx);

# filename, optionally passed in (if not then need filetype):
has filename => ( is => 'ro' );

# filetype (xls or xlsx); passed in at object creation or captured in builder
# from filename extension (.xls[x]):
has filetype => ( # use builder to trigger on ->new rather than on usage
    is => 'ro',
    isa => sub {
        my $ft = shift; # say $ft;
        die "unsupported filetype $ft" unless grep { $ft eq $_ } @exts;
    },
    builder => 1,
);
sub _build_filetype { # say "Building filetype";
    my $self = shift;
    # only get here if filetype *not* passed into object, so we capture filetype
    # from filename extension, so need to check filename *is* passed:
    $self->filename
        || die "require either filename or filetype in args to object";
    $self->filename =~ m!\.(?<ext>[^\.]+)$!;
    # return extension (xls or xlsx):
    return $+{ext};
}

# for Excel::Writer::XLSX (provides reference to scalar):
has xlsx_data => ( is => 'ro', default => sub { return \my $tmp } );

# xl_object: Spreadsheet::WriteExcel::Simple or Excel::Writer::XLSX object
has xl_object => ( is => 'rwp' ); # set in BUILD block

# set Excel::Writer::XLSX worksheet name:
has worksheet_name => ( is => 'rw', default => 'sheet1', trigger => 1 );
sub _trigger_worksheet_name {
    die "filetype must be xlsx to use worksheet_name"
      unless $_[0]->filetype eq 'xlsx';
}

# new Excel::Writer::XLSX worksheet:
has worksheet => ( is => 'lazy' );
sub _build_worksheet { $_[0]->xl_object->add_worksheet($_[0]->worksheet_name) }

# for Excel::Writer::XLSX write_row():
has row_counter => ( is => 'rw', default => 'A1' ); # 1st data row

# only close xlsx file once:
has xlsx_close_event => ( is => 'rw', predicate => 1 );

sub BUILD {
    my ($self, $args) = @_; # p $self; p $args;

    my $xl_object; # is an Excel::Writer::XLSX or Spreadsheet::WriteExcel::Simple:
    if ( $self->filetype eq 'xlsx' ) {
        my $scalar_ref = IO::Scalar->new($self->xlsx_data); # warn ref $scalar_ref;
        $xl_object = Excel::Writer::XLSX->new($scalar_ref);
    }
    else {
        $xl_object = Spreadsheet::WriteExcel::Simple->new();
    }
    $self->_set_xl_object($xl_object);
}

#===============================================================================
sub write_bold_row {
    my $self = shift;
    my $ref  = shift; # aref

    my $xl = $self->xl_object;
    if ( $self->filetype eq 'xls' ) {
        $xl->write_bold_row($ref);
    }
    else {
        my $hdr_format = $xl->add_format(bold => 1);
        $self->_write_xlsx_row($ref, $hdr_format);
    }
}

#-------------------------------------------------------------------------------
sub write_row {
    my $self = shift;
    my $ref  = shift; # aref

    if ( $self->filetype eq 'xls' ) {
        $self->xl_object->write_row($ref);
    }
    else {
        $self->_write_xlsx_row($ref);
    }
}

#-------------------------------------------------------------------------------
# return data in format eg for email attachment:
sub data {
    my $self = shift; # p $self;
    if ( $self->filetype eq 'xls' ) {
        return $self->xl_object->data;
    }
    else {
        $self->_close_xlsx_file; # only if 1st time called
        return ${ $self->xlsx_data };
    }
}

#-------------------------------------------------------------------------------
sub save {
    my ($self, $filename) = @_;
    # filename optional, may already have been provided in object creation
    # could also be overridden by passing in a new value:
    $filename ||= $self->filename or die 'cannot call save() without a '
        . 'filename arg unless already provided at object construction';

    if ( $self->filetype eq 'xls' ) {
        $self->xl_object->save($filename);
    }
    else {
        $self->_close_xlsx_file; # only if 1st time called
        io($filename)->print(${ $self->xlsx_data });
    }
}

#-------------------------------------------------------------------------------
sub _write_xlsx_row {
    my ($self, $ref, $format) = @_; # format optional

    my $row = $self->row_counter; # p $row;
    $self->worksheet->write_row($row, $ref, $format); # A1, A2, A3, A4, etc
    # auto-increment & set new row counter:
    $self->row_counter(++$row);
}

#-------------------------------------------------------------------------------
# closes xlsx file (if 1st time called) to allow data return or printing:
sub _close_xlsx_file {
    my $self = shift; # p $self->has_xlsx_close_event;
    # return if already closed (maybe doesn't matter if closed more than once):
    return if $self->has_xlsx_close_event; # warn 'here';
    # xl_object->close returns true if it succeeds:
    $self->xlsx_close_event( $self->xl_object->close );
}

1;