File Coverage

blib/lib/AtteanX/Serializer/TextTable.pm
Criterion Covered Total %
statement 31 31 100.0
branch n/a
condition n/a
subroutine 12 12 100.0
pod 2 2 100.0
total 45 45 100.0


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             AtteanX::Serializer::TextTable - SPARQL Results TSV Serializer
4              
5             =head1 VERSION
6              
7             This document describes AtteanX::Serializer::TextTable version 0.032
8              
9             =head1 SYNOPSIS
10              
11             use Attean;
12             my $s = Attean->get_serializer('TextTable')->new();
13             $s->serialize_iter_to_io( $fh, $iter );
14              
15             =head1 DESCRIPTION
16              
17             ...
18              
19             =head1 ATTRIBUTES
20              
21             =over 4
22              
23             =item C<< canonical_media_type >>
24              
25             =item C<< file_extensions >>
26              
27             =back
28              
29             =head1 METHODS
30              
31             =over 4
32              
33             =cut
34              
35 2     2   6204 use v5.14;
  2         12  
36 2     2   9 use warnings;
  2         5  
  2         82  
37              
38             use Moo;
39 2     2   22 use Types::Standard qw(Str Bool ArrayRef);
  2         5  
  2         12  
40 2     2   628 use Encode qw(encode);
  2         6  
  2         16  
41 2     2   1361 use Scalar::Util qw(blessed);
  2         4  
  2         72  
42 2     2   11 use Attean::ListIterator;
  2         5  
  2         62  
43 2     2   13 use List::MoreUtils qw(any);
  2         7  
  2         38  
44 2     2   13 use Text::Table;
  2         2  
  2         11  
45 2     2   2958 use namespace::clean;
  2         31358  
  2         65  
46 2     2   16  
  2         4  
  2         12  
47             my @rule = qw(- +);
48             has 'canonical_media_type' => (is => 'ro', isa => Str, init_arg => undef, default => 'text/plain');
49             has 'number_rows' => (is => 'rw', isa => Bool, default => 0);
50              
51             =item C<< media_types >>
52              
53             Returns a list of media types that identify the format produced by this serializer.
54              
55             =cut
56              
57             return [qw(text/plain)];
58             }
59 9     9 1 26  
60             =item C<< file_extensions >>
61              
62             Returns a list of file extensions associated with the serialized format.
63              
64             =cut
65              
66            
67             =item C<< serialize_iter_to_io( $fh, $iterator ) >>
68 4     4 1 16  
69             Serializes the L<Attean::API::Binding> objects from C<< $iterator >> to the
70             L<IO::Handle> object C<< $fh >>.
71              
72             =cut
73              
74             my $self = shift;
75             my $io = shift;
76             my $iter = shift;
77            
78             my @vars;
79             if ($iter->does('Attean::API::ResultOrTermIterator')) {
80             @vars = @{ $iter->variables };
81             } elsif ($iter->does('Attean::API::TripleIterator')) {
82             @vars = qw(subject predicate object);
83             } else {
84             @vars = qw(subject predicate object graph);
85             }
86              
87             my @header_names = @vars;
88             if ($self->number_rows) {
89             unshift(@header_names, '#');
90             }
91              
92             my @headers = (\q"| ");
93             push(@headers, map { $_ => \q" | " } @header_names);
94             pop @headers;
95             push @headers => (\q" |");
96              
97             my $table = Text::Table->new(@headers);
98              
99             my @rule = qw(- +);
100             my @rows;
101             my $row = 1;
102             while (my $t = $iter->next()) {
103             my @strings = map { blessed($_) ? $_->as_string : '' } map { eval { $t->value($_) } } @vars;
104             if ($self->number_rows) {
105             unshift(@strings, $row++);
106             }
107             push(@rows, \@strings);
108             }
109             $table->load(@rows);
110            
111             print {$io} join('',
112             $table->rule(@rule),
113             $table->title,
114             $table->rule(@rule),
115             map({ $table->body($_) } 0 .. @rows),
116             $table->rule(@rule)
117             );
118             }
119            
120             =item C<< serialize_iter_to_bytes( $iterator ) >>
121              
122             Serializes the L<Attean::API::Binding> objects from C<< $iterator >>
123             and returns the serialization as a UTF-8 encoded byte string.
124              
125             =cut
126              
127             my $self = shift;
128             my $io = shift;
129             my $iter = shift;
130            
131             my @vars = @{ $iter->variables };
132             my @header_names = @vars;
133             if ($self->number_rows) {
134             unshift(@header_names, '#');
135             }
136              
137             my @headers = (\q"| ");
138             push(@headers, map { $_ => \q" | " } @header_names);
139             pop @headers;
140             push @headers => (\q" |");
141              
142             my $table = Text::Table->new(@headers);
143            
144             my @rows;
145             my $row = 1;
146             while (my $t = $iter->next()) {
147             my @strings = map { blessed($_) ? $_->ntriples_string : '' } map { $t->value($_) } @vars;
148             if ($self->number_rows) {
149             unshift(@strings, $row++);
150             }
151             push(@rows, \@strings);
152             }
153             $table->load(@rows);
154              
155             my $data = join('',
156             $table->rule(@rule),
157             $table->title,
158             $table->rule(@rule),
159             map({ $table->body($_) } 0 .. @rows),
160             $table->rule(@rule)
161             );
162             return encode('UTF-8', $data);
163             }
164              
165             with 'Attean::API::ResultSerializer';
166             }
167              
168             1;
169              
170              
171             =back
172              
173             =head1 BUGS
174              
175             Please report any bugs or feature requests to through the GitHub web interface
176             at L<https://github.com/kasei/perlrdf/issues>.
177              
178             =head1 AUTHOR
179              
180             Gregory Todd Williams C<< <gwilliams@cpan.org> >>
181              
182             =head1 COPYRIGHT
183              
184             Copyright (c) 2014--2022 Gregory Todd Williams. This
185             program is free software; you can redistribute it and/or modify it under
186             the same terms as Perl itself.
187              
188             =cut