XML::Excel - Perl extension converting Excel files to XML

  use XML::Excel;
  $excel_obj = XML::Excel->new();
  $excel_obj = XML::Excel->new(\%attr);

  $status = $excel_obj->parse_doc(file_name);
  $status = $excel_obj->parse_doc(file_name, \%attr);

  $excel_obj->declare_xml(\%attr);
  $excel_obj->declare_doctype(\%attr);

  $excel_obj->print_xml(file_name, \%attr);

package XML::Excel;

use Spreadsheet::ParseExcel;
use Carp;

#use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require 5.004;
require Exporter;
#require DynaLoader;
require AutoLoader;

@ISA = qw(Exporter);# DynaLoader);

@EXPORT = qw(
	
);
$VERSION = '0.01';

#bootstrap XML::Excel $VERSION;

my $ParseExcel_obj;  #Declared for global usage
my $_error;  #Error container


sub new($;$)
{
	
	my $class = shift;
	my $attr = shift || {};

	my $self =	{  	'error_out' => 0,
		   		'column_headings' => 0,
		   		'column_data' => 0,
		   		'ParseExcel' => 0,
		   		%$attr
			};
		
	bless $self, $class;
	
	if ($attr->{ParseExcel})  ### if custom Spreadsheet::ParseExcel object is provided use it
	{
		$ParseExcel_obj = $attr->{ParseExcel};
		$attr->{ParseExcel} = undef;
	} else {   	      ### else create our own Spreadsheet::ParseExcel object with it's defaults
		$ParseExcel_obj = Spreadsheet::ParseExcel->new();
	}
	
	return $self;
	
}

sub parse_doc
{
	my $class = shift;
	my $file_name = shift || croak "Usage: parse_doc(file_name, [\%attr])";
	my $attr = shift;  # %attr (headings, sub_char)
	
	my $workbook = $ParseExcel_obj->Parse($file_name) or die "Error: $!\n";
	my $worksheet = $workbook->{Worksheet}[0];
				
	$_error = "Problems parsing the file: $file_name  " unless defined($workbook);
	
	croak "$_error" if ($class->{'error_out'} == 1 && $@);
				
	my @col_headings;
	
	$attr->{headings} = 0 unless (exists($attr->{headings}));  ### default headings to 0
	
	if ($attr->{headings} == 0)  ### No headings to be used from file
	{
		if ($class->{column_headings})
		{
			@col_headings = @{$class->{column_headings}};   ### if column_heading are provided
		} 			                                ### by user, use them
			
	}
	#my $line;  ### declare $line outside of scope to be use later
	
	if ($attr->{headings} != 0)
	{		
		my $cols_returned = $get_header->($worksheet, \@col_headings, defined($attr->{sub_char})? $attr->{sub_char}:undef );
		$_error = "There were no columns returned for headers, please check your excel file" if (!$cols_returned);
		croak "$_error" if ($class->{'error_out'} == 1);
					
		return 0 if (!$cols_returned);
	}                                                               	
	
	my @arr_cols_data;   ### declare @arr_cols_data to be used for stacking data
	
	
	#######
	
	my ($cell, $row_count, $cell_count);
			
	for($row_count = $attr->{headings}; defined $worksheet->{MaxRow} && $row_count <= $worksheet->{MaxRow}; $row_count++) 
	{
		my @cols_data;
        	for(my $cell_count = $worksheet->{MinCol}; defined $worksheet->{MaxCol} && $cell_count <= $worksheet->{MaxCol} ; $cell_count++) 
        	{
            		$cell = $worksheet->{Cells}[$row_count][$cell_count];
            		defined($cell) ? push(@cols_data, $cell->Value) : push(@cols_data, undef);            		
        	}
        	$escape_char->(\@cols_data);
        	push(@arr_cols_data, \@cols_data);
    	}
    	
    	$class->{'column_headings'} = \@col_headings;  ### assign reference of @col_headings (xml headers) to object	
	$class->{'column_data'} = \@arr_cols_data;     ### assign reference of @arr_cols_data (xml data) to object

	return 1;
}

sub print_xml
{
	my $class = shift;
	my $file_out = shift || 0;
	my $args = shift || {};  # %attr (file_tag, parent_tag, format)
	
	$args->{file_tag} = "records" unless $args->{file_tag};  #default {parent_tag} to record if not supplied
	$args->{parent_tag} = "record" unless $args->{parent_tag}; 
	$args->{format} = "\t" unless $args->{format};  #default {format} to tab if not supplied
	
	$class->{'document_element'} = $args->{file_tag};  ### Used later for declare_doctype() method
	
	if ($class->{'column_data'} == 0 || ($class->{'column_headings'} == 0 && $class->{'headings'}))
	{
		croak "There is no data to print, make sure that you parsed the document before printing";
	}
	
	###Open file $file_out for output or output to STDOUT
	if ($file_out)
	{
		open FILE_OUT, ">$file_out";
	} else {
		*FILE_OUT = *STDOUT;
	}
	
	print FILE_OUT $class->{'declare_xml'}."\n" if $class->{'declare_xml'};
	###This will replace the non-interpolated $class->{'document_element'} inside the $class->{'declare_doctype'} to get the real value
	###Should be replace with something more practical in the future...
	$class->{'declare_doctype'} =~ s/\$class\-\>\{\'document_element\'\}/$class->{'document_element'}/ if $class->{'declare_doctype'};
	
	print FILE_OUT $class->{'declare_doctype'}."\n" if $class->{'declare_doctype'};
	print FILE_OUT "<$args->{file_tag}>", "\n";	### print initial document tag
		
	### declare the $tag for <$tag> and $loop_num for headers and data index tracking
	my $tag;
	my $loop_num;

	if ($#{$class->{'column_headings'}} > 0)  ### if column headings are provided
	{
	
		foreach $loop_num (0..$#{$class->{'column_data'}})
		{
			print FILE_OUT $args->{format}, "<$args->{parent_tag}>", "\n";
			foreach $tag (0..$#{$class->{'column_headings'}})
			{
				print FILE_OUT $args->{format}, $args->{format}, "<$class->{'column_headings'}[$tag]>$class->{'column_data'}[$loop_num][$tag]</$class->{'column_headings'}[$tag]>\n";
			}
			print FILE_OUT $args->{format}, "</$args->{parent_tag}>", "\n";
		}
	
	} else {  ### if column headings are not provided we default to <tr$loop_num>
		
		foreach $loop_num (0..$#{$class->{'column_data'}})
		{
	       		print FILE_OUT $args->{format}, "<$args->{parent_tag}>", "\n";
			foreach $tag (0..$#{$class->{'column_data'}->[$loop_num]})
			{
				print FILE_OUT $args->{format}, $args->{format}, "<tr$loop_num>$class->{'column_data'}[$loop_num][$tag]</tr$loop_num>\n";
			}
			print FILE_OUT $args->{format}, "</$args->{parent_tag}>", "\n";
		}
	}
	
	print FILE_OUT "</$args->{file_tag}>", "\n";  ### print the final document tag
	
	close FILE_OUT;
	
}

sub declare_xml
{

	my $class = shift;
	my $attr = shift || {};
	
	### Attributes: version, encoding, standalone

	if (exists $attr->{'version'})
	{
		$class->{'declare_xml'} = "<?xml version=\"$attr->{'version'}\"" 
	}
	else
	{
		$csvxml_error = "The version attribute must be specified for declare_xml()\n
								Usage: declare_xml\({version=>1.0, [encoding=>..., standalone=>yes/no]}\)";
		croak "$csvxml_error" if ($class->{'error_out'} == 1);		
	}
	
	$class->{'declare_xml'} .= " encoding=\"$attr->{'encoding'}\"" if exists $attr->{'encoding'};
	if (exists $attr->{'standalone'} && ($attr->{'standalone'} =~ /[yes|no]/))
	{
		$class->{'declare_xml'} .= " standalone=\"$attr->{'standalone'}\""; 
	}
	elsif (!($attr->{'standalone'} =~ /[yes|no]/))
	{
		$csvxml_error = "The standalone attribute must be yes|no for declare_xml()\n
								Usage: declare_xml\({version=>1.0, [encoding=>..., standalone=>yes/no]}\)";
		croak "$csvxml_error" if ($class->{'error_out'} == 1);
	}
	
	$class->{'declare_xml'} .= "?>";
		
	return $class->{'declare_xml'};

}

sub declare_doctype
{
	
	my $class = shift;
	my $attr = shift || {};
	
	### Attributes: source, location1, location2, subset

	$class->{'declare_doctype'} = '<!DOCTYPE $class->{\'document_element\'}';
	if ($attr->{source} eq "SYSTEM" || $attr->{source} eq "PUBLIC")
	{
		$class->{'declare_doctype'} .= " $attr->{'source'}";
	}
	else
	{
		$csvxml_error = "The source attribute is not set correctly";
		croak "$csvxml_error" if ($class->{'error_out'} == 1);
	}
	
	if (exists $attr->{location1} && !(exists $attr->{subset}))
	{
		$class->{'declare_doctype'} .= " \"$attr->{'location1'}\"";
	}
	else
	{
		$csvxml_error = "$attr->{'source'} location1 must be specified";
		croak "$csvxml_error" if ($class->{'error_out'} == 1);
	}
	
	$class->{'declare_doctype'} .= " \"$attr->{'location2'}\"" if exists $attr->{'location2'};
	$class->{'declare_doctype'} .= " [$attr->{'subset'}]" if exists $attr->{'subset'};
	
	
	$class->{'declare_doctype'} .= ">";
	
	return $class->{'declare_doctype'};
	
}

$get_header = sub()
{
	my $worksheet = shift;
	my $ref_col = shift;
	my $sub_char = shift;
	
	my ($cell, $row_count, $cell_count);
			
	for(my $row_count = 0; defined $worksheet->{MaxRow} && $row_count < 1; $row_count++) 
	{
        	for(my $cell_count = $worksheet->{MinCol}; defined $worksheet->{MaxCol} && $cell_count <= $worksheet->{MaxCol} ; $cell_count++) 
        	{
            		$cell = $worksheet->{Cells}[$row_count][$cell_count];
            		defined($cell) ? push(@$ref_col, $cell->Value) : push(@$ref_col, undef);            		
        	}
    	}
	
	
	if (defined($sub_char))
	{
		map {s/^([^a-zA-Z|_|:]|((x|X)(m|M)(l|L)))/$sub_char/g;} @$ref_col;  #convert all beginning \n or \t or \s to '_'	
		map {s/[^a-zA-Z|^-|^.|^0-9|^:]/$sub_char/g;} @$ref_col;
	}
	
	#print __LINE__.": $ref_col->[0]\n";

	if ($ref_col) {return $#$ref_col;}else{return 0;}
};

$escape_char = sub()  ### Escape char per XML 1.0 specifications
{                     ### Needs to be optimized for faster processing
	
	my $arg = shift;
	if (ref($arg) eq 'ARRAY')
	{
		my $arr_index;
		foreach $arr_index (0..$#{$arg})
		{
			@{$arg}[$arr_index] =~ s/\&/\&amp\;/g;
			@{$arg}[$arr_index] =~ s/\</\&lt\;/g;
			@{$arg}[$arr_index] =~ s/\>/\&gt\;/g;
			@{$arg}[$arr_index] =~ s/\'/\&apos\;/g;
			@{$arg}[$arr_index] =~ s/\"/\&quot\;/g;
			@{$arg}[$arr_index] =~ s/([\x80-\xFF])/$XmlUtf8Encode->(ord($1))/ge;
		}
	}
	elsif (ref($arg) eq 'SCALAR')
	{
		${$arg} =~ s/\&/\&amp\;/g;
		${$arg} =~ s/\</\&lt\;/g;
		${$arg} =~ s/\>/\&gt\;/g;
		${$arg} =~ s/\'/\&apos\;/g;
		${$arg} =~ s/\"/\&quot\;/g;	
		${$arg} =~ s/([\x80-\xFF])/$XmlUtf8Encode->(ord($1))/ge;			
	}
	else
	{
		croak "Usage: $escape_char->(\@cols_data) or $escape_char->(\$foo)\n";
	}
		
};

$XmlUtf8Encode = sub() {

    my $n = shift;
    if ($n < 0x80) {
        return chr ($n);
    } elsif ($n < 0x800) {
        return pack ("CC", (($n >> 6) | 0xc0), (($n & 0x3f) | 0x80));
    } elsif ($n < 0x10000) {
        return pack ("CCC", (($n >> 12) | 0xe0), ((($n >> 6) & 0x3f) | 0x80),
                     (($n & 0x3f) | 0x80));
    } elsif ($n < 0x110000) {
        return pack ("CCCC", (($n >> 18) | 0xf0), ((($n >> 12) & 0x3f) | 0x80),
                     ((($n >> 6) & 0x3f) | 0x80), (($n & 0x3f) | 0x80));
    }
    return $n;
};
  

# Preloaded methods go here.

# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__