The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Spreadsheet::Perl ;
use 5.006 ;

use Carp ;
use strict ;
use warnings ;

require Exporter ;

our @ISA = qw(Exporter) ;

our %EXPORT_TAGS = 
	(
	'all' => [ qw() ]
	) ;

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ) ;

our @EXPORT ;
push @EXPORT, qw( ) ;

our $VERSION = '0.02' ;

#-------------------------------------------------------------------------------

use Text::ASCIITable 0.12 ;

use Data::TreeDumper ;
$Data::TreeDumper::Useascii = 0 ;

#-------------------------------------------------------------------------------

my @default_table_decoration =
	(
	  ['.','.','-','-']   # .-------------.
	, ['|','|','|']       # | info | info |
	, ['|','|','=','=']   # |=============|
	, ['|','|','|']       # | info | info |
	, ["'","'",'-','-']   # '-------------'
	, ['|','|','-','+']   # |------+------| rowseperator
	) ;
	
sub GenerateASCIITable
{
# The following code was contributed to Spreadsheet::Perl by Håkon Nessjøen <lunatic@cpan.org>

my $ss            = shift ;
my $ranges        = shift ; 
my $display_setup = shift ; 

my $ASCIITable_setup = shift || {} ;

my @table_decoration = @_ ;

@table_decoration = @default_table_decoration unless @table_decoration ;

#-------------------------------------------------------------------------------

my $dump = '' ;

if($display_setup)
	{
	my $NoData = sub
			{
			my $s = shift ;
			
			if('Spreadsheet::Perl' eq ref $s)
				{
				return('HASH', undef, sort grep {! /CELLS/} keys %$s) ;
				}
				
			return(Data::TreeDumper::DefaultNodesToDisplay($s)) ;
			} ;
			
	$dump = DumpTree($ss, 'Setup:', FILTER => $NoData, DISPLAY_ADDRESS => 0) ;
	}

#-------------------------------------------------------------------------------

my ($last_letter, $rows) = $ss->GetLastIndexes() ;

$ranges ||= ["A1:$last_letter$rows"] ;

for my $range (@$ranges)
	{
	my ($address, $is_cell, $start_cell, $end_cell) = $ss->CanonizeAddress($range) ;
	
	my ($start_cell_x, $start_cell_y) = ConvertAdressToNumeric($start_cell) ;
	my ($end_cell_x, $end_cell_y) = ConvertAdressToNumeric($end_cell) ;
	
	my $table = new Text::ASCIITable({ drawRowLine => 1 , %$ASCIITable_setup}) ;
	
	# Column names
	$table->setCols([ map{$ss->Get("$_,0")} (0, $start_cell_x .. $end_cell_x)]) ;
	
	if(exists $ss->{DEBUG}{INLINE_INFORMATION})
		{
		if($ss->{DEBUG}{PRINT_DEPENDENT_LIST})
			{
#			my $dh = $ss->{DEBUG}{ERROR_HANDLE} ;
#			print $dh "PRINT_DEPENDENT_LIST set, calling Recalculate before dumping spreadsheet in table form.\n" ;

			$ss->Recalculate() ;
			}
		}

	for my $row ($start_cell_y .. $end_cell_y) 
		{
		my $cell_values ;
		
		if(exists $ss->{DEBUG}{INLINE_INFORMATION})
			{
			# go through all the cells, heavy and slow process but gives nice debugging info
			
			for my $current_cell ($ss->GetAddressList("$start_cell_x,$row:$end_cell_x,$row"))
				{
				my $cell_value = $ss->Get($current_cell) || '' ;
				my $cell_info = $ss->GetCellInfo($current_cell) ;
				
				push @$cell_values, "$cell_info$cell_value" ;
				}
			}
		else
			{
			# get all the values in one shot
			$cell_values = $ss->Get("$start_cell_x,$row:$end_cell_x,$row") ;
			}
			
		unshift @$cell_values, $ss->Get("\@$row") ;
		
		$table->addRow($cell_values) ;
		}
		
	#------------------------------------------------------------------------
	# page width handling
	use Term::Size::Any ;
	
	my $table_width = $table->getTableWidth() ;
	
	my ($screen_width) = Term::Size::chars *STDOUT{IO} ;
	$screen_width = 78 if $screen_width eq '' ;
	
	my $page_width = $screen_width ;
		
	$page_width = $ASCIITable_setup->{pageWidth} if exists $ASCIITable_setup->{pageWidth} ;

	if($page_width < $table_width)
		{
		my @cuts ;
		
		my $row_header_width = $table->getColWidth($ss->Get("0,0")) + 2 ;
		my $running_width    = $row_header_width ;
		
		for my $column ($start_cell_x .. $end_cell_x)
			{
			my $column_width = $table->getColWidth($ss->Get("$column,0")) ;
			
			if($running_width  + $column_width + 1 >= $page_width)
				{
				push @cuts, ($running_width - $row_header_width) ;
				
				$running_width = $row_header_width + $column_width + 1 ;
				}
			else
				{
				$running_width += $column_width + 1 ;
				}
			}
			
		push @cuts, $table_width ;
			
		my $table_dump = $table->draw(@table_decoration) ;
		
		my @pages ;
		
		while($table_dump =~ /([^\n]+)\n/g)
			{
			my $offset = $row_header_width ;
			my $page = 0 ;
			my $row_header = substr($1, 0, $row_header_width) ;
			
			for my $cut (@cuts)
				{
				$pages[$page] .= $row_header . substr($1, $offset, $cut) . "\n" ;
						 
				$offset += $cut ;
				$page++ ;
				}
			}
			
		unless(exists $ASCIITable_setup->{noPageCount})
			{
			for my $page (0 .. $#pages)
				{
				$pages[$page] .=  "'" . $ss->GetName() . "' " . ($page + 1) . '/' . scalar(@pages) . ".\n" ;
				}
			}
			
		$dump .= join "\n\n", @pages ;
		$dump .= "\n" ;
		}
	else
		{
	#------------------------------------------------------------------------
		$dump .= $table->draw(@table_decoration) . "\n" ;
		}
	}
	
return( $dump ) ;
}

*DumpTable = \&GenerateASCIITable ;

#-------------------------------------------------------------------------------

1 ;

__END__

=head1 NAME

Spreadsheet::Perl::ASCIITable - ASCIITable output for Spreadsheet::Perl

=head1 SYNOPSIS

  print $ss->GenerateASCIITable() ;
  
  # or

  print $ss->DumpTable() ;

=head1 DESCRIPTION

Part of Spreadsheet::Perl.

=head1 AUTHOR

Håkon Nessjøen, <lunatic@cpan.org>

  Copyright (c) 2004 Håkon Nessjøen. All rights reserved.
  This program is free software; you can redistribute it
  and/or modify it under the same terms as Perl itself.
  
=cut