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"; $output .= $sheet->sheet(); $output .= "
\n
\n"; } 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__ # Below is stub documentation for your module. You'd better edit it! =head1 NAME IO::StructuredOutput - Perl OO extension to ease creation of structured data output (html tables, csv files, excel spreadsheets, etc) =head1 SYNOPSIS use IO::StructuredOutput; my $io_so = IO::StructuredOutput->new; $io_so->format('xls'); # or 'html' or 'csv' # optionally setup some styles $io_so->defaultstyle( { bold => 1, font => 'arial', underline => 1 } ); my $style_italic = $io_so->addstyle( { italic => 1 } ); my $style_align = $io_so->addstyle( { align => 'right', bg_color => '24#AAAAAA', color => '25#FF0000' } ); my $ws = $io_so->addsheet('some title'); my $number_of_sheets_currently = $io_so->sheetcount(); my $current_sheet_name = $ws->name(); my $ws2 = $io_so->addsheet('new page'); # add row with default styles $ws->addrow( ['some data','another cell','etc'] ); # add row, with one cell that spans multiple columns $ws->addrow( [ ['data that spans 2 cells/columns',''], 'third cell'] ); # set the style for the whole row $ws2->addrow( ['data','in','the','other','sheet'], $style_italic ); # different style for each cell (undef to use default style) $ws2->addrow( ['more','data','in','this','sheet'], [$style_italic, $style_align, undef, $style_italic, $style_align ] ); my $rows_added_to_first_sheet = $ws->rowcount(); my $output = $io_so->output(); =head1 ABSTRACT IO::StructuredOutput provides a high level abstraction from creating output that is formatted in a structured way (like in tables). Currently, excel, csv, and html table output are supported. csv data is returned in a zip archive xls data is returned as an excel spreadsheet html data is returned as plain text w/ html formatting =head1 DESCRIPTION Provides a high level abstraction from creating output that is formatted in a structured way (like in tables). Currently, excel, csv, and html table output are supported. =head2 REQUIRES IO::Scalar Spreadsheet::WriteExcel Archive::Zip Text::CSV_XS =head2 EXPORT None. =head1 METHODS =over =item C<$io_so = IO::StructuredOutput-Enew;> This creates a new IO::StructuredOutput object. =item C<$io_so-Eformat( $output_format );> Sets the output format for this instance. Valid output formats are 'html', 'csv', or 'xls', for HTML, Comma Separated Values files in a Zip archive, or an Excel spreadsheet respectively. Defaults to 'html'. MUST be called before any other methods if using anything but 'html'. =item C<$io_so-Edefaultstyle( \%options );> This method sets the default style for the output. For 'csv' format, it's basically ignored. Uses the same options as addstyle(). =item C<$style = $io_so-Eaddstyle( \%options );> Create a new Style object. The following options are supported: =over =item C $fontname> $fontname can be anything you want, but it's suggested you use font names that will likely be available on the end users systems, such as 'arial', 'helvetica', 'Times New Roman', etc. =item C $fontsize> $fontsize should be an integer value. =item C "$index#$hex"> =item C "$index#$hex"> B set's the cells background color. B set's the font color. $index should be a number between 8 and 63 inclusively (a limit imposed by excel output). For each unique color passed into an IO::StructuredOutput instance, a unique index number should be used. The index is ignored in csv and html output formats. $hex should consist of three 2 character hex numbers (ie. FFFFFF for white, or 000000 for black). Order is red, green, blue. =item C $bool> =item C $bool> =item C $bool> =item C $bool> =item C $bool> =item C $bool> Set to true (1) to turn option on, or false (0) to turn if off. B, B, and B are currently only effective under the 'xls' format. =item C $horizontal_alignment> Sets the alignment of text in the cells. 'horizontal alignment' should be one of 'center','left', or 'right' =item C $vertical_alignment> Sets the alignment of text in the cells. 'vertical alignment' should be one of 'top','center', or 'bottom' =back =item C<$ws = $io_so-Eaddsheet($title);> Creates a new Sheet object. Adds a new page/sheet/file/table as appropriate for the format being used. $title is optional, but if supplied it must be unique the the IO::StructuredOutput instance, and will be truncated to 31 characters (a limit of Excel spreadsheets). =item C<$number_of_sheets_currently = $io_so-Esheetcount();> Returns the current number of pages/sheets/files/tables in the document. =item C<$current_sheet_name = $ws-Ename();> Returns the name (title) of the sheet object. =item C<$ws-Eaddrow( \@data );> =item C<$ws-Eaddrow( \@data, $style );> =item C<$ws-Eaddrow( \@data, \@styles );> =item C<$ws-Eaddrow( [$data1, [$data_for_two_columns,undef] ], \@styles );> Adds a row of cells to the page/sheet. Each element of \@data represents one cell column that will be filled in. If an item in \@data is an array referance, the first element of that array referance will be used to fill a cell that spans as many columns as there are elements in that array referance. In other words, the resulting row from the last example above would consist of the first column being filled with $data1, and $data_for_two_columns filling a cell that spans the two columns next to it. If $style option is a scalar, that style will be applied to every cell in that row. If $style is an array referance, it must contain the same number of elements as the \@data passed in. $style->[0] will be applied the the data in the first cell which will be filed with the data from $data->[0]. =item C<$rows_added_to_first_sheet = $ws-Erowcount();> Returns the number of rows added to that Sheet object. =item C<$output = $io_so-Eoutput();> =over =item * Build the datafile, and returns a referance to it. =item * It can be accessed by dereferancing it, like so: =over =item C =back =item * A document of 'xls' format will return an Excel document. =item * A document of 'html' format will return an HTML page (without header|footer) as a scalar variable of plain text. =item * A document of 'csv' format will return a Zip file consisting of one file (with it's name set to the $title of the page) for each page added. =back =back =head1 SEE ALSO IO::Scalar Spreadsheet::WriteExcel Archive::Zip Text::CSV_XS =head1 AUTHOR Josh Miller, Ejmiller@purifieddata.netE =head1 COPYRIGHT AND LICENSE Copyright 2003 by Josh Miller This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut