File Coverage

blib/lib/Spreadsheet/SimpleExcel.pm

Criterion	Covered	Total	%
statement	272	436	62.3
branch	63	160	39.3
condition	25	54	46.3
subroutine	28	31	90.3
pod	18	18	100.0
total	406	699	58.0

package Spreadsheet::SimpleExcel;

# ABSTRACT: Create Excel files with Perl

use 5.006;
use strict;
use warnings;

use Spreadsheet::WriteExcel;
use IO::Scalar;
use IO::File;
use XML::Writer;

our $VERSION     = '1.92';
our $errstr      = '';

sub new{
  my ($class,%opts) = @_;
  my $self = {};
  $self->{worksheets} = $opts{-worksheets} || [];
  $self->{type}       = 'application/vnd.ms-excel';
  $self->{BIG}        = $opts{-big}        || 0;
  $self->{FILE}       = $opts{-filename}   || '';
  bless($self,$class);

  for my $sheet( @{ $self->{worksheets} } ){
      if( length($sheet->[0]) > 31 ){
          warn "length of worksheet name is greater than 31. It is truncated...";
          $sheet->[0] = substr $sheet->[0], 0, 30;
      }
  }

  $self->_last_sheet('');

  return $self;
}# end new

sub current_sheet{
    my ($self) = @_;
    return $self->_last_sheet;
}

sub add_worksheet{
    my ($self,@array) = @_;
    my ($package,$filename,$line) = caller();
    unless(defined $array[0]){
        $errstr = qq~No worksheet defined at Spreadsheet::SimpleExcel add_worksheet() from
            $filename line $line\n~;
        $array[0] = 'unknown' unless defined $array[0];
        return undef;
    }

    if( length( $array[0] ) > 31 ){
        $errstr = qq~Length of worksheet name has be at most 31~;
        return undef;
    }

    $self->_last_sheet($array[0]);

    if(grep{$_->[0] eq $array[0]}@{$self->{worksheets}}){
        $errstr = qq~Duplicate worksheet-title at Spreadsheet::SimpleExcel add_worksheet() from
            $filename line $line\n~;
        return undef;
    }
    push(@{$self->{worksheets}},[@array]);
    return 1;
}# end add_worksheet

sub _last_sheet{
    my ($self,$title) = @_;

    $self->{last_sheet} = $title if defined $title;

    return $self->{last_sheet};
}

sub del_worksheet{
    my ($self,$title) = @_;
    my ($package,$filename,$line) = caller();

    $title = $self->_last_sheet unless defined $title;
    $self->_last_sheet( $title );

    unless(defined $title){
        $errstr = qq~No worksheet-title defined at Spreadsheet::SimpleExcel del_worksheet() from
            $filename line $line\n~;
        return undef;
    }
    my @worksheets = grep{$_->[0] ne $title}@{$self->{worksheets}};
    $self->{worksheets} = [@worksheets];
}# end del_worksheet

sub add_row{
    my ($self,$title,$arref,$props) = @_;
    my ($package,$filename,$line) = caller();

    if(ref $title eq 'ARRAY'){
        $props  = $arref;
        $arref  = $title;
        $title  = $self->_last_sheet;
    }

    $title = $self->_last_sheet unless $title;
    $self->_last_sheet( $title );

    unless(grep{$_->[0] eq $title}@{$self->{worksheets}}){
        $errstr = qq~Worksheet $title does not exist at Spreadsheet::SimpleExcel add_row() from
            $filename line $line\n~;
        return undef;
    }
    unless(ref($arref) eq 'ARRAY'){
        $errstr = qq~Is not an arrayref at Spreadsheet::SimpleExcel add_row() from
            $filename line $line\n~;
        return undef;
    }
    foreach my $worksheet(@{$self->{worksheets}}){
        if($worksheet->[0] eq $title){
            push(@{$worksheet->[1]->{'-data'}},$arref);
            last;
        }
    }
    return 1;
}# end add_data

sub set_headers{
    my ($self,$title,$arref,$props) = @_;
    my ($package,$filename,$line) = caller();

    if(ref $title eq 'ARRAY'){
        $props  = $arref;
        $arref  = $title;
        $title  = $self->_last_sheet;
    }

    $title ||= $self->_last_sheet;
    $self->_last_sheet( $title );

    unless(grep{$_->[0] eq $title}@{$self->{worksheets}}){
        $errstr = qq~Worksheet $title does not exist at Spreadsheet::SimpleExcel set_headers() from
            $filename line $line\n~;
        return undef;
    }
    unless(ref($arref) eq 'ARRAY'){
        $errstr = qq~Is not an arrayref at Spreadsheet::SimpleExcel set_headers() from
            $filename line $line\n~;
        return undef;
    }
    foreach my $worksheet(@{$self->{worksheets}}){
        if($worksheet->[0] eq $title){
            $worksheet->[1]->{'-headers'} = $arref;
            last;
        }
    }
    return 1;
}# end add_headers

sub set_headers_format{
    my ($self,$title,$arref) = @_;
    my ($package,$filename,$line) = caller();

    if(ref $title eq 'ARRAY'){
        $arref = $title;
        $title = $self->_last_sheet;
    }

    $title = $self->_last_sheet unless defined $title;
    $self->_last_sheet( $title );

    unless(grep{$_->[0] eq $title}@{$self->{worksheets}}){
        $errstr = qq~Worksheet $title does not exist at Spreadsheet::SimpleExcel set_headers_format() from
            $filename line $line\n~;
        return undef;
    }
    unless(ref($arref) eq 'ARRAY'){
        $errstr = qq~Is not an arrayref at Spreadsheet::SimpleExcel set_headers_format() from
            $filename line $line\n~;
        return undef;
    }
    foreach my $worksheet(@{$self->{worksheets}}){
        if($worksheet->[0] eq $title){
            $worksheet->[1]->{'-headers_format'} = $arref;
            last;
        }
    }
    return 1;
}# end add_headers

sub set_data_format{
    my ($self,$title,$arref) = @_;
    my ($package,$filename,$line) = caller();

    if(ref $title eq 'ARRAY'){
        $arref = $title;
        $title = $self->_last_sheet;
    }

    $title = $self->_last_sheet unless defined $title;
    $self->_last_sheet( $title );

    unless(grep{$_->[0] eq $title}@{$self->{worksheets}}){
        $errstr = qq~Worksheet $title does not exist at Spreadsheet::SimpleExcel set_data_format() from
            $filename line $line\n~;
        return undef;
    }
    unless(ref($arref) eq 'ARRAY'){
        $errstr = qq~Is not an arrayref at Spreadsheet::SimpleExcel set_data_format() from
            $filename line $line\n~;
        return undef;
    }
    foreach my $worksheet(@{$self->{worksheets}}){
        if($worksheet->[0] eq $title){
            $worksheet->[1]->{'-data_format'} = $arref;
            last;
        }
    }
    return 1;
}# end add_headers

sub add_row_at{
    my ($self,$title,$index,$arref,$props) = @_;
    my ($package,$filename,$line) = caller();

    if(ref $index eq 'ARRAY'){
        $props = $arref;
        $arref = $index;
        $index = $title;
        $title = $self->_last_sheet;
    }

    $title = $self->_last_sheet unless defined $title;
    $self->_last_sheet( $title );

    unless(grep{$_->[0] eq $title}@{$self->{worksheets}}){
        $errstr = qq~Worksheet $title does not exist at Spreadsheet::SimpleExcel add_row_at() from
            $filename line $line\n~;
        return undef;
    }
    unless(ref($arref) eq 'ARRAY'){
        $errstr = qq~Is not an arrayref at Spreadsheet::SimpleExcel add_row() from
            $filename line $line\n~;
        return undef;
    }
    foreach my $worksheet(@{$self->{worksheets}}){
        if($worksheet->[0] eq $title){
            my @array = @{$worksheet->[1]->{'-data'}};
            if($index =~ /[^\d]/ || $index > $#array){
                $errstr = qq~Index not in Array at Spreadsheet::SimpleExcel add_row_at() from
                    $filename line $line\n~;
                return undef;
            }
            splice(@array,$index,0,$arref);
            $worksheet->[1]->{'-data'} = \@array;
            last;
        }
    }
    return 1;
}# end add_row_at

sub sort_data{
    my ($self,$title,$index,$type) = @_;
    my ($package,$filename,$line) = caller();

    if(scalar @_ == 1){
        $errstr = qq~at least column index is missing ($filename line $line)~;
        return undef;
    }
    elsif(scalar @_ == 2){
        if($title =~ /\D/){
            $errstr = qq~Index not in Array at Spreadsheet::SimpleExcel sort_data() from
                $filename line $line\n~;
            return undef;

        }
        else{
            $index = $title;
            $title = $self->_last_sheet;
        }
    }
    elsif(scalar @_ == 3){
        if($title =~ /^\d+$/ and $index =~ /^ASC|DESC$/){
            $type  = $index;
            $index = $title;
            $title = $self->_last_sheet;
        }
    }

    $title = $self->_last_sheet unless defined $title;
    $type  ||= 'ASC';

    $self->_last_sheet( $title );

    unless(grep{$_->[0] eq $title}@{$self->{worksheets}}){
        $errstr = qq~Worksheet $title does not exist at Spreadsheet::SimpleExcel sort_data() from
            $filename line $line\n~;
        return undef;
    }

    foreach my $worksheet(@{$self->{worksheets}}){
        if($worksheet->[0] eq $title){
            $worksheet->[1]->{sortstring} = '' unless(exists $worksheet->[1]->{sortstring});
            my $join = $worksheet->[1]->{sortstring} =~ /\w/ ? ' || ' : '';
            my @array = @{$worksheet->[1]->{'-data'}};
            last unless(scalar(@array) > 0);
            if($index >= scalar(@{$array[0]})){
                $errstr = qq~Index not in Array at Spreadsheet::SimpleExcel sort_data() from
                    $filename line $line\n~;
                return undef;
            }
            if(not defined $index || $index =~ /\D/){
                $errstr = qq~Index not in Array at Spreadsheet::SimpleExcel sort_data() from
                    $filename line $line\n~;
                return undef;
            }
            if(_is_numeric(\@array,$index)){
                if($type && $type eq 'DESC'){
                    $worksheet->[1]->{sortstring} .= "$join \$b->[$index] <=> \$a->[$index]";
                }
                else{
                    $worksheet->[1]->{sortstring} .= "$join \$a->[$index] <=> \$b->[$index]";
                }
            }
            else{
                if($type && $type eq 'DESC'){
                    $worksheet->[1]->{sortstring} .= "$join \$b->[$index] cmp \$a->[$index]";
                }
                else{
                    $worksheet->[1]->{sortstring} .= "$join \$a->[$index] cmp \$b->[$index]";
                }
            }
            last;
        }
    }
    return 1;
}# end sort_data

sub reset_sort{
    my ($self,$title) = @_;
    my ($package,$filename,$line) = caller();

    $title = $self->_last_sheet unless defined $title;
    $self->_last_sheet( $title );

    unless(grep{$_->[0] eq $title}@{$self->{worksheets}}){
        $errstr = qq~Worksheet $title does not exist at Spreadsheet::SimpleExcel add_row_at() from
            $filename line $line\n~;
        return undef;
    }
    my (@worksheets) = grep{$_->[0] eq $title}@{$self->{worksheets}};
    for my $sheet(@worksheets){
        $sheet->[1]->{sortstring} = '';
    }
}# reset_sort

sub errstr{
    return $errstr;
}# end errstr

sub sort_worksheets{
    my ($self,$type) = @_;
    $type ||= 'ASC';

    my @title_array = map{$_->[0]}@{$self->{worksheets}};
    if( _is_title_numeric(\@title_array) ){
        @{$self->{worksheets}} = sort{$a->[0] <=> $b->[0]}@{$self->{worksheets}};
    }
    else{
        @{$self->{worksheets}} = sort{$a->[0] cmp $b->[0]}@{$self->{worksheets}};
    }
    @{$self->{worksheets}} = reverse(@{$self->{worksheets}}) if($type && $type eq 'DESC');
    return @{$self->{worksheets}};
}# end sort_worksheets

sub _is_numeric{
    my ($arref,$index) = @_;
    foreach(@$arref){
        return 0 if($_->[$index] =~ /[^\d\.]/);
    }
    return 1;
}# end _is_numeric


sub _is_title_numeric{
    my ($arref,$index) = @_;
    foreach(@$arref){
        return 0 if($_ =~ /[^\d\.]/);
    }
    return 1;
}# end _is_numeric

sub _do_sort{
  my ($worksheet) = @_;
  my @array = @{$worksheet->[1]->{'-data'}};
  if(exists  $worksheet->[1]->{sortstring} &&
     defined $worksheet->[1]->{sortstring} &&
             $worksheet->[1]->{sortstring} =~ /\w/){
    $worksheet->[1]->{-data} = [sort{eval($worksheet->[1]->{sortstring})}@array];
  }
}# _do_sort

sub output{
  my ($self,$lines) = @_;
  my ($package,$filename,$line) = caller();
  $lines ||= 32000;
  $lines =~ s/\D//g;
  my $excel = $self->_make_excel($lines);
  unless(defined $excel){
    $errstr = qq~Could not create Spreadsheet at Spreadsheet::SimpleExcel output() from
         $filename line $line\n~;
    return undef;
  }
  print "Content-type: ".$self->{type}."\n\n",
        $excel;
}# end output

sub output_as_string{
  my ($self,$lines) = @_;
  my ($package,$filename,$line) = caller();
  $lines ||= 32000;
  $lines =~ s/\D//g;
  my $excel = $self->_make_excel($lines);
  unless(defined $excel){
    $errstr = qq~Could not create Spreadsheet at Spreadsheet::SimpleExcel output_to_file() from
        $filename line $line\n~;
    return undef;
  }
  return $excel;
}# end output_as_string

sub output_to_file{
  my ($self,$filename,$lines) = @_;
  my ($package,$file,$line) = caller();
  $lines ||= 32000;
  $lines =~ s/\D//g;
  unless($filename){
    if($self->{FILE}){
        $filename = $self->{FILE};
    }
    else{
        $errstr = qq~No filename specified at Spreadsheet::SimpleExcel output_to_file() from
            $file line $line\n~;
        return undef;
    }
  }
  #$filename =~ s/[^A-Za-z0-9_\.\/]//g; #/
  my $excel = $self->_make_excel($lines);
  unless(defined $excel){
    $errstr = qq~Could not create $filename at Spreadsheet::SimpleExcel output_to_file() from
        $file line $line\n~;
    return undef;
  }
  open(EXCEL,">$filename") or die $!;
  binmode EXCEL;
  print EXCEL $excel;
  close EXCEL;
  return 1;
}# end output_to_file

sub output_to_XML{
  my ($self,$filename) = @_;
  my ($package,$file,$line) = caller();
  unless($filename){
    $errstr = qq~No filename specified at Spreadsheet::SimpleExcel output_to_XML() from
        $file line $line\n~;
    return undef;
  }
  unless(scalar(@{$self->{worksheets}}) >= 1){
    $errstr = qq~No worksheets in Spreadsheet~;
    return undef;
  }

  my $fh = IO::File->new(">$filename");
  my $xml = XML::Writer->new(OUTPUT => $fh, DATA_MODE => 1, DATA_INDENT => 2);
  $xml->xmlDecl('UTF-8','yes');
  $xml->startTag('workbook');
  for my $worksheet(@{$self->{worksheets}}){
    my $name = $worksheet->[0];
    $name =~ s~[^\w]~_~g;
    $xml->startTag($name);

    my @headers;
    my @datasets = @{$worksheet->[1]->{-data}};
    if(exists $worksheet->[1]->{-headers}){
      @headers = (@{$worksheet->[1]->{-headers}});
      for(@headers){
        s~[^\w]~_~g;
      }
    }
    else{
      my $var = 'A';
      for(0..scalar(@{$datasets[0]})-1){
        ++$var;
        push(@headers,$var);
      }
    }
    my $row = 0;
    for my $data(@datasets){
      $xml->startTag('Row'.(++$row));
      for my $i(0..scalar(@$data)-1){
        $xml->startTag($headers[$i]);
        $xml->characters($data->[$i]);
        $xml->endTag($headers[$i]);
      }
      $xml->endTag('Row'.$row);
    }

    $xml->endTag($name);
  }
  $xml->endTag('workbook');
  $xml->end();
  $fh->close();
}# output_to_XML

sub _make_excel{
  my ($self,$nr_of_lines) = @_;
  my ($package,$filename,$line) = caller();
  my $c_lines = $nr_of_lines || 32000;
  unless(scalar(@{$self->{worksheets}}) >= 1){
    $errstr = qq~No worksheets in Spreadsheet~;
    return undef;
  }
  my $output;
  tie(*XLS,'IO::Scalar',\$output);
  my $excel;
  unless($excel = new Spreadsheet::WriteExcel(\*XLS)){
    $errstr = qq~Could not create spreadsheet object ($!) from
        $filename line $line~;
    return undef;
  }
  if($self->{BIG}){
    eval{require Spreadsheet::WriteExcel::Big};
    if($@){
      $errstr = $@;
      return undef;
    }
    unless($excel = new Spreadsheet::WriteExcel::Big(\*XLS)){#$fname)){
      $errstr = qq~Could not create spreadsheet object ($!) from
          $filename line $line~;
      return undef;
    }
  }
  #else{
    my @titles = map{$_->[0]}@{$self->{worksheets}};
    foreach my $worksheet(@{$self->{worksheets}}){
      my $sheet = $excel->addworksheet($worksheet->[0]);
      _do_sort($worksheet);
      my $col  = 0;
      my $row  = 0;
      my $page = 2;
      _header2sheet($sheet,$worksheet->[1]->{-headers},$worksheet->[1]->{-headers_format});
      $row++ if(exists $worksheet->[1]->{'-headers'} && scalar(@{$worksheet->[1]->{'-headers'}}) > 0);
      foreach my $data(@{$worksheet->[1]->{-data}}){
        $col = 0;
        if($row >= $c_lines){
          my $title = $worksheet->[0].'_p'.$page;
          while(grep{$_ eq $title}@titles){
            $page++;
            $title = $worksheet->[0].'_p'.$page;
          }
          push(@titles,$title);
          $sheet = $excel->addworksheet($title);
          $row = 0;
          if(scalar(@{$worksheet->[1]->{'-headers'}}) > 0){
            $row = 1;
            _header2sheet($sheet,$worksheet->[1]->{-headers},$worksheet->[1]->{-headers_format});
          }
        }
        my $formatref = $worksheet->[1]->{-data_format};
        foreach my $value(@$data){
          if(defined $formatref && defined $formatref->[$col]){
            if($formatref->[$col] eq 's'){
              $sheet->write_string($row,$col,$value);
            }
            elsif($formatref->[$col] eq 'n'){
              $sheet->write_number($row,$col,$value);
            }
            else{
              $sheet->write($row,$col,$value);
            }
          }
          #elsif($value =~ /^=/){
          #  $sheet->write_string($row,$col,$value);
          #}
          else{
            $sheet->write($row,$col,$value);
          }
          $col++;
        }
        $row++;
      }
    }
    $excel->close();
  #}
  return $output;
}# end _make_excel

sub _header2sheet{
  my ($sheet,$arref,$formatref) = @_;
  my $col = 0;
  foreach(@$arref){
    unless(defined $formatref && defined $formatref->[$col]){
      $sheet->write(0,$col,$_);
    }
    else{
      if($formatref->[$col] eq 's'){
        $sheet->write_string(0,$col,$_);
      }
      elsif($formatref->[$col] eq 'n'){
        $sheet->write_number(0,$col,$_);
      }
      else{
        $sheet->write(0,$col,$_);
      }
    }
    $col++;
  }
}# end _header2sheet

sub sheets{
    my ($self) = @_;
    my @titles = map{$_->[0]}@{$self->{worksheets}};
    return wantarray ? @titles : \@titles;
}# end sheets

1;

__END__