view release on metacpan or  search on metacpan

lib/Spreadsheet/HTML.pm  view on Meta::CPAN

sub calculator      { Spreadsheet::HTML::Presets::Calculator::calculator( @_ ) }
sub chess           { Spreadsheet::HTML::Presets::Chess::chess(         @_ ) }
sub checkers        { Spreadsheet::HTML::Presets::Draughts::draughts(   @_ ) }
sub draughts        { Spreadsheet::HTML::Presets::Draughts::draughts(   @_ ) }
sub tictactoe       { Spreadsheet::HTML::Presets::TicTacToe::tictactoe( @_ ) }
sub sudoku          { Spreadsheet::HTML::Presets::Sudoku::sudoku(   @_ ) }
sub checkerboard    { Spreadsheet::HTML::Presets::checkerboard(     @_ ) }
sub calendar        { Spreadsheet::HTML::Presets::calendar(         @_ ) }
sub scroll          { Spreadsheet::HTML::Presets::Scroll::scroll(   @_ ) }
sub maze            { Spreadsheet::HTML::Presets::maze(             @_ ) }
sub banner          { Spreadsheet::HTML::Presets::banner(           @_ ) }
sub beadwork        { Spreadsheet::HTML::Presets::Beadwork::beadwork( @_ ) }

sub generate {
    my %args = _process( @_ );

    $args{theta} *= -1 if $args{theta} and $args{flip};

    if (!$args{theta}) { # north

        $args{data} = $args{flip} ? [ map [ CORE::reverse @$_ ], @{ $args{data} } ] : $args{data};

    } elsif ($args{theta} == -90) {

        $args{data} = [ CORE::reverse @{ _transpose( $args{data} ) }];
        $args{data} = ($args{pinhead} and !$args{headless})
            ? [ map [ @$_[1 .. $#$_], $_->[0] ], @{ $args{data} } ]
            : [ map [ CORE::reverse @$_ ], @{ $args{data} } ];

    } elsif ($args{theta} == 90) { # east

        $args{data} = _transpose( $args{data} );
        $args{data} = ($args{pinhead} and !$args{headless})
            ? [ map [ @$_[1 .. $#$_], $_->[0] ], @{ $args{data} } ]
            : [ map [ CORE::reverse @$_ ], @{ $args{data} } ];

    } elsif ($args{theta} == -180) { # south

        $args{data} = ($args{pinhead} and !$args{headless})
            ? [ @{ $args{data} }[1 .. $#{ $args{data} }], $args{data}[0] ]
            : [ CORE::reverse @{ $args{data} } ];

    } elsif ($args{theta} == 180) {

        $args{data} = ($args{pinhead} and !$args{headless})
            ? [ map [ CORE::reverse @$_ ], @{ $args{data} }[1 .. $#{ $args{data} }], $args{data}[0] ]
            : [ map [ CORE::reverse @$_ ], CORE::reverse @{ $args{data} } ];

    } elsif ($args{theta} == -270) { # west

        $args{data} = [@{ _transpose( $args{data} ) }];

    } elsif ($args{theta} == 270) {

        $args{data} = [ CORE::reverse @{ _transpose( $args{data} ) }];
    }

    if ($args{scroll}) {
        my ($js, %new_args) = Spreadsheet::HTML::Presets::Scroll::scroll(
            %args,
            data => [ map [ map $_->{cdata}, @$_ ], @{ $args{data} } ],
        );
        for (keys %args) {
            if (ref $args{$_} eq 'HASH') {
                $new_args{$_} = { %{ $new_args{$_} || {} }, %{ $args{$_} || {} } };
            }
        }
        my $table = _make_table( _process( %new_args ) );
        return $js . $table;
    }

    return _make_table( %args );
}

sub new {
    my $class = shift;
    my %attrs = ref($_[0]) eq 'HASH' ? %{+shift} : @_;
    return bless { %attrs }, $class;
}

sub _process {
    my ($self,$data,$args) = _args( @_ );

    if ($self and $self->{is_cached}) {
        return wantarray ? ( data => $self->{data}, %{ $args || {} } ) : $data;
    }

    # headings is an alias for -r0
    $args->{-r0} = $args->{headings} if exists $args->{headings};

    # headings to index mapping (alias for some -cX)
    my %index = ();
    if ($#{ $data->[0] }) {
        %index = map { '-' . ($data->[0][$_] || '') => $_ } 0 .. $#{ $data->[0] };
        for (grep /^-/, keys %$args) {
            $args->{"-c$index{$_}" } = $args->{$_} if exists $index{$_};
        }
    }

    my $empty = exists $args->{empty} ? $args->{empty} : ' ';
    my $tag   = ($args->{headless} or $args->{matrix}) ? 'td' : 'th';
    for my $row (0 .. $args->{_max_rows} - 1) {

        unless ($args->{_layout}) {
            push @{ $data->[$row] }, undef for 1 .. $args->{_max_cols} - $#{ $data->[$row] } + 1;  # pad
            pop  @{ $data->[$row] } for $args->{_max_cols} .. $#{ $data->[$row] };                 # truncate
        }

        for my $col (0 .. $#{ $data->[$row] }) {

            my ( $cdata, $attr ) = ( $data->[$row][$col], undef );
            for ($tag, "-c$col", "-r$row", "-r${row}c${col}") {
                next unless exists $args->{$_};
                ( $cdata, $attr ) = _extrapolate( $cdata, $attr, $args->{$_} );
            }

            do{ no warnings;
                $cdata = HTML::Entities::encode_entities( $cdata, $args->{encodes} ) if $args->{encode} || exists $args->{encodes};
                $cdata =~ s/^\s*$/$empty/g;
            };

            $data->[$row][$col] = { 
                tag => $tag, 
                (defined( $cdata ) ? (cdata => $cdata) : ()), 
                (keys( %$attr )    ? (attr => $attr)   : ()),
            };
        }
        $tag = 'td';
    }

    if ($args->{cache} and $self and !$self->{is_cached}) {
        $self->{data} = $data;
        $self->{is_cached} = 1;
    }

    shift @$data if $args->{headless};

    return wantarray ? ( data => $data, %$args ) : $data;
}

sub _make_table {
    my %args = @_;

    my @cdata = ( _tag( %args, tag => 'caption' ) || (), _colgroup( %args ) );

    if ($args{tgroups}) {

        my @body = @{ $args{data} };
        my $head = shift @body unless $args{matrix} and scalar @{ $args{data} } > 2;
        my $foot = pop @body if !$args{matrix} and $args{tgroups} > 1 and scalar @{ $args{data} } > 2;

        my $head_row  = { tag => 'tr', attr => $args{'thead.tr'}, cdata => $head };
        my $foot_row  = { tag => 'tr', attr => $args{'tfoot.tr'}, cdata => $foot };
        my $body_rows = [ map { tag => 'tr', attr => $args{tr}, cdata => $_ }, @body ];

        if (int($args{group} || 0) > 1) {
            $body_rows = [
                map [ @$body_rows[$_ .. $_ + $args{group} - 1] ],
                _range( 0, $#$body_rows, $args{group} )
            ];
            pop @{ $body_rows->[-1] } while !defined $body_rows->[-1][-1];
        } else {
            $body_rows = [ $body_rows ];
        }

        push @cdata, (
            ( $head ? { tag => 'thead', attr => $args{thead}, cdata => $head_row } : () ),
            ( $foot ? { tag => 'tfoot', attr => $args{tfoot}, cdata => $foot_row } : () ),
            ( map     { tag => 'tbody', attr => $args{tbody}, cdata => $_ }, @$body_rows ),
        );


    } else {
        push @cdata, map { tag => 'tr', attr => $args{tr}, cdata => $_ }, @{ $args{data} };
    }

    return $args{_auto}->tag( tag => 'table', attr => $args{table}, cdata => \@cdata );
}

sub _args {
    my ($self,@data,$data,@args,$args);
    $self = shift if UNIVERSAL::isa( $_[0], __PACKAGE__ );
    $data = shift if (@_ == 1);

    while (@_) {
        if (ref( $_[0] )) {
            push @data, shift;
            if (ref( $_[0] )) {
                push @data, shift;
            } elsif (defined $_[0]) {
                push @args, shift, shift;
            }
        } else {
            push @args, shift, shift;
        }
    }

    $data ||= (@data == 1) ? $data[0] : (@data) ? [ @data ] : undef;
    $args = scalar @args ? { @args } : {};
    $args = { %{ $self || {} }, %{ $args || {} } };
    $data = delete $args->{data} if exists $args->{data};

    $args->{_auto} ||= HTML::AutoTag->new(
        indent  => $args->{indent},
        level   => $args->{level},
        sorted  => $args->{sorted_attrs},
    );

    return ( $self, $self->{data}, $args ) if $self and $self->{is_cached};

    $args->{worksheet} ||= 1;
    $args->{worksheet} = 1 if $args->{worksheet} < 1;
    if ($args->{file}) {
        $data = Spreadsheet::HTML::File::Loader::_parse( $args, $data );
        unlink $args->{file} if $args->{_unlink};
    }

    $data = [ $data ] unless ref($data) eq 'ARRAY';
    $data = [ $data ] unless ref($data->[0]) eq 'ARRAY';

    if ($args->{wrap} and defined $data->[0][0]) {
        my @flat = map @$_, @$data;
        $data = [
            map [ @flat[$_ .. $_ + $args->{wrap} - 1] ],
            _range( 0, $#flat, $args->{wrap} )
        ];
    }

    $data = Spreadsheet::HTML::Engine::_apply( $data, $args->{apply} ) if $args->{apply};

    $args->{_max_rows} = scalar @{ $data }      || 1;
    $args->{_max_cols} = scalar @{ $data->[0] } || 1;

    if ($args->{fill}) {
        my ($row,$col) = split /\D/, $args->{fill};
        $args->{_max_rows} = $row if (int($row || 0)) > ($args->{_max_rows});
        $args->{_max_cols} = $col if (int($col || 0)) > ($args->{_max_cols});
    }

    return ( $self, [ map [@$_], @$data], $args );
}

sub _extrapolate {
    my ( $cdata, $attr, $thingy ) = @_;
    my $new_attr;
    $thingy = [ $thingy ] unless ref( $thingy ) eq 'ARRAY';
    for (@{ $thingy }) {
        if (ref($_) eq 'CODE') {
            $cdata = $_->($cdata);
        } elsif (ref($_) eq 'HASH') {
            $new_attr = $_;
        }
    }
    $attr = { %{ $attr || {} }, %{ $new_attr || {} } };
    return ( $cdata, $attr );
}

sub _colgroup {
    my %args = @_;

    my @colgroup;
    $args{col} = [ $args{col} ] if ref($args{col}) eq 'HASH';

    if (ref($args{col}) eq 'ARRAY') {

        if (ref $args{colgroup} eq 'ARRAY') {
            @colgroup = map {
                tag   => 'colgroup',
                attr  => $_,
                cdata => [ map { tag => 'col', attr => $_ }, @{ $args{col} } ]
            }, @{ $args{colgroup} }; 
        } else {
            @colgroup = {
                tag   => 'colgroup',
                attr  => $args{colgroup},
                cdata => [ map { tag => 'col', attr => $_ }, @{ $args{col} } ]
            }; 
        }

    } else {

        $args{colgroup} = [ $args{colgroup} ] if ref($args{colgroup}) eq 'HASH';
        if (ref $args{colgroup} eq 'ARRAY') {
            @colgroup = map { tag => 'colgroup', attr => $_ }, @{ $args{colgroup} };
        }
    }

    return @colgroup;
}

sub _tag {
    my %args = @_;
    my $thingy = $args{ $args{tag} };
    return unless defined $thingy;
    my $tag = { tag => $args{tag}, cdata => $thingy };
    if (ref $thingy eq 'HASH') {
        $tag->{cdata} = ( keys   %$thingy )[0];
        $tag->{attr}  = ( values %$thingy )[0];
    }
    return $tag;
}

# credit: Math::Matrix
sub _transpose {
    my $data = shift;
    my @trans;
    for my $i (0 .. $#{ $data->[0] }) {
        push @trans, [ map $_->[$i], @$data ]
    }
    return \@trans;
}

sub _range {grep!(($_-$_[0])%($_[2]||1)),$_[0]..$_[1]}


1;

__END__
=head1 NAME

Spreadsheet::HTML - Just another HTML table generator.

=head1 SYNOPSIS

Object oriented interface:

    use Spreadsheet::HTML;

    my @data = ( [qw(foo b&r b&z)], [1,2,3], [4,5,6], [7,8,9] );
    my $gen  = Spreadsheet::HTML->new( data => \@data, encode => 1 );

    print $gen->portrait( indent => '   ' );
    print $gen->landscape( indent => "\t" );

    $gen = Spreadsheet::HTML->new( file => 'data.xls', worksheet => 2 );
    print $gen->generate( preserve => 1 );

Procedural interface:

    use Spreadsheet::HTML qw( portrait landscape );

    print portrait( \@data, td => sub { sprintf "%02d", shift } );
    print landscape( \@data, tr => { class => [qw(odd even)] } );

=head1 DESCRIPTION

Generate HTML tables with ease (HTML4, XHTML and HTML5). Generate portrait,
landscape and other rotated views, Handsontable tables, HTML calendars,
checkerboard patterns, games such as sudoku, banners and mazes, and create
animations of cell values and backgrounds via jQuery. Transform Excel, HTML,
JSON, CSV, YAML, PNG, JPEG and GIF files instantly into HTML tables.

=head1 CLI TOOLS

=over 4

=item * C<mktable>