File Coverage

blib/lib/AtteanX/Serializer/SPARQLHTML.pm
Criterion Covered Total %
statement 56 56 100.0
branch 10 10 100.0
condition n/a
subroutine 13 13 100.0
pod 3 3 100.0
total 82 82 100.0


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             AtteanX::Serializer::SPARQLHTML - SPARQL Results HTML Serializer
4              
5             =head1 VERSION
6              
7             This document describes AtteanX::Serializer::SPARQLHTML version 0.032
8              
9             =head1 SYNOPSIS
10              
11             use Attean;
12             my $s = Attean->get_serializer('SPARQLHTML')->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 4     4   13823 use v5.14;
  4         53  
36 4     4   27 use warnings;
  4         11  
  4         159  
37              
38             use Moo;
39 4     4   21 use Types::Standard qw(Str Bool ArrayRef);
  4         8  
  4         27  
40 4     4   1408 use Encode qw(encode);
  4         10  
  4         38  
41 4     4   2934 use Scalar::Util qw(blessed);
  4         9  
  4         171  
42 4     4   22 use Attean::ListIterator;
  4         9  
  4         134  
43 4     4   20 use List::MoreUtils qw(any);
  4         7  
  4         96  
44 4     4   21 use namespace::clean;
  4         7  
  4         29  
45 4     4   3595  
  4         8  
  4         30  
46             has 'full_document' => (is => 'rw', isa => Bool, default => 1);
47             has 'canonical_media_type' => (is => 'ro', isa => Str, init_arg => undef, default => 'text/html');
48              
49             =item C<< media_types >>
50              
51             Returns a list of media types that identify the format produced by this serializer.
52              
53             =cut
54              
55             return [qw(text/html)];
56             }
57 10     10 1 27  
58             =item C<< file_extensions >>
59              
60             Returns a list of file extensions associated with the serialized format.
61              
62             =cut
63              
64            
65             =item C<< serialize_iter_to_io( $fh, $iterator ) >>
66 9     9 1 42  
67             Serializes the L<Attean::API::Binding> objects from C<< $iterator >> to the
68             L<IO::Handle> object C<< $fh >>.
69              
70             =cut
71              
72             my $self = shift;
73             my $io = shift;
74             my $iter = shift;
75             if ($self->full_document) {
76             $io->print(<<"END");
77             <!DOCTYPE html>
78             <html><head><title>SPARQL Results</title></head><body>
79             <div id="result">
80             <h2>Results</h2>
81             END
82             }
83             my @names;
84             my $count = 0;
85             my $first = 1;
86             while (my $t = $iter->next()) {
87             $count++;
88             if ($first) {
89             $io->print("<table class='sparqlresults'>\n<thead><tr>\n");
90             @names = $t->variables;
91             foreach my $name (@names) {
92             $io->print("\t<th>" . $name . "</th>\n");
93             }
94             $io->print("</tr></thead>\n");
95             $first = 0;
96             }
97            
98             $io->print("<tr>\n");
99             foreach my $k (@names) {
100             my $term = $t->value($k);
101             my $value = $self->node_as_html($term) // '';
102             $io->print("\t<td>$value</td>\n");
103             }
104             $io->print("</tr>\n");
105             }
106             unless ($first) {
107             my $columns = scalar(@names);
108             $io->print("<tfoot><tr><th colspan=\"$columns\">Total: $count</th></tr></tfoot>\n</table>\n");
109             }
110             if ($self->full_document) {
111             $io->print("</div>\n</body></html>\n");
112             }
113             return;
114             }
115            
116             =item C<< serialize_iter_to_bytes( $iterator ) >>
117              
118             Serializes the L<Attean::API::Binding> objects from C<< $iterator >>
119             and returns the serialization as a UTF-8 encoded byte string.
120              
121             =cut
122              
123             my $self = shift;
124             my $iter = shift;
125             my $data = '';
126             open(my $fh, '>:utf8', \$data);
127             $self->serialize_iter_to_io($fh, $iter);
128             close($fh);
129             return $data;
130             }
131 1     1   8  
  1         2  
  1         8  
132             =item C<< node_as_html($node) >>
133              
134             Serializes the L<Attean::API::Term> object as HTML.
135              
136             =cut
137              
138             my $self = shift;
139             my $node = shift;
140             return '' unless (blessed($node));
141             if ($node->does('Attean::API::IRI')) {
142             my $uri = $node->value;
143             for ($uri) {
144 22     22 1 4723 s/&/&amp;/g;
145 22         25 s/</&lt;/g;
146 22 100       67 }
147 18 100       54 my $html = qq[<a href="${uri}">$uri</a>];
    100          
148 10         156  
149 10         15 if (my $map = $self->namespaces) {
150 10         16 my $abr = $map->abbreviate($uri);
151 10         18  
152             if ($abr) {
153 10         28 return qq[<a href="${uri}">$abr</a>];
154             } else {
155 10 100       27 return $html;
156 2         9 }
157              
158 2 100       382 } else {
159 1         8
160             return $html;
161 1         6 }
162              
163              
164             # if ($link) {
165             # $html = qq[<a href="${uri}">$html</a>];
166 8         24 # }
167             } elsif ($node->does('Attean::API::Literal')) {
168             my $html = $node->value;
169             for ($html) {
170             s/&/&amp;/g;
171             s/</&lt;/g;
172             }
173             return $html;
174 4         148 } else {
175 4         7 my $html = $node->value;
176 4         6 for ($html) {
177 4         9 s/&/&amp;/g;
178             s/</&lt;/g;
179 4         12 }
180             return $html;
181 4         123 }
182 4         6 }
183 4         8 with 'Attean::API::ResultSerializer';
184 4         6 with 'Attean::API::AbbreviatingSerializer';
185             }
186 4         11  
187             1;
188              
189              
190             =back
191              
192             =head1 BUGS
193              
194             Please report any bugs or feature requests to through the GitHub web interface
195             at L<https://github.com/kasei/perlrdf/issues>.
196              
197             =head1 AUTHOR
198              
199             Gregory Todd Williams C<< <gwilliams@cpan.org> >>
200              
201             =head1 COPYRIGHT
202              
203             Copyright (c) 2014--2022 Gregory Todd Williams. This
204             program is free software; you can redistribute it and/or modify it under
205             the same terms as Perl itself.
206              
207             =cut