view release on metacpan or  search on metacpan

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

package Spreadsheet::HTML::Presets::List;
use strict;
use warnings FATAL => 'all';

sub list {
    my ($self,$data,$args);
    $self = shift if ref($_[0]) =~ /^Spreadsheet::HTML/;
    ($self,$data,$args) = $self ? $self->_args( @_ ) : Spreadsheet::HTML::_args( @_ );

    my $list = [];
    if (exists $args->{row}) {
        $args->{row} = 0 unless $args->{row} =~ /^\d+$/;
        $list = @$data[$args->{row}];
    } else {
        $args->{col} = 0 unless $args->{col} && $args->{col} =~ /^\d+$/;
        $list = [ map { $data->[$_][$args->{col}] } 0 .. $#$data ];
    }

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

    $HTML::AutoTag::ENCODE  = defined $args->{encode}  ? $args->{encode}  : exists $args->{encodes};
    $HTML::AutoTag::ENCODES = defined $args->{encodes} ? $args->{encodes} : '';
    return $args->{_auto}->tag(
        tag   => $args->{ordered} ? 'ol' : 'ul', 
        attr  => $args->{ol} || $args->{ul},
        cdata => [
            map {
                my ( $cdata, $attr ) = Spreadsheet::HTML::_extrapolate( $_, undef, $args->{li} );
                { tag => 'li', attr => $attr, cdata => $cdata }
            } @$list
        ]
    );
}

sub select {
    my ($self,$data,$args);
    $self = shift if ref($_[0]) =~ /^Spreadsheet::HTML/;
    ($self,$data,$args) = $self ? $self->_args( @_ ) : Spreadsheet::HTML::_args( @_ );

    my $cdata  = [];
    my $values = [];
    if (exists $args->{row}) {
        $args->{row} = 0 unless $args->{row} =~ /^\d+$/;
        $cdata  = @$data[$args->{row}];
        $values = @$data[$args->{row} + 1];
    } else {
        $args->{col} = 0 unless $args->{col} && $args->{col} =~ /^\d+$/;
        $cdata  = [ map { $data->[$_][$args->{col}] } 0 .. $#$data ];
        $values = [ map { $data->[$_][$args->{col} + 1 ] } 0 .. $#$data ];
    }

    my $selected = [];
    if ($args->{selected}) {
        $args->{selected} = [ $args->{selected} ] unless ref $args->{selected};
        for my $text (@$cdata) {
            if (grep $_ eq $text, @{ $args->{selected} }) {
                push @$selected, 'selected';
            } else {
                push @$selected, undef;
            }
        }
    }

    my $attr = { value => [] };
    $attr->{value}    = $cdata   if $args->{values};
    $attr->{selected} = $selected if map defined $_ ? $_ : (), @$selected;

    my $options = [
        map { 
            my ( $cdata, $opt_attr ) = Spreadsheet::HTML::_extrapolate( $_, $attr, $args->{option} );
            { tag => 'option', attr => $opt_attr, cdata => $cdata };
        } $args->{values} ? @$values : @$cdata
    ];

    if (ref( $args->{optgroup} ) eq 'ARRAY' and @{ $args->{optgroup} }) {
        my @groups = @{ $args->{optgroup} };
        my @ranges = Spreadsheet::HTML::_range( 0, $#$options, $#groups );
        splice( @$options, $_, 0, { tag => 'optgroup', attr => { label => pop @groups } } ) for reverse @ranges;
    }

    if ($args->{headless}) {
        shift @$options;
        shift @{ $attr->{value} };
    }

    $HTML::AutoTag::ENCODE  = defined $args->{encode}  ? $args->{encode}  : exists $args->{encodes};
    $HTML::AutoTag::ENCODES = defined $args->{encodes} ? $args->{encodes} : '';

    my $label = '';
    if ($args->{label}) {
        $label = $args->{_auto}->tag( %{ Spreadsheet::HTML::_tag( %$args, tag => 'label' ) } );
    }

    return $label . $args->{_auto}->tag(
        tag   => 'select', 
        attr  => $args->{select},
        cdata => [
            ( $args->{placeholder} 
                ? { tag => 'option', attr => { value => '' }, cdata => $args->{placeholder} } 
                : ()
            ), @$options
        ],
    );
}

=head1 NAME

Spreadsheet::HTML::Presets::List - Generate <select>, <ol> and <ul> lists.

=head1 DESCRIPTION

This is a container for L<Spreadsheet::HTML> preset methods.
These methods are not meant to be called from this package.
Instead, use the Spreadsheet::HTML interface:

  use Spreadsheet::HTML;
  my $generator = Spreadsheet::HTML->new( data => \@data );
  print $generator->list( ordered => 1 );
  print $generator->select( values => 1, placeholder => 'Pick one' );

  # or
  use Spreadsheet::HTML qw( list );
  print list( data => \@data, col => 2 );
  print Spreadsheet::HTML::select( data => \@data, row => 0 );

Note that C<select()> is not exportable, due to the existance of Perl's
built-in C<select()> function.

=head1 METHODS

=over 4

=item * C<list( ordered, col, row, %params )>

Renders ordered <ol> and unordered <ul> lists.

=back

=head2 LITERAL PARAMETERS

=over 8

=item * C<headless>

Boolean. Discard first element. Useful for datasets that include headings.

  headless => 1

=item * C<ordered>

Boolean. Uses <ol> instead of <ul> container when true.

  ordered => 1

=item * C<col>

Integer. Start at this column. If neither C<col> nor C<row> is specified,
then the first column (0) is used.