From aef74127ef74114e7fb30d16037b810ed93635d7 Mon Sep 17 00:00:00 2001
From: zhouzhen1 <zhouzhen1@gmail.com>
Date: Sat, 3 Oct 2015 15:42:07 +0800
Subject: add support for having absolute path in internal xml file targets

---
 lib/Spreadsheet/ParseXLSX.pm |  21 ++++++++++++++++-----
 t/data/target-abspath.xlsx   | Bin 0 -> 6927 bytes
 t/target-abspath.t           |  17 +++++++++++++++++
 3 files changed, 33 insertions(+), 5 deletions(-)
 create mode 100644 t/data/target-abspath.xlsx
 create mode 100644 t/target-abspath.t

diff --git a/lib/Spreadsheet/ParseXLSX.pm b/lib/Spreadsheet/ParseXLSX.pm
index ad7f54c..f8daaae 100644
--- a/lib/Spreadsheet/ParseXLSX.pm
+++ b/lib/Spreadsheet/ParseXLSX.pm
@@ -714,6 +714,7 @@ sub _extract_files {
     my $wb_name = ($rels->find_nodes(
         qq<//Relationship[\@Type="$type_base/officeDocument"]>
     ))[0]->att('Target');
+    $wb_name =~ s/^\///;
     my $wb_xml = $self->_parse_xml($zip, $wb_name);
 
     my $path_base = $self->_base_path_for($wb_name);
@@ -722,25 +723,35 @@ sub _extract_files {
         $self->_rels_for($wb_name)
     );
 
+    my $get_path = sub {
+        my ($p) = @_;
+        if ($p !~ /^\//) {
+            return $path_base . $p;
+        } else {
+            $p =~ s/^\///;
+            return $p;
+        }
+    };
+
     my ($strings_xml) = map {
-        $zip->memberNamed($path_base . $_->att('Target'))->contents
+        $zip->memberNamed(&$get_path($_->att('Target')))->contents
     } $wb_rels->find_nodes(qq<//Relationship[\@Type="$type_base/sharedStrings"]>);
 
     my $styles_xml = $self->_parse_xml(
         $zip,
-        $path_base . ($wb_rels->find_nodes(
+        &$get_path(($wb_rels->find_nodes(
             qq<//Relationship[\@Type="$type_base/styles"]>
-        ))[0]->att('Target')
+        ))[0]->att('Target'))
     );
 
     my %worksheet_xml = map {
-        if ( my $sheetfile = $zip->memberNamed($path_base . $_->att('Target'))->contents ) {
+        if ( my $sheetfile = $zip->memberNamed(&$get_path($_->att('Target')))->contents ) {
             ( $_->att('Id') => $sheetfile );
         }
     } $wb_rels->find_nodes(qq<//Relationship[\@Type="$type_base/worksheet"]>);
 
     my %themes_xml = map {
-        $_->att('Id') => $self->_parse_xml($zip, $path_base . $_->att('Target'))
+        $_->att('Id') => $self->_parse_xml($zip, &$get_path($_->att('Target')))
     } $wb_rels->find_nodes(qq<//Relationship[\@Type="$type_base/theme"]>);
 
     return {
diff --git a/t/data/target-abspath.xlsx b/t/data/target-abspath.xlsx
new file mode 100644
index 0000000..2ca7970
Binary files /dev/null and b/t/data/target-abspath.xlsx differ
diff --git a/t/target-abspath.t b/t/target-abspath.t
new file mode 100644
index 0000000..e79445b
--- /dev/null
+++ b/t/target-abspath.t
@@ -0,0 +1,17 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+use Spreadsheet::ParseXLSX;
+
+my $wb;
+eval {
+    $wb = Spreadsheet::ParseXLSX->new->parse('t/data/target-abspath.xlsx');
+};
+if ($@) {
+    diag $@;
+}
+ok((not $@), "parsing target-abspath.xlsx ok");
+
+done_testing;
-- 
cgit v1.2.3-54-g00ecf