File Coverage

blib/lib/RDF/RDFa/Generator/HTML/Pretty.pm
Criterion Covered Total %
statement 164 190 86.3
branch 54 78 69.2
condition 20 39 51.2
subroutine 18 18 100.0
pod 2 3 66.6
total 258 328 78.6


line stmt bran cond sub pod time code
1             package RDF::RDFa::Generator::HTML::Pretty;
2              
3 4     4   76 use 5.008;
  4         13  
4 4     4   22 use base qw'RDF::RDFa::Generator::HTML::Hidden';
  4         10  
  4         494  
5 4     4   35 use strict;
  4         9  
  4         128  
6 4     4   22 use constant XHTML_NS => 'http://www.w3.org/1999/xhtml';
  4         37  
  4         339  
7 4     4   40 use Encode qw'encode_utf8';
  4         8  
  4         208  
8 4     4   15863 use Icon::FamFamFam::Silk;
  4         2251  
  4         127  
9 4     4   2068 use RDF::RDFa::Generator::HTML::Pretty::Note;
  4         12  
  4         125  
10 4     4   28 use XML::LibXML qw':all';
  4         19  
  4         33  
11              
12 4     4   651 use warnings;
  4         9  
  4         11389  
13              
14              
15             our $VERSION = '0.200';
16              
17             sub create_document
18             {
19 8     8 1 1332 my ($proto, $model, %opts) = @_;
20 8 50       34 my $self = (ref $proto) ? $proto : $proto->new;
21            
22 8   50     154 my $html = sprintf(<<HTML, ($self->{'version'}||'1.0'), ($self->{'title'} || 'RDFa Document'), ref $self);
      50        
23             <html xmlns="http://www.w3.org/1999/xhtml" version="XHTML+RDFa %1\$s">
24             <head profile="http://www.w3.org/1999/xhtml/vocab">
25             <title>%2\$s</title>
26             <meta name="generator" value="%3\$s" />
27             </head>
28             <body>
29             <h1>%2\$s</h1>
30             <main/>
31             <footer>
32             <p><small>Generated by %3\$s.</small></p>
33             </footer>
34             </body>
35             </html>
36             HTML
37              
38 8         66 return $proto->inject_document($html, $model, %opts);
39             }
40              
41             sub injection_site
42             {
43 8     8 0 49 return '//xhtml:main';
44             }
45              
46              
47             sub nodes
48             {
49 8     8 1 29 my ($proto, $model, %opts) = @_;
50 8 50       45 my $self = (ref $proto) ? $proto : $proto->new;
51            
52 8         51 my $stream = $self->_get_stream($model);
53 8         15454 my @nodes;
54            
55 8         73 my $root_node = XML::LibXML::Element->new('div');
56 8         52 $root_node->setNamespace(XHTML_NS, undef, 1);
57            
58 8         202 my $subjects = {};
59 8         51 while (my $st = $stream->next)
60             {
61 20 50       2370 next if $st->subject->is_literal; # ???
62 20 100       549 my $s = $st->subject->is_resource ?
63             $st->subject->abs :
64             ('_:'.$st->subject->value);
65 20         1577 push @{ $subjects->{$s} }, $st;
  20         103  
66             }
67            
68 8         507 foreach my $s (sort keys %$subjects)
69             {
70 11         160 my $subject_node = $root_node->addNewChild(XHTML_NS, 'div');
71            
72 11         60 my $id = _make_id($s, $opts{'id_prefix'});
73 11 100       52 $subject_node->setAttribute('id', $id) if defined $id;
74            
75 11         116 $self->_process_subject($subjects->{$s}->[0], $subject_node);
76 11         99 $self->_resource_heading($subjects->{$s}->[0]->subject, $subject_node, $subjects->{$s});
77 11         319 $self->_resource_classes($subjects->{$s}->[0]->subject, $subject_node, $subjects->{$s});
78 11   100     218 $self->_resource_statements($subjects->{$s}->[0]->subject, $subject_node, $subjects->{$s}, $opts{'interlink'}||0, $opts{'id_prefix'}, $model);
79             $self->_resource_notes($subjects->{$s}->[0]->subject, $subject_node, $model, $opts{'notes_heading'}||'Notes', $opts{'notes'})
80 11 100 50     162 if defined $opts{'notes'};
81             }
82              
83 8 50 33     164 if (defined($self->{'version'}) && $self->{'version'} == 1.1
      33        
84             and $self->{'prefix_attr'})
85             {
86 0 0       0 if (defined($self->{namespacemap}->rdfa)) {
87             $root_node->setAttribute('prefix', $self->{namespacemap}->rdfa->as_string)
88 0         0 }
89             }
90             else
91             {
92 8         46 while (my ($prefix, $nsURI) = $self->{namespacemap}->each_map) {
93 281         31911 $root_node->setNamespace($nsURI->as_string, $prefix, 0);
94             }
95             }
96            
97 8         847 push @nodes, $root_node;
98 8 50       113 return @nodes if wantarray;
99 0         0 my $nodelist = XML::LibXML::NodeList->new;
100 0         0 $nodelist->push(@nodes);
101 0         0 return $nodelist;
102             }
103              
104             sub _make_id
105             {
106 13     13   91 my ($ident, $prefix) = @_;
107            
108 13 100 66     78 if (defined($prefix) && ($prefix =~ /^[A-Za-z][A-Za-z0-9\_\:\.\-]*$/))
109             {
110 4         18 $ident =~ s/([^A-Za-z0-9\_\:\.])/sprintf('-%x-',ord($1))/ge;
  6         30  
111 4         22 return $prefix . $ident;
112             }
113            
114 9         27 return undef;
115             }
116              
117             sub _resource_heading
118             {
119 11     11   43 my ($self, $subject, $node, $statements) = @_;
120            
121 11         83 my $heading = $node->addNewChild(XHTML_NS, 'h3');
122 11 100       49 $heading->appendTextNode( $subject->is_resource ? $subject->abs : ('_:'.$subject->value) );
123 11 100       903 $heading->setAttribute('class', $subject->is_resource ? 'resource' : 'blank' );
124            
125 11         353 return $self;
126             }
127              
128             sub _resource_classes
129             {
130 11     11   38 my ($self, $subject, $node, $statements) = @_;
131            
132             my @statements = sort {
133 0 0       0 $a->predicate->abs cmp $b->predicate->abs
134             or $a->object->abs cmp $b->object->abs
135             }
136             grep {
137 11 100       34 $_->predicate->abs eq 'http://www.w3.org/1999/02/22-rdf-syntax-ns#type'
  20         1196  
138             and $_->object->is_resource
139             }
140             @$statements;
141              
142 11 100       862 return unless @statements;
143              
144 7         66 my $SPAN = $node->addNewChild(XHTML_NS, 'span');
145 7         39 $SPAN->setAttribute('class', 'rdf-type');
146 7         101 $SPAN->setAttribute('rel', $self->_make_curie('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'));
147              
148 7         100 foreach my $st (@statements)
149             {
150 7         87 my $IMG = $SPAN->addNewChild(XHTML_NS, 'img');
151 7         184 $IMG->setAttribute('about', $st->object->abs);
152 7         666 $IMG->setAttribute('alt', $st->object->abs);
153 7         616 $IMG->setAttribute('src', $self->_img($st->object->abs));
154 7         57147 $IMG->setAttribute('title', $st->object->abs);
155             }
156              
157 7         684 return $self;
158             }
159              
160              
161             sub _resource_statements
162             {
163 11     11   58 my ($self, $subject, $node, $statements, $interlink, $id_prefix, $model) = @_;
164            
165             my @statements = sort {
166 6 50       499 $a->predicate->abs cmp $b->predicate->abs
167             or $a->object->ntriples_string cmp $b->object->ntriples_string
168             }
169             grep {
170 11 100       34 $_->predicate->abs ne 'http://www.w3.org/1999/02/22-rdf-syntax-ns#type'
  20         1033  
171             or !$_->object->is_resource
172             }
173             @$statements;
174              
175 11 100       1281 return unless @statements;
176            
177 7         59 my $DL = $node->addNewChild(XHTML_NS, 'dl');
178            
179 7         22 my $current_property = undef;
180 7         25 foreach my $st (@statements)
181             {
182 13 50 66     301 unless (defined($current_property) && ($st->predicate->abs eq $current_property))
183             {
184 13         463 my $DT = $DL->addNewChild(XHTML_NS, 'dt');
185 13         271 $DT->setAttribute('title', $st->predicate->abs);
186 13         934 $DT->appendTextNode($self->_make_curie($st->predicate));
187             }
188 13         540 $current_property = $st->predicate->abs;
189            
190 13         940 my $DD = $DL->addNewChild(XHTML_NS, 'dd');
191            
192 13 50 33     106 if ($st->object->is_resource && $st->object->abs =~ /^javascript:/i)
    50 33        
    100 33        
    50 33        
    50          
    50          
193             {
194 0         0 $DD->setAttribute('class', 'resource');
195            
196 0         0 my $A = $DD->addNewChild(XHTML_NS, 'span');
197 0         0 $A->setAttribute('rel', $self->_make_curie($st->predicate));
198 0         0 $A->setAttribute('resource', $st->object->abs);
199 0         0 $A->appendTextNode($st->object->abs);
200             }
201             elsif ($st->object->is_resource)
202             {
203 0         0 $DD->setAttribute('class', 'resource');
204            
205 0         0 my $A = $DD->addNewChild(XHTML_NS, 'a');
206 0         0 $A->setAttribute('rel', $self->_make_curie($st->predicate));
207 0         0 $A->setAttribute('href', $st->object->abs);
208 0         0 $A->appendTextNode($st->object->abs);
209             }
210             elsif ($st->object->is_blank)
211             {
212 3         241 $DD->setAttribute('class', 'blank');
213            
214 3         71 my $A = $DD->addNewChild(XHTML_NS, 'span');
215 3         18 $A->setAttribute('rel', $self->_make_curie($st->predicate));
216 3         62 $A->setAttribute('resource', '[_:'.$st->object->value.']');
217 3         54 $A->appendTextNode('_:'.$st->object->value);
218             }
219             elsif ($self->{'safe_xml_literals'}
220             && $st->object->is_literal
221             && $st->object->datatype->value eq 'http://www.w3.org/1999/02/22-rdf-syntax-ns#XMLLiteral')
222             {
223 0         0 $DD->setAttribute('property', $self->_make_curie($st->predicate));
224 0         0 $DD->setAttribute('class', 'typed-literal datatype-xmlliteral');
225 0         0 $DD->setAttribute('datatype', $self->_make_curie($st->object->datatype));
226 0         0 $DD->setAttribute('content', encode_utf8($st->object->value));
227 0         0 $DD->addNewChild(XHTML_NS, 'pre')->addNewChild(XHTML_NS, 'code')->appendTextNode(encode_utf8($st->object->value));
228             }
229             elsif ($st->object->is_literal
230             && $st->object->datatype->value eq 'http://www.w3.org/1999/02/22-rdf-syntax-ns#XMLLiteral')
231             {
232 0         0 $DD->setAttribute('property', $self->_make_curie($st->predicate));
233 0         0 $DD->setAttribute('class', 'typed-literal datatype-xmlliteral');
234 0         0 $DD->setAttribute('datatype', $self->_make_curie($st->object->datatype));
235 0         0 $DD->appendWellBalancedChunk(encode_utf8($st->object->value));
236             }
237             elsif ($st->object->is_literal)
238             {
239 10         3404 $DD->setAttribute('property', $self->_make_curie($st->predicate));
240 10         160 $DD->setAttribute('class', 'typed-literal');
241 10 100       125 if ($st->object->has_language) {
242 3         46 $DD->setAttribute('xml:lang', ''.$st->object->language);
243             }
244 10         270 $DD->setAttribute('datatype', $self->_make_curie($st->object->datatype));
245 10         242 $DD->appendTextNode(encode_utf8($st->object->value));
246             }
247              
248 13 100 100     134 if ($interlink && !$st->object->is_literal)
249             {
250 1 50       56 if ($model->count_quads($st->object, undef, undef, undef))
251             {
252 1         352 $DD->appendTextNode(' ');
253 1         6 my $seealso = $DD->addNewChild(XHTML_NS, 'a');
254 1 50       7 $seealso->setAttribute('about', $st->object->is_resource ? $st->object->abs : '[_:'.$st->object->value.']');
255 1         54 $seealso->setAttribute('rel', $self->_make_curie('http://www.w3.org/2000/01/rdf-schema#seeAlso'));
256 1 50       18 $seealso->setAttribute('href', '#'._make_id($st->object->is_resource ? $st->object->abs : '_:'.$st->object->value, $id_prefix));
257 1         15 $seealso->appendTextNode($interlink);
258             }
259             }
260             }
261            
262 7 100       176 if ($interlink)
263             {
264 2         15 my $iter = $model->get_quads(undef, undef, $subject, undef)->materialize;
265 2 100       5381 if ($iter->peek)
266             {
267 1         203 my $seealsoDT = $DL->addNewChild(XHTML_NS, 'dt');
268 1         5 $seealsoDT->setAttribute('class', 'seeAlso');
269 1         18 $seealsoDT->appendTextNode($interlink);
270              
271 1         3 my $sadata = {};
272 1         4 while (my $sast = $iter->next)
273             {
274 1 50       82 my $sas = $sast->subject->is_resource ? $sast->subject->abs : '_:'.$sast->subject->value;
275 1         146 my $p = $self->_make_curie($sast->predicate);
276 1         23 $sadata->{$sas}->{$p} = $sast->predicate->abs;
277             }
278            
279 1         138 my $seealso = $DL->addNewChild(XHTML_NS, 'dd');
280 1         7 $seealso->setAttribute('class', 'seeAlso');
281 1         20 my @keys = sort keys %$sadata;
282 1         5 foreach my $sas (@keys)
283             {
284 1         10 my $span = $seealso->addNewChild(XHTML_NS, 'span');
285 1         6 $span->appendTextNode('is ');
286 1         3 my @pkeys = sort keys %{$sadata->{$sas}};
  1         9  
287 1         6 foreach my $curie (@pkeys)
288             {
289 1         6 my $i = $span->addNewChild(XHTML_NS, 'i');
290 1         6 $i->appendTextNode($curie);
291 1         4 $i->setAttribute(title => $sadata->{$sas}->{$curie});
292 1 50       17 $span->appendTextNode( $curie eq $pkeys[-1] ? '' : ', ' );
293             }
294 1         25 $span->appendTextNode(' of ');
295 1         8 my $a = $span->addNewChild(XHTML_NS, 'a');
296 1 50       14 $a->setAttribute('about', $sas !~ /^_:/ ? $sas : '[_:'.$sas.']');
297 1         18 $a->setAttribute('rel', $self->_make_curie('http://www.w3.org/2000/01/rdf-schema#seeAlso'));
298 1         18 $a->setAttribute('href', '#'._make_id($sas, $id_prefix));
299 1         14 $a->appendTextNode($sas);
300 1 50       21 $seealso->appendTextNode( $sas eq $keys[-1] ? '.' : '; ' );
301             }
302             }
303             }
304            
305 7         162 return $self;
306             }
307              
308             sub _resource_notes
309             {
310 2     2   8 my ($self, $subject, $node, $model, $notes_heading, $notes) = @_;
311            
312 2         4 my @relevant;
313            
314 2         6 foreach my $note (@$notes)
315             {
316 2 100       14 push @relevant, $note
317             if $note->is_relevant_to($subject);
318             }
319            
320 2 100       488 if (@relevant) {
321 1         11 my $wrapper = $node->addNewChild(XHTML_NS, 'aside');
322 1         8 my $heading = $wrapper->addNewChild(XHTML_NS, 'h4');
323 1   50     7 $heading->appendTextNode($notes_heading || 'Notes');
324              
325 1         5 my $list = $wrapper->addNewChild(XHTML_NS, 'ul');
326              
327 1         3 foreach my $note (@relevant)
328             {
329 1         9 $list->appendChild( $note->node(XHTML_NS, 'li') );
330             }
331             }
332            
333 2         50 return $self;
334             }
335              
336             sub _img
337             {
338 7     7   459 my ($self, $type) = @_;
339            
340 7 50       31 if ($type eq 'urn:x-rdf-rdfa-linter:internals:OpenGraphProtocolNode')
341             {
342 0         0 return 'data:image/png;charset=binary;base64,iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAIAAACQkWg2AAAAAXNSR0IArs4c6QAAAAlwSFlzAAALEwAACxMBAJqcGAAAAAd0SU1FB9oFEBYGBzcdoOEAAALhSURBVCjPJdLfb4trHADw7/d53nbr2661X9ZV29mE/VLMYplwchwnmCziR7iSEHbpQnAj7lxJJBIhJELcSBAh50iErAcJ2wnLRrJstQXdL7Sbtmpv173P3vd9nq8Ln7/hg3/t6BJCAEB9Q/2Na1d8Xt1YmsuaSVsKn7u6Sl/lZjoAIiIAEJG2aJpSyi2dnceOH87I4UfD12fyw7aJ0mIu3fHqZbHa7s4VxwLuECJDRA0Bund3vXz1cmWCjMyzz33uz31e4zsCANcg2Kimtz8Ya32xv+VC1N/BkPM//tzW03MEArN3b/1X6vJ8G+VKYmWUwjEyC8A0TPa7hVjMlsUbKjf7S2r4m//7YVl6sHB56q1uzGJkPYkC1HdQrEulxrAiAkgwMaC5y5ac6kRrdbfm83kfj9yYGtK4BvUdKhFnjENmEhbnubQwEcdwTK3rVh96S0KxkanIG61o56fyQzNDnrU7VfPf0jQwO4luDy1kcVmI5mehba8Mr6Ovw2wuoY83xrW8mHEslf+KP9P4/l+emUQ9QBURUJJsAVzDj694bpqQQW6GZcykJpUgQMeC+TQgQ2GAcjA1BqBAOuDYkE+hJcAyQdoglaWVuYPIHV8l1bVTzRo18pRbJoRalFVEZJCbxtadMhyj3kuat1L5Sqo1f0ltuR6qaTRSH7C2BQpZNGbBsTgiWSYW81j8gQs5MjK44YAT9W9iHF0bQwcbti6kEqzvJrcFlAagrl1tOSq95RQI0qd+9uKqFmpWVVG+KXyIAWBb8FBT0+rYHpGbZv7l5KugQgYKGSzmMdhITduULUDSUlfzmYf34khERJQujj4YPTk+mB154jHm0OUh7oKlAgKDtr2yPCpe34YTPacGBt4hEf1umBMTzycvJr68zk2UZpPMsdBbTsEWq2pF6a7m02ay7uy587Zto1Lqd10AcJSVLo6OZ3u/L35ylPC5qiL+9rbQvn8ePr9z9346lXKk/AUjmnS/afx+BwAAAABJRU5ErkJggg==';
343             }
344            
345 7         407 my $icons = {
346             'http://bblfish.net/work/atom-owl/2006-06-06/#Entry' => 'page_white_link',
347             'http://bblfish.net/work/atom-owl/2006-06-06/#Feed' => 'feed',
348             'http://commontag.org/ns#AuthorTag' => 'tag_green',
349             'http://commontag.org/ns#AutoTag' => 'tag_red',
350             'http://commontag.org/ns#ReaderTag' => 'tag_yellow',
351             'http://commontag.org/ns#Tag' => 'tag_blue',
352             'http://ontologi.es/doap-bugs#Bug' => 'bug',
353             'http://purl.org/goodrelations/v1#PriceSpecification' => 'money',
354             'http://purl.org/NET/book/vocab#Book' => 'book',
355             'http://purl.org/NET/c4dm/event.owl#Event' => 'date',
356             'http://purl.org/ontology/bibo/Book' => 'book',
357             'http://purl.org/rss/1.0/channel' => 'feed',
358             'http://purl.org/rss/1.0/item' => 'page_white_link' ,
359             'http://purl.org/stuff/rev#Review' => 'award_star_gold_1',
360             'http://rdf.data-vocabulary.org/#Organization' => 'chart_organisation',
361             'http://rdf.data-vocabulary.org/#Person' => 'user',
362             'http://rdf.data-vocabulary.org/#Review-aggregate' => 'award_star_add',
363             'http://rdf.data-vocabulary.org/#Review' => 'award_star_gold_1',
364             'http://schema.org/Person' => 'user_orange',
365             'http://schema.org/Event' => 'date',
366             'http://schema.org/FinancialService' => 'money',
367             'http://schema.org/TennisComplex' => 'sport_tennis',
368             'http://schema.org/Bakery' => 'cake',
369             'http://schema.org/Map' => 'world',
370             'http://schema.org/GolfClub' => 'sport_golf',
371             'http://schema.org/CafeOrCoffeeShop' => 'cup',
372             'http://schema.org/ProfilePage' => 'page_green',
373             'http://usefulinc.com/ns/doap#Project' => 'application_double',
374             'http://usefulinc.com/ns/doap#Version' => 'application_lightning',
375             'http://www.holygoat.co.uk/owl/redwood/0.1/tags/Tagging' => 'tag_blue_add',
376             'http://www.holygoat.co.uk/owl/redwood/0.1/tags/Tag' => 'tag_blue',
377             'http://www.w3.org/1999/02/22-rdf-syntax-ns#Property' => 'arrow_right',
378             'http://www.w3.org/2000/01/rdf-schema#Class' => 'cog',
379             'http://www.w3.org/2002/12/cal/ical#Vcalendar' => 'calendar',
380             'http://www.w3.org/2002/12/cal/ical#Vevent' => 'date',
381             'http://www.w3.org/2002/07/owl#AnnotationProperty' => 'arrow_right',
382             'http://www.w3.org/2002/07/owl#AsymmetricProperty' => 'arrow_right',
383             'http://www.w3.org/2002/07/owl#Class' => 'cog',
384             'http://www.w3.org/2002/07/owl#DatatypeProperty' => 'arrow_right',
385             'http://www.w3.org/2002/07/owl#DeprecatedProperty' => 'arrow_right',
386             'http://www.w3.org/2002/07/owl#FunctionalProperty' => 'arrow_right',
387             'http://www.w3.org/2002/07/owl#InverseFunctionalProperty' => 'arrow_right',
388             'http://www.w3.org/2002/07/owl#IrreflexiveProperty' => 'arrow_right',
389             'http://www.w3.org/2002/07/owl#ObjectProperty' => 'arrow_right',
390             'http://www.w3.org/2002/07/owl#OntologyProperty' => 'arrow_right',
391             'http://www.w3.org/2002/07/owl#ReflexiveProperty' => 'arrow_right',
392             'http://www.w3.org/2002/07/owl#SymmetricProperty' => 'arrow_right',
393             'http://www.w3.org/2002/07/owl#TransitiveProperty' => 'arrow_right',
394             'http://www.w3.org/2003/01/geo/wgs84_pos#Point' => 'world',
395             'http://www.w3.org/2003/01/geo/wgs84_pos#SpatialThing' => 'world',
396             'http://www.w3.org/2004/02/skos/core#Concept' => 'brick',
397             'http://www.w3.org/2004/02/skos/core#ConceptScheme' => 'bricks',
398             'http://www.w3.org/2006/vcard/ns#Address' => 'house',
399             'http://www.w3.org/2006/vcard/ns#Location' => 'world',
400             'http://www.w3.org/2006/vcard/ns#Vcard' => 'vcard',
401             'http://www.w3.org/ns/auth/rsa#RSAPublicKey' => 'key',
402             'http://xmlns.com/foaf/0.1/Agent' => 'user_gray',
403             'http://xmlns.com/foaf/0.1/Document' => 'page_white_text',
404             'http://xmlns.com/foaf/0.1/Group' => 'group',
405             'http://xmlns.com/foaf/0.1/Image' => 'image',
406             'http://xmlns.com/foaf/0.1/OnlineAccount' => 'status_online',
407             'http://xmlns.com/foaf/0.1/Organization' => 'chart_organisation',
408             'http://xmlns.com/foaf/0.1/Person' => 'user_green',
409             'http://xmlns.com/foaf/0.1/PersonalProfileDocument' => 'page_green',
410             };
411            
412 7   50     88 return Icon::FamFamFam::Silk->new($icons->{$type}||'asterisk_yellow')->uri;
413             }
414              
415             1;