package Spreadsheet::ParseXLSX;

use strict;
use warnings;
use 5.010;

our $VERSION = '0.33'; # VERSION

# ABSTRACT: parse XLSX files

use Archive::Zip 1.34;
use Graphics::ColorUtils 'rgb2hls', 'hls2rgb';
use Scalar::Util 'openhandle';
use Spreadsheet::ParseExcel;
use XML::Twig;

use Spreadsheet::ParseXLSX::Decryptor;
use Spreadsheet::ParseXLSX::Cell;



sub new {
  my $class = shift;
  my (%args) = @_;

  my $self = bless {}, $class;
  $self->{Password} = $args{Password} if defined $args{Password};

  return $self;
}


sub parse {
  my $self = shift;
  my ($file, $formatter) = @_;

  my $zip = Archive::Zip->new;
  my $workbook = Spreadsheet::ParseExcel::Workbook->new;

  if ($self->_check_signature($file)) {
    my $decrypted_file = Spreadsheet::ParseXLSX::Decryptor->open($file, $self->{Password});
    $file = $decrypted_file if $decrypted_file;
  }

  if (openhandle($file)) {
    bless $file, 'IO::File' if ref($file) eq 'GLOB'; # sigh
    my $fh =
      ref($file) eq 'File::Temp'
      ? IO::File->new("<&=" . fileno($file))
      : $file;
    $zip->readFromFileHandle($fh) == Archive::Zip::AZ_OK
      or die "Can't open filehandle as a zip file";
    $workbook->{File} = undef;
    $workbook->{__tempfile} = $file;
  } elsif (ref($file) eq 'SCALAR') {
    open my $fh, '+<', $file
      or die "Can't create filehandle from memory data";
    $zip->readFromFileHandle($fh) == Archive::Zip::AZ_OK
      or die "Can't open scalar ref as a zip file";
    $workbook->{File} = undef;
  } elsif (!ref($file)) {
    $zip->read($file) == Archive::Zip::AZ_OK
      or die "Can't open file '$file' as a zip file";
    $workbook->{File} = $file;
  } else {
    die "First argument to 'parse' must be a filename, open filehandle, or scalar ref";
  }

  return $self->_parse_workbook($zip, $workbook, $formatter);
}

sub _check_signature {
  my $self = shift;
  my ($file) = @_;

  my $signature = '';
  if (openhandle($file)) {
    bless $file, 'IO::File' if ref($file) eq 'GLOB'; # sigh
    $file->read($signature, 2);
    $file->seek(-2, IO::File::SEEK_CUR);
  } elsif (ref($file) eq 'SCALAR') {
    $signature = substr($$file, 0, 2);
  } elsif (!ref($file)) {
    my $fh = IO::File->new($file, 'r');
    $fh->read($signature, 2);
    $fh->close;
  }

  return $signature eq "\xd0\xcf";
}

sub _parse_workbook {
  my $self = shift;
  my ($zip, $workbook, $formatter) = @_;

  my $files = $self->_extract_files($zip);

  my ($version) = $files->{workbook}->find_nodes('//s:fileVersion');
  my ($properties) = $files->{workbook}->find_nodes('//s:workbookPr');

  if ($version) {
    $workbook->{Version} = $version->att('appName')
      . (
      $version->att('lowestEdited')
      ? ('-' . $version->att('lowestEdited'))
      : ("")
      );
  }

  $workbook->{Flg1904} = $self->_xml_boolean($properties->att('date1904'))
    if $properties;

  $workbook->{FmtClass} = $formatter || Spreadsheet::ParseExcel::FmtDefault->new;

  my $themes = $self->_parse_themes((values %{$files->{themes}})[0]); # XXX

  $workbook->{Color} = $themes->{Color};

  my $styles = $self->_parse_styles($workbook, $files->{styles});

  $workbook->{Format} = $styles->{Format};
  $workbook->{FormatStr} = $styles->{FormatStr};
  $workbook->{Font} = $styles->{Font};

  if ($files->{strings}) {
    my %string_parse_data = $self->_parse_shared_strings($files->{strings}, $themes->{Color});
    $workbook->{PkgStr} = $string_parse_data{PkgStr};
    $workbook->{Rich} = $string_parse_data{Rich};
  }

  # $workbook->{StandardWidth} = ...;

  # $workbook->{Author} = ...;

  # $workbook->{PrintArea} = ...;
  # $workbook->{PrintTitle} = ...;

  my @sheets = map {
    my $idx = $_->att('rels:id');
    if ($files->{sheets}{$idx}) {
      my $sheet = Spreadsheet::ParseExcel::Worksheet->new(
        Name => $_->att('name'),
        _Book => $workbook,
        _SheetNo => $idx,
      );
      $sheet->{SheetHidden} = 1 if defined $_->att('state') and $_->att('state') eq 'hidden';
      $self->_parse_sheet($sheet, $files->{sheets}{$idx});

      # Do we have a rels for for this sheet?
      if ( $files->{sheets_rels}
        && $files->{sheets_rels}{$idx})
      {
        # Yes - now parse the rels to extract the hyperlinks
        $self->_parse_sheet_links($sheet, $files->{sheets}{$idx}, $files->{sheets_rels}{$idx});
      }

      ($sheet);
    } else {
      ()
    }
  } $files->{workbook}->find_nodes('//s:sheets/s:sheet');

  $workbook->{Worksheet} = \@sheets;
  $workbook->{SheetCount} = scalar(@sheets);

  my ($node) = $files->{workbook}->find_nodes('//s:workbookView');
  my $selected = $node ? $node->att('activeTab') : undef;
  $workbook->{SelectedSheet} = defined($selected) ? 0 + $selected : 0;

  return $workbook;
}

sub _parse_sheet {
  my $self = shift;
  my ($sheet, $sheet_file) = @_;

  $sheet->{MinRow} = 0;
  $sheet->{MinCol} = 0;
  $sheet->{MaxRow} = -1;
  $sheet->{MaxCol} = -1;
  $sheet->{Selection} = [0, 0];

  my @column_formats;
  my @column_widths;
  my @columns_hidden;
  my @row_heights;
  my @rows_hidden;

  my $default_row_height = 15;
  my $default_column_width = 10;

  my $row_idx = 0;

  my $sheet_xml = $self->_new_twig(
    twig_roots => {
      #XXX need a fallback here, the dimension tag is optional
      's:dimension' => sub {
        my ($twig, $dimension) = @_;

        my ($rmin, $cmin, $rmax, $cmax) = $self->_dimensions($dimension->att('ref'));

        $sheet->{MinRow} = $rmin;
        $sheet->{MinCol} = $cmin;
        $sheet->{MaxRow} = $rmax ? $rmax : -1;
        $sheet->{MaxCol} = $cmax ? $cmax : -1;

        $twig->purge;
      },

      's:headerFooter' => sub {
        my ($twig, $hf) = @_;

        my ($helem, $felem) = map { $hf->first_child("s:$_") } qw(oddHeader oddFooter);
        $sheet->{Header} = $helem->text
          if $helem;
        $sheet->{Footer} = $felem->text
          if $felem;

        $twig->purge;
      },

      's:pageMargins' => sub {
        my ($twig, $margin) = @_;
        map {
          my $key = "\u${_}Margin";
          $sheet->{$key} = defined $margin->att($_) ? $margin->att($_) : 0
        } qw(left right top bottom header footer);

        $twig->purge;
      },

      's:pageSetup' => sub {
        my ($twig, $setup) = @_;
        $sheet->{Scale} =
          defined $setup->att('scale')
          ? $setup->att('scale')
          : 100;
        $sheet->{Landscape} = ($setup->att('orientation') || '') ne 'landscape';
        $sheet->{PaperSize} =
          defined $setup->att('paperSize')
          ? $setup->att('paperSize')
          : 1;
        $sheet->{PageStart} = $setup->att('firstPageNumber');
        $sheet->{UsePage} = $self->_xml_boolean($setup->att('useFirstPageNumber'));
        $sheet->{HorizontalDPI} = $setup->att('horizontalDpi');
        $sheet->{VerticalDPI} = $setup->att('verticalDpi');

        $twig->purge;
      },

      's:mergeCells/s:mergeCell' => sub {
        my ($twig, $merge_area) = @_;

        if (my $ref = $merge_area->att('ref')) {
          my ($topleft, $bottomright) = $ref =~ /([^:]+):([^:]+)/;

          my ($toprow, $leftcol) = $self->_cell_to_row_col($topleft);
          my ($bottomrow, $rightcol) = $self->_cell_to_row_col($bottomright);

          push @{$sheet->{MergedArea}}, [$toprow, $leftcol, $bottomrow, $rightcol,];
        }

        $twig->purge;
      },

      's:sheetFormatPr' => sub {
        my ($twig, $format) = @_;

        $default_row_height = $format->att('defaultRowHeight')
          unless defined $default_row_height;
        $default_column_width = $format->att('baseColWidth')
          unless defined $default_column_width;

        $twig->purge;
      },

      's:col' => sub {
        my ($twig, $col) = @_;

        for my $colnum ($col->att('min') .. $col->att('max')) {
          $column_widths[$colnum - 1] = $col->att('width');
          $column_formats[$colnum - 1] = $col->att('style');
          $columns_hidden[$colnum - 1] = $self->_xml_boolean($col->att('hidden'));
        }

        $twig->purge;
      },

      's:selection' => sub {
        my ($twig, $selection) = @_;

        if (my $cell = $selection->att('activeCell')) {
          $sheet->{Selection} = [$self->_cell_to_row_col($cell)];
        } elsif (my $range = $selection->att('sqref')) {
          my ($topleft, $bottomright) = $range =~ /([^:]+):([^:]+)/;
          $sheet->{Selection} = [$self->_cell_to_row_col($topleft), $self->_cell_to_row_col($bottomright),];
        }

        $twig->purge;
      },

      's:sheetPr/s:tabColor' => sub {
        my ($twig, $tab_color) = @_;

        $sheet->{TabColor} = $self->_color($sheet->{_Book}{Color}, $tab_color);

        $twig->purge;
      },

      's:sheetData/s:row' => sub {
        my ($twig, $row_elt) = @_;
        my $explicit_row_idx = $row_elt->att('r');
        $row_idx = $explicit_row_idx - 1 if defined $explicit_row_idx;

        $row_heights[$row_idx] = $row_elt->att('ht');
        $rows_hidden[$row_idx] = $self->_xml_boolean($row_elt->att('hidden'));

        my $col_idx = 0;
        for my $cell ($row_elt->children('s:c')) {
          my $loc = $cell->att('r');
          my ($row, $col);
          if ($loc) {
            ($row, $col) = $self->_cell_to_row_col($loc);
            if ($row != $row_idx) {
              warn "mismatched coords: got $loc for cell in row $row_idx";
            }
            $col_idx = $col - 1;
          } else {
            ($row, $col) = ($row_idx, $col_idx);
          }
          $sheet->{MaxRow} = $row
            if $sheet->{MaxRow} < $row;
          $sheet->{MaxCol} = $col
            if $sheet->{MaxCol} < $col;
          my $type = $cell->att('t') || 'n';
          my $val_xml;
          if ($type ne 'inlineStr') {
            $val_xml = $cell->first_child('s:v');
          } elsif (defined $cell->first_child('s:is')) {
            $val_xml = ($cell->find_nodes('.//s:t'))[0];
          }
          my $val = $val_xml ? $val_xml->text : undef;

          my $long_type;
          my $Rich;
          if (!defined($val)) {
            $long_type = 'Text';
            $val = '';
          } elsif ($type eq 's') {
            $long_type = 'Text';
            $Rich = $sheet->{_Book}{Rich}->{$val};
            $val = $sheet->{_Book}{PkgStr}[$val];
          } elsif ($type eq 'n') {
            $long_type = 'Numeric';
            $val = defined($val) && $val ne '' ? 0 + $val : undef;
          } elsif ($type eq 'd') {
            $long_type = 'Date';
          } elsif ($type eq 'b') {
            $long_type = 'Text';
            $val = $val ? "TRUE" : "FALSE";
          } elsif ($type eq 'e') {
            $long_type = 'Text';
          } elsif ($type eq 'str' || $type eq 'inlineStr') {
            $long_type = 'Text';
          } else {
            die "unimplemented type $type"; # XXX
          }

          my $format_idx = $cell->att('s') || 0;
          my $format = $sheet->{_Book}{Format}[$format_idx];
          my $formatstr = $sheet->{_Book}{FormatStr}{$format->{FmtIdx}};
          die "unknown format $format_idx" unless $format;

          # see the list of built-in formats below in _parse_styles
          # XXX probably should figure this out from the actual format string,
          # but that's not entirely trivial
          if (grep { $format->{FmtIdx} == $_ } 14 .. 22, 45 .. 47) {
            $long_type = 'Date';
          }

          if ($formatstr =~ /\b(mmm|m|d|yy|h|hh|mm|ss)\b/i) {
            $long_type = 'Date';
          }

          my $formula = $cell->first_child('s:f');
          my $cell = Spreadsheet::ParseXLSX::Cell->new(
            Val => $val,
            Type => $long_type,
            Format => $format,
            FormatNo => $format_idx,
            (
              $formula
              ? (Formula => $formula->text)
              : ()
            ),
            Rich => $Rich,
          );
          $cell->{_Value} = $sheet->{_Book}{FmtClass}->ValFmt($cell, $sheet->{_Book});
          $sheet->{Cells}[$row][$col] = $cell;
          $col_idx++;
        }

        $twig->purge;
        $row_idx++;
      },
    }
  );

  $sheet_xml->parse($sheet_file);

  if ($sheet->{Cells}) {
    # SMELL: we have to connect cells their sheet as well as their position
    for my $r (0 .. $#{$sheet->{Cells}}) {
      my $row = $sheet->{Cells}[$r] or next;
      for my $c (0 .. $#$row) {
        my $cell = $row->[$c] or next;
        $cell->{Sheet} = $sheet;
        $cell->{Row} = $r;
        $cell->{Col} = $c;
      }
    }
  } else {
    $sheet->{MaxRow} = $sheet->{MaxCol} = -1;
  }

  $sheet->{DefRowHeight} = 0 + $default_row_height;
  $sheet->{DefColWidth} = 0 + $default_column_width;
  $sheet->{RowHeight} = [map { defined $_ ? 0 + $_ : 0 + $default_row_height } @row_heights];
  $sheet->{RowHidden} = \@rows_hidden;
  $sheet->{ColWidth} = [map { defined $_ ? 0 + $_ : 0 + $default_column_width } @column_widths];
  $sheet->{ColFmtNo} = \@column_formats;
  $sheet->{ColHidden} = \@columns_hidden;

}

sub _parse_sheet_links {
  my $self = shift;
  my ($sheet, $sheet_file, $rels_file) = @_;

  # First we need to parse the hyperlinks out of the rels XML
  my $rels;

  my $rels_xml = XML::Twig->new(
    twig_roots => {
      'Relationships/Relationship' => sub {
        my $twig = shift;
        my $relationship = shift;

        if ( $relationship->att('Type') eq 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink'
          && $relationship->att('TargetMode') eq 'External')
        {
          # Store the target URL in a hash by relationship id
          $rels->{$relationship->att('Id')} = $relationship->att('Target');
        }

        $twig->purge;
      },
    },
  );

  # Run the parser
  $rels_xml->parse($rels_file);

  # Now iterate over the sheet XML again, this time processing hyperlink entries
  my $sheet_xml = XML::Twig->new(
    twig_roots => {
      'hyperlinks/hyperlink' => sub {
        my $twig = shift;
        my $hyperlink = shift;

        # Work out our row and column
        my ($row, $col) = $self->_cell_to_row_col($hyperlink->att('ref'));

        # Get the cell
        my $cell = $sheet->{Cells}[$row][$col];

        # Do I have a cell?
        unless ($cell) {
          # No - just create an empty value for now
          $cell = $sheet->{Cells}[$row][$col] = Spreadsheet::ParseXLSX::Cell->new();
        }

        # Is this an external hyperlink I've parsed from the rels?
        if ( $hyperlink->att('r:id')
          && $rels
          && $rels->{$hyperlink->att('r:id')})
        {
          # Yes - Check if we need to frig our destination a bit
          my $destination_url = sprintf('%s%s%s', $rels->{$hyperlink->att('r:id')}, $hyperlink->att('location') ? '#' : '', $hyperlink->att('location') || '',);

          # Add the hyperlink
          $cell->{Hyperlink} = [
            $hyperlink->att('display') || $cell->{_Value} || undef, # Description
            $destination_url, # Target
            undef, # Target Frame
            $row, # Start Row
            $row, # End Row
            $col, # Start Column
            $col, # End Column
          ];
        } else {
          # This is an internal hyperlink

          # Add the hyperlink
          $cell->{Hyperlink} = [
            $hyperlink->att('display') || $cell->{_Value} || undef, # Description
            $hyperlink->att('location'), # Target
            undef, # Target Frame
            $row, # Start Row
            $row, # End Row
            $col, # Start Column
            $col, # End Column
          ];
        }

        $twig->purge;
      },
    },
  );

  # Now parse the XML
  $sheet_xml->parse($sheet_file);
}

sub _get_text_and_rich_font_by_cell {
  my $self = shift;
  my ($si, $theme_colors) = @_;

  # XXX
  my %default_font_opts = (
    Height => 12,
    Color => '#000000',
    Name => '',
    Bold => 0,
    Italic => 0,
    Underline => 0,
    UnderlineStyle => 0,
    Strikeout => 0,
    Super => 0,
  );

  my $string_text = '';
  my @rich_font_by_cell;
  for my $subnode ($si->children) {
    if ($subnode->name eq 's:t') {
      $string_text .= $subnode->text;
    } elsif ($subnode->name eq 's:r') {
      for my $chunk ($subnode->children) {
        my $string_length = length($string_text);
        if ($chunk->name eq 's:t') {
          if (!@rich_font_by_cell) {
            push @rich_font_by_cell, [$string_length, Spreadsheet::ParseExcel::Font->new(%default_font_opts)];
          }
          $string_text .= $chunk->text;
        } elsif ($chunk->name eq 's:rPr') {
          my %format_text = %default_font_opts;
          for my $node_format ($chunk->children) {
            if ($node_format->name eq 's:sz') {
              $format_text{Height} = $node_format->att('val');
            } elsif ($node_format->name eq 's:color') {
              $format_text{Color} = $self->_color($theme_colors, $node_format);
            } elsif ($node_format->name eq 's:rFont') {
              $format_text{Name} = $node_format->att('val');
            } elsif ($node_format->name eq 's:b') {
              $format_text{Bold} = 1;
            } elsif ($node_format->name eq 's:i') {
              $format_text{Italic} = 1;
            } elsif ($node_format->name eq 's:u') {
              $format_text{Underline} = 1;
              if (defined $node_format->att('val')) {
                $format_text{UnderlineStyle} = 2;
              } else {
                $format_text{UnderlineStyle} = 1;
              }
            } elsif ($node_format->name eq 's:strike') {
              $format_text{Strikeout} = 1;
            } elsif ($node_format->name eq 's:vertAlign') {
              if ($node_format->att('val') eq 'superscript') {
                $format_text{Super} = 1;
              } elsif ($node_format->att('val') eq 'subscript') {
                $format_text{Super} = 2;
              }
            }
          }
          push @rich_font_by_cell, [$string_length, Spreadsheet::ParseExcel::Font->new(%format_text)];
        }
      }
    } else {
      # $subnode->name is either 's:rPh' or 's:phoneticPr'
      # We ignore phonetic information and do nothing.
    }
  }

  return (
    String => $string_text,
    Rich => \@rich_font_by_cell,
  );
}

sub _parse_shared_strings {
  my $self = shift;
  my ($strings, $theme_colors) = @_;

  my $PkgStr = [];

  my %richfonts;
  if ($strings) {
    my $xml = $self->_new_twig(
      twig_handlers => {
        's:si' => sub {
          my ($twig, $si) = @_;

          my %text_rich = $self->_get_text_and_rich_font_by_cell($si, $theme_colors);
          $richfonts{scalar @$PkgStr} = $text_rich{Rich};
          push @$PkgStr, $text_rich{String};
          $twig->purge;
        },
      }
    );
    $xml->parse($strings);
  }
  return (
    Rich => \%richfonts,
    PkgStr => $PkgStr,
  );
}

sub _parse_themes {
  my $self = shift;
  my ($themes) = @_;

  return {} unless $themes;

  my @color = map { $_->name eq 'drawmain:sysClr' ? $_->att('lastClr') : $_->att('val') } $themes->find_nodes('//drawmain:clrScheme/*/*');

  # this shouldn't be necessary, but the documentation is wrong here
  # see http://stackoverflow.com/questions/2760976/theme-confusion-in-spreadsheetml
  ($color[0], $color[1]) = ($color[1], $color[0]);
  ($color[2], $color[3]) = ($color[3], $color[2]);

  return {Color => \@color,};
}

sub _parse_styles {
  my $self = shift;
  my ($workbook, $styles) = @_;

  # these defaults are from
  # http://social.msdn.microsoft.com/Forums/en-US/oxmlsdk/thread/e27aaf16-b900-4654-8210-83c5774a179c
  my %default_format_str = (
    0 => 'GENERAL',
    1 => '0',
    2 => '0.00',
    3 => '#,##0',
    4 => '#,##0.00',
    5 => '$#,##0_);($#,##0)',
    6 => '$#,##0_);[Red]($#,##0)',
    7 => '$#,##0.00_);($#,##0.00)',
    8 => '$#,##0.00_);[Red]($#,##0.00)',
    9 => '0%',
    10 => '0.00%',
    11 => '0.00E+00',
    12 => '# ?/?',
    13 => '# ??/??',
    14 => 'm/d/yyyy',
    15 => 'd-mmm-yy',
    16 => 'd-mmm',
    17 => 'mmm-yy',
    18 => 'h:mm AM/PM',
    19 => 'h:mm:ss AM/PM',
    20 => 'h:mm',
    21 => 'h:mm:ss',
    22 => 'm/d/yyyy h:mm',
    37 => '#,##0_);(#,##0)',
    38 => '#,##0_);[Red](#,##0)',
    39 => '#,##0.00_);(#,##0.00)',
    40 => '#,##0.00_);[Red](#,##0.00)',
    45 => 'mm:ss',
    46 => '[h]:mm:ss',
    47 => 'mm:ss.0',
    48 => '##0.0E+0',
    49 => '@',
  );

  my %default_format_opts = (
    IgnoreFont => 1,
    IgnoreFill => 1,
    IgnoreBorder => 1,
    IgnoreAlignment => 1,
    IgnoreNumberFormat => 1,
    IgnoreProtection => 1,
    FontNo => 0,
    FmtIdx => 0,
    Lock => 1,
    Hidden => 0,
    AlignH => 0,
    Wrap => 0,
    AlignV => 2,
    Rotate => 0,
    Indent => 0,
    Shrink => 0,
    BdrStyle => [0, 0, 0, 0],
    BdrColor => [undef, undef, undef, undef],
    BdrDiag => [0, 0, undef],
    Fill => [0, undef, undef],
  );

  if (!$styles) {
    # XXX i guess?
    my $font = Spreadsheet::ParseExcel::Font->new(
      Height => 12,
      Color => '#000000',
      Name => '',
    );
    my $format = Spreadsheet::ParseExcel::Format->new(%default_format_opts, Font => $font,);

    return {
      FormatStr => \%default_format_str,
      Font => [$font],
      Format => [$format],
    };
  }

  my %halign = (
    center => 2,
    centerContinuous => 6,
    distributed => 7,
    fill => 4,
    general => 0,
    justify => 5,
    left => 1,
    right => 3,
  );

  my %valign = (
    bottom => 2,
    center => 1,
    distributed => 4,
    justify => 3,
    top => 0,
  );

  my %border = (
    dashDot => 9,
    dashDotDot => 11,
    dashed => 3,
    dotted => 4,
    double => 6,
    hair => 7,
    medium => 2,
    mediumDashDot => 10,
    mediumDashDotDot => 12,
    mediumDashed => 8,
    none => 0,
    slantDashDot => 13,
    thick => 5,
    thin => 1,
  );

  my %fill = (
    darkDown => 7,
    darkGray => 3,
    darkGrid => 9,
    darkHorizontal => 5,
    darkTrellis => 10,
    darkUp => 8,
    darkVertical => 6,
    gray0625 => 18,
    gray125 => 17,
    lightDown => 13,
    lightGray => 4,
    lightGrid => 15,
    lightHorizontal => 11,
    lightTrellis => 16,
    lightUp => 14,
    lightVertical => 12,
    mediumGray => 2,
    none => 0,
    solid => 1,
  );

  my @fills = map {
    my $pattern_type = $_->att('patternType');
    [($pattern_type ? $fill{$pattern_type} : 0), $self->_color($workbook->{Color}, $_->first_child('s:fgColor'), 1), $self->_color($workbook->{Color}, $_->first_child('s:bgColor'), 1),]
  } $styles->find_nodes('//s:fills/s:fill/s:patternFill');

  my @borders = map {
    my $border = $_;
    my ($ddiag, $udiag) = map { $self->_xml_boolean($border->att($_)) } qw(diagonalDown diagonalUp);
    my %borderstyles = map {
      my $e = $border->first_child("s:$_");
      $_ => ($e ? $e->att('style') || 'none' : 'none')
    } qw(left right top bottom diagonal);
    my %bordercolors = map {
      my $e = $border->first_child("s:$_");
      $_ => ($e ? $e->first_child('s:color') : undef)
    } qw(left right top bottom diagonal);
    # XXX specs say "begin" and "end" rather than "left" and "right",
    # but... that's not what seems to be in the file itself (sigh)
    {
      colors => [map { $self->_color($workbook->{Color}, $bordercolors{$_}) } qw(left right top bottom)],
      styles => [map { $border{$borderstyles{$_}} } qw(left right top bottom)],
      diagonal => [(
            $ddiag && $udiag ? 3
          : $ddiag && !$udiag ? 2
          : !$ddiag && $udiag ? 1
          : 0
        ),
        $border{$borderstyles{diagonal}},
        $self->_color($workbook->{Color}, $bordercolors{diagonal}),
      ],
    }
  } $styles->find_nodes('//s:borders/s:border');

  my %format_str = (%default_format_str, (map { $_->att('numFmtId') => $_->att('formatCode') } $styles->find_nodes('//s:numFmts/s:numFmt')),);

  my @font = map {
    my $vert = $_->first_child('s:vertAlign');
    my $under = $_->first_child('s:u');
    my $heightelem = $_->first_child('s:sz');
    # XXX i guess 12 is okay?
    my $height = 0 + ($heightelem ? $heightelem->att('val') : 12);
    my $nameelem = $_->first_child('s:name');
    my $name = $nameelem ? $nameelem->att('val') : '';
    Spreadsheet::ParseExcel::Font->new(
      Height => $height,
      # Attr           => $iAttr,
      # XXX not sure if there's a better way to keep the indexing stuff
      # intact rather than just going straight to #xxxxxx
      # XXX also not sure what it means for the color tag to be missing,
      # just assuming black for now
      Color => (
          $_->first_child('s:color')
        ? $self->_color($workbook->{Color}, $_->first_child('s:color'))
        : '#000000'
      ),
      Super => (
        $vert
        ? (
            $vert->att('val') eq 'superscript' ? 1
          : $vert->att('val') eq 'subscript' ? 2
          : 0
          )
        : 0
      ),
      # XXX not sure what the single accounting and double accounting
      # underline styles map to in xlsx. also need to map the new
      # underline styles
      UnderlineStyle => (
        $under
        # XXX sometimes style xml files can contain just <u/> with no
        # val attribute. i think this means single underline, but not
        # sure
        ? (
           !$under->att('val') ? 1
          : $under->att('val') eq 'single' ? 1
          : $under->att('val') eq 'double' ? 2
          : 0
          )
        : 0
      ),
      Name => $name,

      Bold => $_->has_child('s:b') ? 1 : 0,
      Italic => $_->has_child('s:i') ? 1 : 0,
      Underline => $_->has_child('s:u') ? 1 : 0,
      Strikeout => $_->has_child('s:strike') ? 1 : 0,
    )
  } $styles->find_nodes('//s:fonts/s:font');

  my @format = map {
    my $xml_fmt = $_;
    my $alignment = $xml_fmt->first_child('s:alignment');
    my $protection = $xml_fmt->first_child('s:protection');
    my %ignore = map { ("Ignore$_" => !$self->_xml_boolean($xml_fmt->att("apply$_"))) } qw(Font Fill Border Alignment NumberFormat Protection);
    my %opts = (%default_format_opts, %ignore,);

    $opts{FmtIdx} = 0 + ($xml_fmt->att('numFmtId') || 0);
    $opts{FontNo} = 0 + ($xml_fmt->att('fontId') || 0);
    $opts{Font} = $font[$opts{FontNo}];
    $opts{Fill} = $fills[$xml_fmt->att('fillId') || 0];
    $opts{BdrStyle} = $borders[$xml_fmt->att('borderId') || 0]{styles};
    $opts{BdrColor} = $borders[$xml_fmt->att('borderId') || 0]{colors};
    $opts{BdrDiag} = $borders[$xml_fmt->att('borderId') || 0]{diagonal};

    if ($alignment) {
      $opts{AlignH} = $halign{$alignment->att('horizontal') || 'general'};
      $opts{Wrap} = $self->_xml_boolean($alignment->att('wrapText'));
      $opts{AlignV} = $valign{$alignment->att('vertical') || 'bottom'};
      $opts{Rotate} = $alignment->att('textRotation');
      $opts{Indent} = $alignment->att('indent');
      $opts{Shrink} = $self->_xml_boolean($alignment->att('shrinkToFit'));
      # JustLast => $iJustL,
    }

    if ($protection) {
      $opts{Lock} =
        defined $protection->att('locked')
        ? $self->_xml_boolean($protection->att('locked'))
        : 1;
      $opts{Hidden} = $self->_xml_boolean($protection->att('hidden'));
    }

    # Style    => $iStyle,
    # Key123   => $i123,
    # Merge   => $iMerge,
    # ReadDir => $iReadDir,
    Spreadsheet::ParseExcel::Format->new(%opts)
  } $styles->find_nodes('//s:cellXfs/s:xf');

  return {
    FormatStr => \%format_str,
    Font => \@font,
    Format => \@format,
  };
}

sub _extract_files {
  my $self = shift;
  my ($zip) = @_;

  my $type_base = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships';

  my $rels = $self->_parse_xml($zip, $self->_rels_for(''),);
  my $node = ($rels->find_nodes(qq<//packagerels:Relationship[\@Type="$type_base/officeDocument"]>))[0];
  die "invalid workbook" unless $node;

  my $wb_name = $node->att('Target');
  $wb_name =~ s{^/}{};
  my $wb_xml = $self->_parse_xml($zip, $wb_name);

  my $path_base = $self->_base_path_for($wb_name);
  my $wb_rels = $self->_parse_xml($zip, $self->_rels_for($wb_name),);

  my $get_path = sub {
    my ($p) = @_;

    return $p =~ s{^/}{}
      ? $p
      : $path_base . $p;
  };

  my ($strings_xml) = map { $self->_zip_file_member($zip, $get_path->($_->att('Target'))) } $wb_rels->find_nodes(qq<//packagerels:Relationship[\@Type="$type_base/sharedStrings"]>);

  my ($styles_xml) = map { $self->_parse_xml($zip, $get_path->($_->att('Target'))) } $wb_rels->find_nodes(qq<//packagerels:Relationship[\@Type="$type_base/styles"]>);

  my %worksheet_xml = map { ($_->att('Id') => $self->_zip_file_member($zip, $get_path->($_->att('Target')))) } $wb_rels->find_nodes(qq<//packagerels:Relationship[\@Type="$type_base/worksheet"]>);

  # If we have hyperlinks in cells we need the rels file to get the link details
  my $worksheet_rels_xml;

  # Get each worksheet object
  foreach my $worksheet ($wb_rels->find_nodes(qq<//packagerels:Relationship[\@Type="$type_base/worksheet"]>)) {
    # Split the worksheet xml path so we can
    my @sheetname_parts = split('/', $worksheet->att('Target'));

    # Insert _rels before the sheetname, and amend the filename to have .rels on the end
    my $sheetname = pop(@sheetname_parts);
    push(@sheetname_parts, '_rels');
    push(@sheetname_parts, $sheetname . '.rels');

    # Recreate the file path
    my $rels_name = join('/', @sheetname_parts);

    # Check if we have a rels file
    if (my $relfile = $zip->memberNamed($get_path->($rels_name))) {
      # Add the XML to our hash for access later on
      $worksheet_rels_xml->{$worksheet->att('Id')} = $relfile->contents;
    }
  }

  my %themes_xml = map { $_->att('Id') => $self->_parse_xml($zip, $get_path->($_->att('Target'))) } $wb_rels->find_nodes(qq<//packagerels:Relationship[\@Type="$type_base/theme"]>);

  return {
    workbook => $wb_xml,
    sheets => \%worksheet_xml,
    themes => \%themes_xml,
    (
      $styles_xml ? (styles => $styles_xml)
      : ()
    ),
    (
      $strings_xml ? (strings => $strings_xml)
      : ()
    ),
    (($worksheet_rels_xml && keys(%$worksheet_rels_xml)) ? (sheets_rels => $worksheet_rels_xml) : ()),
  };
}

sub _parse_xml {
  my $self = shift;
  my ($zip, $subfile, $map_xmlns) = @_;

  my $xml = $self->_new_twig;
  $xml->parse($self->_zip_file_member($zip, $subfile));

  return $xml;
}

sub _zip_file_member {
  my $self = shift;
  my ($zip, $name) = @_;

  my @members = $zip->membersMatching(qr/^$name$/i);
  die "no subfile named $name" unless @members;

  return scalar $members[0]->contents;
}

sub _rels_for {
  my $self = shift;
  my ($file) = @_;

  my @path = split '/', $file;
  my $name = pop @path;
  $name = '' unless defined $name;
  push @path, '_rels';
  push @path, "$name.rels";

  return join '/', @path;
}

sub _base_path_for {
  my $self = shift;
  my ($file) = @_;

  my @path = split '/', $file;
  pop @path;

  return join('/', @path) . '/';
}

sub _dimensions {
  my $self = shift;
  my ($dim) = @_;

  my ($topleft, $bottomright) = split ':', $dim;
  $bottomright = $topleft unless defined $bottomright;

  my ($rmin, $cmin) = $self->_cell_to_row_col($topleft);
  my ($rmax, $cmax) = $self->_cell_to_row_col($bottomright);

  return ($rmin, $cmin, $rmax, $cmax);
}

sub _is_merged {
  my ($self, $sheet, $row, $col) = @_;

  return unless $sheet->{MergedArea};

  foreach my $area (@{$sheet->{MergedArea}}) {
    my ($topRow, $leftCol, $bottomRow, $rightCol) = @$area;

    return 1
      if $topRow <= $row
      && $leftCol <= $col
      && $row <= $bottomRow
      && $col <= $rightCol;
  }

  return 0;
}

sub _cell_to_row_col {
  my $self = shift;
  my ($cell) = @_;

  my ($col, $row) = $cell =~ /([A-Z]+)([0-9]+)/;

  my $ncol = 0;
  for my $char (split //, $col) {
    $ncol *= 26;
    $ncol += ord($char) - ord('A') + 1;
  }
  $ncol = $ncol - 1;

  my $nrow = $row - 1;

  return ($nrow, $ncol);
}

sub _xml_boolean {
  my $self = shift;
  my ($bool) = @_;
  return defined($bool) && ($bool eq 'true' || $bool eq '1');
}

sub _color {
  my $self = shift;
  my ($colors, $color_node, $fill) = @_;

  my $color;
  if ($color_node && !$self->_xml_boolean($color_node->att('auto'))) {
    if (defined $color_node->att('indexed')) {
      # see https://rt.cpan.org/Public/Bug/Display.html?id=93065
      if ($fill && $color_node->att('indexed') == 64) {
        return '#FFFFFF';
      } else {
        $color = '#' . Spreadsheet::ParseExcel->ColorIdxToRGB($color_node->att('indexed'));
      }
    } elsif (defined $color_node->att('rgb')) {
      $color = '#' . substr($color_node->att('rgb'), 2, 6);
    } elsif (defined $color_node->att('theme')) {
      my $theme = $colors->[$color_node->att('theme')];
      if (defined $theme) {
        $color = "#$theme";
      } else {
        return;
      }
    }

    $color = $self->_apply_tint($color, $color_node->att('tint'))
      if $color_node->att('tint');
  }

  return $color;
}

sub _apply_tint {
  my $self = shift;
  my ($color, $tint) = @_;

  my ($r, $g, $b) = map { oct("0x$_") } $color =~ /#(..)(..)(..)/;
  my ($h, $l, $s) = rgb2hls($r, $g, $b);

  if ($tint < 0) {
    $l = $l * (1.0 + $tint);
  } else {
    $l = $l * (1.0 - $tint) + (1.0 - 1.0 * (1.0 - $tint));
  }

  return scalar hls2rgb($h, $l, $s);
}

sub _new_twig {
  my $self = shift;
  my %opts = @_;

  return XML::Twig->new(
    map_xmlns => {
      'http://schemas.openxmlformats.org/spreadsheetml/2006/main' => 's',
      'http://schemas.openxmlformats.org/package/2006/relationships' => 'packagerels',
      'http://schemas.openxmlformats.org/officeDocument/2006/relationships' => 'rels',
      'http://schemas.openxmlformats.org/drawingml/2006/main' => 'drawmain',
    },
    no_xxe => 1,
    keep_original_prefix => 1,
    %opts,
  );
}


1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Spreadsheet::ParseXLSX - parse XLSX files

=head1 VERSION

version 0.33

=head1 SYNOPSIS

  use Spreadsheet::ParseXLSX;

  my $parser = Spreadsheet::ParseXLSX->new;
  my $workbook = $parser->parse("file.xlsx");
  # see Spreadsheet::ParseExcel for further documentation

=head1 DESCRIPTION

This module is an adaptor for L<Spreadsheet::ParseExcel> that reads XLSX files.
For documentation about the various data that you can retrieve from these
classes, please see L<Spreadsheet::ParseExcel>,
L<Spreadsheet::ParseExcel::Workbook>, L<Spreadsheet::ParseExcel::Worksheet>,
and L<Spreadsheet::ParseExcel::Cell>.

=head1 METHODS

=head2 new(%opts)

Returns a new parser instance. Takes a hash of parameters:

=over 4

=item Password

Password to use for decrypting encrypted files.

=back

=head2 parse($file, $formatter)

Parses an XLSX file. Parsing errors throw an exception. C<$file> can be either
a filename or an open filehandle. Returns a
L<Spreadsheet::ParseExcel::Workbook> instance containing the parsed data.
The C<$formatter> argument is an optional formatter class as described in L<Spreadsheet::ParseExcel>.

=head1 INCOMPATIBILITIES

This module returns data using classes from L<Spreadsheet::ParseExcel>, so for
the most part, it should just be a drop-in replacement. That said, there are a
couple areas where the data returned is intentionally different:

=over 4

=item Colors

In Spreadsheet::ParseExcel, colors are represented by integers which index into
the color table, and you have to use
C<< Spreadsheet::ParseExcel->ColorIdxToRGB >> in order to get the actual value
out. In Spreadsheet::ParseXLSX, while the color table still exists, cells are
also allowed to specify their color directly rather than going through the
color table. In order to avoid confusion, I normalize all color values in
Spreadsheet::ParseXLSX to their string RGB format (C<"#0088ff">). This affects
the C<Fill>, C<BdrColor>, and C<BdrDiag> properties of formats, and the
C<Color> property of fonts. Note that the default color is represented by
C<undef> (the same thing that C<ColorIdxToRGB> would return).

=item Formulas

Spreadsheet::ParseExcel doesn't support formulas. Spreadsheet::ParseXLSX
provides basic formula support by returning the text of the formula as part of
the cell data. You can access it via C<< $cell->{Formula} >>. Note that the
restriction still holds that formula cell values aren't available unless they
were explicitly provided when the spreadsheet was written.

=back

=head1 BUGS

=over 4

=item Large spreadsheets may cause segfaults on perl 5.14 and earlier

This module internally uses XML::Twig, which makes it potentially subject to
L<Bug #71636 for XML-Twig: Segfault with medium-sized document|https://rt.cpan.org/Public/Bug/Display.html?id=71636>
on perl versions 5.14 and below (the underlying bug with perl weak references
was fixed in perl 5.15.5). The larger and more complex the spreadsheet, the
more likely to be affected, but the actual size at which it segfaults is
platform dependent. On a 64-bit perl with 7.6gb memory, it was seen on
spreadsheets about 300mb and above. You can work around this adding
C<XML::Twig::_set_weakrefs(0)> to your code before parsing the spreadsheet,
although this may have other consequences such as memory leaks.

=item Worksheets without the C<dimension> tag are not supported

=item Intra-cell formatting is discarded

=item Shared formulas are not supported

Shared formula support will require an actual formula parser and quite a bit of
custom logic, since the only thing stored in the document is the formula for
the base cell - updating the cell references in the formulas in the rest of the
cells is handled by the application. Values for these cells are still handled
properly.

=back

In addition, there are still a few areas which are not yet implemented (the
XLSX spec is quite large). If you run into any of those, bug reports are quite
welcome.

Please report any bugs to GitHub Issues at
L<https://github.com/MichaelDaum/spreadsheet-parsexlsx/issues>.

=head1 SEE ALSO

L<Spreadsheet::ParseExcel>: The equivalent, for XLS files.

L<Spreadsheet::XLSX>: An older, less robust and featureful implementation.

=head1 SUPPORT

You can find this documentation for this module with the perldoc command.

    perldoc Spreadsheet::ParseXLSX

You can also look for information at:

=over 4

=item * MetaCPAN

L<https://metacpan.org/release/Spreadsheet-ParseXLSX>

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Spreadsheet-ParseXLSX>

=item * Github

L<https://github.com/MichaelDaum/spreadsheet-parsexlsx>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Spreadsheet-ParseXLSX>

=back

=head1 SPONSORS

Parts of this code were paid for by

=over 4

=item Socialflow L<http://socialflow.com>

=back

=head1 AUTHOR

Jesse Luehrs <doy@tozt.net>

=head1 CONTRIBUTORS

=for stopwords Alexey Mazurin Daryl Anderman Dave Clarke Fitz Elliott FL Gareth Tunley M Conrad Meredith Howard Michael Daum Nick Moore oharakouhei rdboisvert Ricardo Signes Robert Boisvert Steve Simms Stuart Watt theevilapplepie zhouzhen1

=over 4

=item *

Alexey Mazurin <mazurin.alexey@gmail.com>

=item *

Daryl Anderman <daryl@273kelvin.ca>

=item *

Dave Clarke <david_clarke@verizon.net>

=item *

Fitz Elliott <felliott@fiskur.org>

=item *

FL <f20@reckon.co.uk>

=item *

Gareth Tunley <gjtunley@gmail.com>

=item *

M Conrad <mike@nrdvana.net>

=item *

Meredith Howard <mhoward@roomag.org>

=item *

Michael Daum <daum@michaeldaumconsulting.com>

=item *

Nick Moore <nick.moore@strategicdata.com.au>

=item *

oharakouhei <gofue0723@gmail.com>

=item *

rdboisvert <rdbprog@gmail.com>

=item *

Ricardo Signes <rjbs@cpan.org>

=item *

Robert Boisvert <robert.boisvert@PABET-J069H12.sncrcorp.net>

=item *

Steve Simms <steve@deefs.net>

=item *

Stuart Watt <stuart@morungos.com>

=item *

theevilapplepie <theevilapplepie@gmail.com>

=item *

zhouzhen1 <zhouzhen1@gmail.com>

=back

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2024 by Jesse Luehrs.

This is free software, licensed under:

  The MIT (X11) License

=cut
