File Coverage

blib/lib/IO/StructuredOutput.pm

Criterion	Covered	Total	%
statement	105	118	88.9
branch	33	54	61.1
condition	9	14	64.2
subroutine	20	20	100.0
pod	7	10	70.0
total	174	216	80.5

package IO::StructuredOutput;


# I think I need to create a worksheet package, that this will inherit from.
# the worksheet will have most of the shit in it.
# I don't know how of if that'll work, but I can't figure out any way
# to make this work right now.
# I should make some test modules to do something similar to what I want,
# but just stick to one output or something.

use 5.00503;
use strict;
use Carp qw(croak);
use Spreadsheet::WriteExcel;
use IO::Scalar;
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );

require Exporter;
use IO::StructuredOutput::Sheets;
use IO::StructuredOutput::Styles;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use IO::StructuredOutput ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
%EXPORT_TAGS = ( 'all' => [ qw(

) ] );

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

@EXPORT = qw(

);

#$VERSION = do { my @r = (q$Revision: 1.8 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker
$VERSION = sprintf '%d.%03d', q$Revision: 1.8 $ =~ /(\d+)/g;

# valid output formats
my %valid_output_format = (
	'html'	=> 1,
	'csv'	=> 1,
	'xls'	=> 1
	);

# Preloaded methods go here.

sub new
{
	my $proto = shift;
	my $class = ref($proto) || $proto;
#	ref(my $class = shift) and croak "class name needed";
	my $self = {
		Format	=> 'html',	# default format
		Sytle	=> '',
		wb   	=> "",
		Sheets	=> [ ]
		};
	bless $self, $class;
}

sub addsheet
{
	ref(my $self = shift) or croak "instance variable needed";
	my $sheetnum = $_[0] || "";
	$sheetnum =~ s/[:*?\/\\]//g;	# get rid of invalid chars
	if ( ($self->format() eq 'xls') && (length($sheetnum) > 31) )
	{	# max length for excel is 31 chars
		$sheetnum = substr($sheetnum,0,31);
	}
	my $sheetcount = $self->sheetcount();
	unless ($sheetnum)
	{
		$sheetnum = "Sheet " . ($sheetcount + 1);
	}
	if ($self->sheetnames($sheetnum))
	{	# name already in use
		croak "Sheet '$sheetnum' already exists";
	}

	$self->add_sheetname($sheetnum);

	my $wb;
	if ( ($self->format() eq 'xls') && (! ref($self->{wb})) )
	{	# need to create a workbook if we haven't already
		my $datablob;
		$self->{wb} = Spreadsheet::WriteExcel->new( IO::Scalar->new_tie(\$datablob) );
		$self->{datablob} = \$datablob;
#	} elsif ( ($self->format() eq 'html') && (! ref($self->{wb})) ){
#		# first sheet added.
#		# may need to do something here
	}

	# need to setup the default style if we haven't already
	if (! $self->defaultstyle())
	{
		$self->{Style} = $self->addstyle();
	}

	my $sheet = IO::StructuredOutput::Sheets->addsheet(
					{
						name	=> $sheetnum,
						format	=> $self->format(),
						style	=> $self->defaultstyle(),
						wb   	=> $self->{wb} } );
	push( @{ $self->{Sheets} }, $sheet);
	return $sheet;
}

sub output
{
	ref(my $self = shift) or croak "instance variable needed";
	# need to do this still
	my $format = $self->format();
	if ($format eq 'csv')
	{	# zip up all "sheets", return zip file
		my $zip = Archive::Zip->new();
		foreach my $sheet ($self->sheets())
		{
			my $member = $zip->addString($sheet->sheet(),$sheet->name());
			$member->desiredCompressionMethod( COMPRESSION_DEFLATED );
		}
		my $zipfile;
		my $zipfh = IO::Scalar->new(\$zipfile);
		$zip->writeToFileHandle( $zipfh );
		return \$zipfile;
	} elsif ($format eq 'html') {
		my $output;
		foreach my $sheet ($self->sheets())
		{
 			$output .= "" . $sheet->name() .
			           "\n\n"; 




138




2





 





 





 





 





10



 			$output .= $sheet->sheet(); 




139




2





 





 





 





 





7



 			$output .= "\n\n";
			$output .= $sheet->sheet();
			$output .= "
		}
		return \$output;
	} elsif ($format eq 'xls') {
		$self->{wb}->close;
		return $self->{datablob};
	}
}

sub format
{	# set output format
	ref(my $self = shift) or croak "instance variable needed";
	if (@_)
	{   # are there any more parameters? (it's a setter)
		my $newformat = shift;
		if ($self->_valid_output_format($newformat))
		{	# it's a valid format, set it
			$self->{Format} = $newformat;
			return $self->{Format};
		} else {
			# invalid output format, return undef
			return;
		}
	} else { # no, it's a getter:
		return $self->{Format};
	}
}

sub defaultstyle
{
	ref(my $self = shift) or croak "instance variable needed";
	if (@_)
	{   # are there any more parameters? (it's a setter)
		my $info = shift;
		$self->{Style} = $self->addstyle($info);
		return $self->{Style};
	} else {
		return $self->{Style};
	}
}

sub addstyle
{
	ref(my $self = shift) or croak "instance variable needed";
	my $info = shift;

	if ( ($self->format() eq 'xls') && (! ref($self->{wb})) )
	{	# need to create a workbook if we haven't already
		my $datablob;
		$self->{wb} = Spreadsheet::WriteExcel->new( IO::Scalar->new_tie(\$datablob) );
		$self->{datablob} = \$datablob;
	}

	my $wbformat;
	if ($self->format() eq 'xls')
	{
		$wbformat = $self->{wb}->add_format();
	}

	my $style = IO::StructuredOutput::Styles->addstyle(
					{
						format	=> $self->format(),
						wbformat => $wbformat,
						wb => $self->{wb}
					} );
	# if they gave us some params, set them up for them
	$style->modify($info) if $info;

	# give them the style object back
	return $style;
}

sub sheetnames
{
	ref(my $self = shift) or croak "instance variable needed";
	if ($_[0])
	{
		return 1 if ($self->{Sheetnames}{$_[0]});
		return;
	} else {
		return keys %{ $self->{Sheetnames} };
	}
}

sub add_sheetname
{
	ref(my $self = shift) or croak "instance variable needed";
	if ($_[0])
	{
		$self->{Sheetnames}{$_[0]}++;
	}
}

sub _valid_output_format
{	# internal method. Can be useful from the outside, but &format
	# already checks this, and they should be using that anyway
	my $either = shift;
	if (ref($either))
	{	# called from instance
		my $testformat = shift;
		return $valid_output_format{$testformat};
	} else {
		return $valid_output_format{$either};
	}
}

sub sheets
{	# returns an array of all sheet objects
	ref(my $self = shift) or croak "instance variable needed";
	return @{ $self->{Sheets} };
}

sub sheetcount
{
	ref(my $self = shift) or croak "instance variable needed";
	return scalar(@{ $self->{Sheets} });
}

1;
__END__