DBIx-XHTML_Table

 view release on metacpan or  search on metacpan

lib/DBIx/XHTML_Table.pm  view on Meta::CPAN

sub _build_table {
    my ($self)  = @_;
    my $attribs = $self->{'global'}->{'table'};

    my ($head,$body,$foot);
    $head = $self->_build_head;
    $body = $self->{'rows'}   ?  $self->_build_body : '';
    $foot = $self->{'totals'} ?  $self->_build_foot : '';

    # w3c says tfoot comes before tbody ...
    my $cdata = $head . $foot . $body;

    return _tag_it('table', $attribs, $cdata) . $N;
}

sub _build_head {
    my ($self) = @_;
    my ($attribs,$cdata,$caption);
    my $output = '';

    # build the <caption> tag if applicable
    if ($caption = $self->{'global'}->{'caption'}) {
        $attribs = $self->{'global'}->{'caption_attribs'};
        $cdata   = $self->{'encode_cells'} ? $self->_xml_encode($caption) : $caption;
        $output .= $N.$T . _tag_it('caption', $attribs, $cdata);
    }

    # build the <colgroup> tags if applicable
    if ($attribs = $self->{'global'}->{'colgroup'}) {
        $cdata   = $self->_build_head_colgroups();
        $output .= $N.$T . _tag_it('colgroup', $attribs, $cdata);
    }

    # go ahead and stop if they don't want the head
    return "$output\n" if $self->{'no_head'};

    # prepare <tr> tag info
    my $tr_attribs = _merge_attribs(
        $self->{'head'}->{'tr'}, $self->{'global'}->{'tr'}
    );
    my $tr_cdata   = $self->_build_head_row();

    # prepare the <thead> tag info
    $attribs = $self->{'head'}->{'thead'} || $self->{'global'}->{'thead'};
    $cdata   = $N.$T . _tag_it('tr', $tr_attribs, $tr_cdata) . $N.$T;

    # add the <thead> tag to the output
    $output .= $N.$T . _tag_it('thead', $attribs, $cdata) . $N;
}

sub _build_head_colgroups {
    my ($self) = @_;
    my (@cols,$output);

    return unless $self->{'colgroups'};
    return undef unless @cols = @{$self->{'colgroups'}};

    foreach (@cols) {

lib/DBIx/XHTML_Table.pm  view on Meta::CPAN

    # if a group was not set via set_group(), then use the entire 2-d array
    my @indicies = exists $self->{'body_breaks'}
        ? @{$self->{'body_breaks'}}
        : ($self->get_row_count - 1);

    # the skinny here is to grab a slice of the rows, one for each group
    foreach my $end (@indicies) {
        my $body_group = $self->_build_body_group([@{$self->{'rows'}}[$beg..$end]]) || '';
        my $attribs    = $self->{'global'}->{'tbody'} || $self->{'body'}->{'tbody'};
        my $cdata      = $N . $body_group . $T;

        $output .= $T . _tag_it('tbody',$attribs,$cdata) . $N;
        $beg = $end + 1;
    }
    return $output;
}

sub _build_body_group {

    my ($self,$chunk) = @_;
    my ($output,$cdata);
    my $attribs = _merge_attribs(
        $self->{'body'}->{'tr'}, $self->{'global'}->{'tr'}
    );
    my $pk_col = '';

    # build the rows
    for my $i (0..$#$chunk) {
        my @row  = @{$chunk->[$i]};
        $pk_col  = splice(@row,$self->{'pk_index'},1) if defined $self->{'pk_index'};
        $cdata   = $self->_build_body_row(\@row, ($i and $self->{'nodup'} or 0), $pk_col);
        $output .= $T . _tag_it('tr',$attribs,$cdata) . $N;
    }

    # build the subtotal row if applicable
    if (my $subtotals = shift @{$self->{'sub_totals'}}) {
        $cdata   = $self->_build_body_subtotal($subtotals);
        $output .= $T . _tag_it('tr',$attribs,$cdata) . $N;
    }

    return $output;
}

sub _build_body_row {
    my ($self,$row,$nodup,$pk) = @_;

    my $group  = $self->{'group'};
    my $index  = $self->_lookup_index($group) if $group;

lib/DBIx/XHTML_Table.pm  view on Meta::CPAN

            $self->{$name}->{'td'}    || $self->{'body'}->{'td'}, 
            $self->{'global'}->{'td'} || $self->{'body'}->{'td'},
        );

        # suppress warnings AND keep 0 from becoming  
        $row->[$_] = '' unless defined($row->[$_]);

        # bug 21761 "Special XML characters should be expressed as entities"
        $row->[$_] = $self->_xml_encode( $row->[$_] ) if $self->{'encode_cells'};

        my $cdata = ($row->[$_] =~ /^\s+$/) 
            ? $self->{'null_value'}
            : $row->[$_] 
        ;

        $self->{'current_col'} = $name;

        $cdata = ($nodup and $index == $_)
            ? $self->{'nodup'}
            : _map_it($self->{'map_cell'}->{$name},$cdata)
        ;

        $output .= $T.$T . _tag_it('td', $attribs, $cdata) . $N;
    }
    return $output . $T;
}

sub _build_body_subtotal {
    my ($self,$row) = @_;
    my $output = $N;

    return '' unless $row;

lib/DBIx/XHTML_Table.pm  view on Meta::CPAN

    return $output . $T;
}

sub _build_foot {
    my ($self) = @_;

    my $tr_attribs = _merge_attribs(
        # notice that foot is 1st and global 2nd - different than rest
        $self->{'foot'}->{'tr'}, $self->{'global'}->{'tr'}
    );
    my $tr_cdata   = $self->_build_foot_row();

    my $attribs = $self->{'foot'}->{'tfoot'} || $self->{'global'}->{'tfoot'};
    my $cdata   = $N.$T . _tag_it('tr', $tr_attribs, $tr_cdata) . $N.$T;

    return $T . _tag_it('tfoot',$attribs,$cdata) . $N;
}

sub _build_foot_row {
    my ($self) = @_;

    my $output = $N;
    my $row    = $self->{'totals'};

    for (0..$#$row) {
        my $name    = $self->_lookup_name($_);

lib/DBIx/XHTML_Table.pm  view on Meta::CPAN

            $sum = defined $sum ? $sum : $self->{'null_value'};
        }

        $output .= $T.$T . _tag_it('th', $attribs, $sum) . $N;
    }
    return $output . $T;
}

# builds a tag and it's enclosed data
sub _tag_it {
    my ($name,$attribs,$cdata) = @_;
    my $text = "<\L$name\E";

    # build the attributes if any - skip blank vals
    for my $k (sort keys %{$attribs}) {
        my $v = $attribs->{$k};
        if (ref $v eq 'HASH') {
            $v = join('; ', map { 
                my $attrib = $_;
                my $value  = (ref $v->{$_} eq 'ARRAY') 
                    ? _rotate($v->{$_}) 
                    : $v->{$_};
                join(': ',$attrib,$value||'');
            } sort keys %$v) . ';';
        }
        $v = _rotate($v) if (ref $v eq 'ARRAY');
        $text .= qq| \L$k\E="$v"| unless $v =~ /^$/;
    }
    $text .= (defined $cdata) ? ">$cdata</\L$name\E>" : '/>';
}

# used by map_cell() and map_head()
sub _map_it {
    my ($sub,$datum) = @_;
    return $datum unless $sub;
    return $datum = $sub->($datum);
}

# used by calc_totals() and calc_subtotals()

lib/DBIx/XHTML_Table.pm  view on Meta::CPAN

  $table->add_col_tag({
     span  => $table->get_col_count(),
     style => 'text-align: center',
  });

=item B<map_cell>

  $table->map_cell($subroutine[,$cols])

Map a supplied subroutine to all the <td> tag's cdata for
the specified columns.  The first argument is a reference to a
subroutine. This subroutine should shift off a single scalar at
the beginning, munge it in some fasion, and then return it.
The second argument is the column (scalar) or columns (reference
to a list of scalars) to apply this subroutine to. Example: 

  # uppercase the data in column DEPARTMENT
  $table->map_cell( sub { return uc shift }, 'department');

  # uppercase the data in the fifth column
  $table->map_cell( sub { return uc shift }, 4);

One temptation that needs to be addressed is using this method to
color the cdata inside a <td> tag pair. For example:

  # don't be tempted to do this
  $table->map_cell(sub {
    return qq|<font color="red">| . shift . qq|</font>|;
  }, [qw(first_name last_name)]);

  # when CSS styles will work
  $table->modify(td => {
    style => 'color: red',
  }, [qw(first_name last_name)]);