Data::Conveyor::Service::Result::Tabular - Stage-based conveyor-belt-like ticket handling system


Data-Conveyor documentation Contained in the Data-Conveyor distribution.

Index


Code Index:

NAME

Top

Data::Conveyor::Service::Result::Tabular - Stage-based conveyor-belt-like ticket handling system

VERSION

Top

version 1.103130

METHODS

Top

result

FIXME

result_as_list_of_hashes

FIXME

result_as_string

FIXME

set_from_rows

FIXME

INSTALLATION

Top

See perlmodinstall for information and options on installing Perl modules.

BUGS AND LIMITATIONS

Top

No bugs have been reported.

Please report any bugs or feature requests through the web interface at http://rt.cpan.org/Public/Dist/Display.html?Name=Data-Conveyor.

AVAILABILITY

Top

The latest version of this module is available from the Comprehensive Perl Archive Network (CPAN). Visit http://www.perl.com/CPAN/ to find a CPAN site near you, or see http://search.cpan.org/dist/Data-Conveyor/.

The development version lives at http://github.com/hanekomu/Data-Conveyor and may be cloned from git://github.com/hanekomu/Data-Conveyor. Instead of sending patches, please fork this project using the standard git and github infrastructure.

AUTHORS

Top

COPYRIGHT AND LICENSE

Top


Data-Conveyor documentation Contained in the Data-Conveyor distribution.

use 5.008;
use strict;
use warnings;

package Data::Conveyor::Service::Result::Tabular;
BEGIN {
  $Data::Conveyor::Service::Result::Tabular::VERSION = '1.103130';
}
# ABSTRACT: Stage-based conveyor-belt-like ticket handling system

use Text::Table;
use Data::Miscellany 'trim';
use parent 'Data::Conveyor::Service::Result';
__PACKAGE__->mk_array_accessors(qw(headers rows));

sub result_as_string {
    my $self = shift;
    unless ($self->rows_count) {
        return "No results\n";
    }
    my @fields = $self->headers;
    my $table  = Text::Table->new(@fields);
    $table->load($self->rows);
    $table;
}

# Given a LoH (list of hashes, a typical DBI result set), it populates the
# result object with those rows. It can also be a list of objects if those
# objects have methods that correspond to the headers.
sub set_from_rows {
    my ($self, %args) = @_;
    my ($did_set_headers, $count);
    my $limit  = $args{limit}       if defined $args{limit};
    my @fields = @{ $args{fields} } if defined $args{fields};
    for my $row (@{ $args{rows} }) {
        last if defined($limit) && ++$count > $limit;
        unless ($did_set_headers) {
            scalar @fields or @fields = sort keys %$row;
            $self->headers(@fields);
            $did_set_headers++;
        }
        my @values;
        for (@fields) {
            if (ref $row eq 'HASH') {
                push @values => $row->{$_};
            } elsif (UNIVERSAL::can($row, $_)) {
                push @values => $row->$_;
            } else {
                throw Error::Hierarchy::Internal::CustomMessage(
                    custom_message => "can't set field [$_] from row [$row]");
            }
        }
        $self->rows_push([ map { defined($_) ? $_ : '' } @values ]);
    }
    $self;
}
sub result { $_[0]->rows }

sub result_as_list_of_hashes {
    my $self = shift;
    my @result;
    my @headers = $self->headers;    # don't call this accessor for every row
    for my $row_ref ($self->rows) {
        my $index = 0;
        my %row_hash;
        for my $header (@headers) {
            $row_hash{$header} = $row_ref->[ $index++ ];
        }
        push @result => \%row_hash;
    }
    wantarray ? @result : \@result;
}
1;


__END__