Data::Google::Visualization::DataTable - Easily create Google DataTable objects

 use Data::Google::Visualization::DataTable;

 my $datatable = Data::Google::Visualization::DataTable->new();

 $datatable->add_columns(
 	{ id => 'date',     label => "A Date",        type => 'date', p => {}},
 	{ id => 'datetime', label => "A Datetime",    type => 'datetime' },
 	{ id => 'timeofday',label => "A Time of Day", type => 'timeofday' },
 	{ id => 'bool',     label => "True or False", type => 'boolean' },
 	{ id => 'number',   label => "Number",        type => 'number' },
 	{ id => 'string',   label => "Some String",   type => 'string' },
 );

 $datatable->add_rows(

 # Add as array-refs
 	[
 		{ v => DateTime->new() },
 		{ v => Time::Piece->new(), f => "Right now!" },
 		{ v => [6, 12, 1], f => '06:12:01' },
 		{ v => 1, f => 'YES' },
 		15.6, # If you're getting lazy
 		{ v => 'foobar', f => 'Foo Bar', p => { display => 'none' } },
 	],

 # And/or as hash-refs (but only if you defined id's for each of your columns)
 	{
 		date      => DateTime->new(),
 		datetime  => { v => Time::Piece->new(), f => "Right now!" },
 		timeofday => [6, 12, 1],
 		bool      => 1,
 		number    => 15.6,
 		string    => { v => 'foobar', f => 'Foo Bar' },
 	},

 );

 # Get the data...

 # Fancy-pants
 my $output = $datatable->output_javascript(
 	columns => ['date','number','string' ],
 	pretty  => 1,
 );

 # Vanilla
 my $output = $datatable->output_javascript();

 Perl:
  date => [ 5, 4, 3 ]
 JS:
  new Date( 5, 4, 3 )

 $object->pedantic(0);

 {"v":new Date( 2011, 2, 21, 2, 6, 25 )}

package Data::Google::Visualization::DataTable;
BEGIN {
  $Data::Google::Visualization::DataTable::VERSION = '0.08';
}

use strict;
use warnings;

use Carp qw(croak carp);
use Storable qw(dclone);
use JSON::XS;
use Time::Local;

sub new {
	my $class = shift;
	my $args  = shift;
	my $self = {
		columns              => [],
		column_mapping       => {},
		rows                 => [],
		json_xs              => JSON::XS->new()->canonical(1)->allow_nonref,
		all_columns_have_ids => 0,
		column_count         => 0,
		pedantic             => 1
	};
	$self->{'properties'} = $args->{'p'} if defined $args->{'p'};
	bless $self, $class;
	return $self;
}

our %ACCEPTABLE_TYPES = map { $_ => 1 } qw(
	date datetime timeofday boolean number string
);

our %JAVASCRIPT_RESERVED = map { $_ => 1 } qw(
	break case catch continue default delete do else finally for function if in
	instanceof new return switch this throw try typeof var void while with
	abstract boolean byte char class const debugger double enum export extends
	final float goto implements import int interface long native package
	private protected public short static super synchronized throws transient
	volatile const export import
);

sub add_columns {
	my ($self, @columns) = @_;

	croak "You can't add columns once you've added rows"
		if @{$self->{'rows'}};

	# Add the columns to our internal store
	for my $column ( @columns ) {

		# Check the type
		my $type = $column->{'type'};
		croak "Every column must have a 'type'" unless $type;
		croak "Unknown column type '$type'" unless $ACCEPTABLE_TYPES{ $type };

		# Check label and ID are sane
		for my $key (qw( label id pattern ) ) {
			if ( $column->{$key} && ref( $column->{$key} ) ) {
				croak "'$key' needs to be a simple string";
			}
		}

		# Check the 'p' column is ok if it was provided, and convert now to JSON
		if ( defined($column->{'p'}) ) {
			eval { $self->json_xs_object->encode( $column->{'p'} ) };
			croak "Serializing 'p' failed: $@" if $@;
		}

		# ID must be unique
		if ( $column->{'id'} ) {
			my $id = $column->{'id'};
			if ( grep { $id eq $_->{'id'} } @{ $self->{'columns'} } ) {
				croak "We already have a column with the id '$id'";
			}
		}

		# Pedantic checking of that ID
		if ( $self->pedantic ) {
			if ( $column->{'id'} ) {
				if ( $column->{'id'} !~ m/^[a-zA-Z0-9_]+$/ ) {
					carp "The API recommends that t ID's should be both simple:"
						. $column->{'id'};
				} elsif ( $JAVASCRIPT_RESERVED{ $column->{'id'} } ) {
					carp "The API recommends avoiding Javascript reserved " .
						"words for IDs: " . $column->{'id'};
				}
			}
		}

		# Add that column to our collection
		push( @{ $self->{'columns'} }, $column );
	}

	# Reset column statistics
	$self->{'column_mapping'} = {};
	$self->{'column_count'  } = 0;
	$self->{'all_columns_have_ids'} = 1;

	# Map the IDs to column indexes, redo column stats, and encode the column
	# data
	my $i = 0;
	for my $column ( @{ $self->{'columns'} } ) {

		$self->{'column_count'}++;

		# Encode as JSON
		delete $column->{'json'};
		my $column_json = $self->json_xs_object->encode( $column );
		$column->{'json'} = $column_json;

		# Column mapping
		if ( $column->{'id'} ) {
			$self->{'column_mapping'}->{ $column->{'id'} } = $i;
		} else {
			$self->{'all_columns_have_ids'} = 0;
		}
		$i++;
	}

	return $self;
}

sub add_rows {
	my ( $self, @rows_to_add ) = @_;

	# Loop over our input rows
	for my $row (@rows_to_add) {

		my @columns;
		my $properties;

		# Map hash-refs to columns
		if ( ref( $row ) eq 'HASH' ) {

			# Grab the properties, if they exist
			if ( exists $self->{'column_mapping'}->{'p'} ) {
				$properties = delete $row->{'_p'};
			} else {
				$properties = delete $row->{'p'};
			}

			# We can't be going forward unless they specified IDs for each of
			# their columns
			croak "All your columns must have IDs if you want to add hashrefs" .
				" as rows" unless $self->{'all_columns_have_ids'};

			# Loop through the keys, populating @columns
			for my $key ( keys %$row ) {
				# Get the relevant column index for the key, or handle 'p'
				# properly
				unless ( exists $self->{'column_mapping'}->{ $key } ) {
					croak "Couldn't find a column with id '$key'";
				}
				my $index = $self->{'column_mapping'}->{ $key };

				# Populate @columns with the data-type and value
				$columns[ $index ] = [
					$self->{'columns'}->[ $index ]->{'type'},
					$row->{ $key }
				];

			}

		# Map array-refs to columns
		} elsif ( ref( $row ) eq 'ARRAY' ) {

			# Populate @columns with the data-type and value
			my $i = 0;
			for my $col (@$row) {
				$columns[ $i ] = [
					$self->{'columns'}->[ $i ]->{'type'},
					$col
				];
				$i++;
			}

		# Rows must be array-refs or hash-refs
		} else {
			croak "Rows must be array-refs or hash-refs: $row";
		}

		# Force the length of columns to be the same as actual columns, to
		# handle undef values better.
		$columns[ $self->{'column_count'} - 1 ] = undef
			unless defined $columns[ $self->{'column_count'} - 1 ];

		# Convert each cell in to the long cell format
		my @formatted_columns;
		for ( @columns ) {
			if ( $_ ) {
				my ($type, $column) = @$_;

				if ( ref( $column ) eq 'HASH' ) {
					# Check f is a simple string if defined
					if ( defined($column->{'f'}) && ref( $column->{'f'} ) ) {
						croak "Cell's 'f' values must be strings: " .
							$column->{'f'};
					}
					# If p is defined, check it serializes
					if ( defined($column->{'p'}) ) {
						croak "'p' must be a reference"
							unless ref( $column->{'p'} );
						eval { $self->json_xs_object->encode( $column->{'p'} ) };
						croak "Serializing 'p' failed: $@" if $@;
					}
					# Complain about any unauthorized keys
					if ( $self->pedantic ) {
						for my $key ( keys %$column ) {
							carp "'$key' is not a recognized key"
								unless $key =~ m/^[fvp]$/;
						}
					}
					push( @formatted_columns, [ $type, $column ] );
				} else {
					push( @formatted_columns, [ $type, { v => $column } ] );
				}
			# Undefined that become nulls
			} else {
				push( @formatted_columns, [ 'null', { v => undef } ] );
			}
		}

		# Serialize each cell
		my @cells;
		for (@formatted_columns) {
			my ($type, $cell) = @$_;

			# Force 'f' to be a string
			if ( defined( $cell->{'f'} ) ) {
				$cell->{'f'} .= '';
			}

			# Handle null/undef
			if ( ! defined($cell->{'v'}) ) {
				push(@cells, $self->json_xs_object->encode( $cell ) );

			# Convert boolean
			} elsif ( $type eq 'boolean' ) {
				$cell->{'v'} = $cell->{'v'} ? \1 : \0;
				push(@cells, $self->json_xs_object->encode( $cell ) );

			# Convert number
			} elsif ( $type eq 'number' ) {
				$cell->{'v'} = 0 unless $cell->{'v'}; # Force false values to 0
				$cell->{'v'} += 0; # Force numeric for JSON encoding
				push(@cells, $self->json_xs_object->encode( $cell ) );

			# Convert string
			} elsif ( $type eq 'string' ) {
				$cell->{'v'} .= '';
				push(@cells, $self->json_xs_object->encode( $cell ) );

			# It's a date!
			} else {
				my @date_digits;

				# Date digits specified manually
				if ( ref( $cell->{'v'} ) eq 'ARRAY' ) {
					@date_digits = @{ $cell->{'v'} };
				# We're going to have to retrieve them ourselves
				} else {
					my @initial_date_digits;

					# Epoch timestamp
					if (! ref( $cell->{'v'} ) ) {
						my ($sec,$min,$hour,$mday,$mon,$year) =
							localtime( $cell->{'v'} );
						@initial_date_digits =
							( $year, $mon, $mday, $hour, $min, $sec );

					} elsif ( $cell->{'v'}->isa('DateTime') ) {
						my $dt = $cell->{'v'};
						@initial_date_digits = (
							$dt->year, ( $dt->mon - 1 ), $dt->day,
							$dt->hour, $dt->min, $dt->sec, $dt->millisecond
						);

					} elsif ( $cell->{'v'}->isa('Time::Piece') ) {
						my $tp = $cell->{'v'};
						@initial_date_digits = (
							$tp->year, $tp->_mon, $tp->mday,
							$tp->hour, $tp->min, $tp->sec
						);

					} else {
						croak "Unknown date format";
					}

					if ( $type eq 'date' ) {
						@date_digits = @initial_date_digits[ 0 .. 2 ];
					} elsif ( $type eq 'datetime' ) {
						@date_digits = @initial_date_digits[ 0 .. 5 ];
					} else { # Time of day
						@date_digits = @initial_date_digits[ 3, -1 ];
					}
				}

				my $json_date = join ', ', @date_digits;
				if ( $type eq 'timeofday' ) {
					$json_date = '[' . $json_date . ']';
				} else {
					$json_date = 'new Date( ' . $json_date . ' )';
				}

				my $placeholder = '%%%PLEHLDER%%%';
				$cell->{'v'} = $placeholder;
				my $json_string = $self->json_xs_object->encode( $cell );
				$json_string =~ s/"$placeholder"/$json_date/;
				push(@cells, $json_string );
			}
		}

		my %data = ( cells => \@cells );
		$data{'properties'} = $properties if defined $properties;

		push( @{ $self->{'rows'} }, \%data );
	}

	return $self;
}

sub pedantic {
	my ($self, $arg) = @_;
	$self->{'pedantic'} = $arg if defined $arg;
	return $self->{'pedantic'};
}

sub set_properties {
	my ( $self, $arg ) = @_;
	$self->{'properties'} = $arg;
	return $self->{'properties'};
}

sub json_xs_object {
	my ($self, $arg) = @_;
	$self->{'json_xs'} = $arg if defined $arg;
	return $self->{'json_xs'};
}

sub output_json { my ( $self, %params ) = @_; $self->output_javascript( %params ) }

sub output_javascript {
	my ($self, %params) = @_;

	my ($columns, $rows) = $self->_select_data( %params );

	my ($t, $s, $n) = ('','','');
	if ( $params{'pretty'} ) {
		$t = "    ";
		$s = " ";
		$n = "\n";
	}

	# Columns
	my $columns_string = join ',' .$n.$t.$t, @$columns;

	# Rows
	my @rows = map {
		my $tt = $t x 3;
		# Turn the cells in to constituent values
		my $individual_row_string = join ',' .$n.$tt.$t, @{$_->{'cells'}};
		# Put together the output itself
		my $output =
			'{' .$n.
			$tt. '"c":[' .$n.
			$tt.$t. $individual_row_string .$n.
			$tt.']';

		# Add properties
		if ( $_->{'properties'} ) {
			my $properties = $self->_encode_properties( $_->{'properties'} );
			$output .= ',' .$n.$tt.'"p":' . $properties;
		}

		$output .= $n.$t.$t.'}';
		$output;
	} @$rows;
	my $rows_string = join ',' . $n . $t . $t, @rows;

	my $return =
		'{' .$n.
		$t.     '"cols": [' .$n.
		$t.     $t.    $columns_string .$n.
		$t.     '],' .$n.
		$t.     '"rows": [' .$n.
		$t.     $t.    $rows_string .$n.
		$t.     ']';

	if ( defined $self->{'properties'} ) {
		my $properties = $self->_encode_properties( $self->{'properties'} );
		$return .= ',' .$n.$t.'"p":' . $properties;
	}

	$return .= $n.'}';
	return $return;
}

sub _select_data {
	my ($self, %params) = @_;

	my $rows    = dclone $self->{'rows'};
	my $columns = [map { $_->{'json'} } @{$self->{'columns'}}];

	# Select certain columns by id only
	if ( $params{'columns'} && @{ $params{'columns'} } ) {
		my @column_spec;

		# Get the name of each column
		for my $column ( @{$params{'columns'}} ) {

		# And push it's place in the array in to our specification
			my $index = $self->{'column_mapping'}->{ $column };
			croak "Couldn't find a column named '$column'" unless
				defined $index;
			push(@column_spec, $index);
		}

		# Grab the column selection
		my @new_columns;
		for my $index (@column_spec) {
			my $column = splice( @{$columns}, $index, 1, '' );
			push(@new_columns, $column);
		}

		# Grab the row selection
		my @new_rows;
		for my $original_row (@$rows) {
			my @new_cells;
			for my $index (@column_spec) {
				my $column = splice( @{$original_row->{'cells'}}, $index, 1, '' );
				push(@new_cells, $column);
			}
			my $new_row = $original_row;
			$new_row->{'cells'} = \@new_cells;

			push(@new_rows, $new_row);
		}

		$rows = \@new_rows;
		$columns = \@new_columns;
	}

	return ( $columns, $rows );
}

sub _encode_properties {
	my ( $self, $properties ) = @_;
	return $self->json_xs_object->encode( $properties );
}

1;