File Coverage

blib/lib/PFT/Map/Node.pm
Criterion Covered Total %
statement 107 117 91.4
branch 39 58 67.2
condition 5 9 55.5
subroutine 35 40 87.5
pod 15 25 60.0
total 201 249 80.7


line stmt bran cond sub pod time code
1             # Copyright 2014-2016 - Giovanni Simoni
2             #
3             # This file is part of PFT.
4             #
5             # PFT is free software: you can redistribute it and/or modify it under the
6             # terms of the GNU General Public License as published by the Free
7             # Software Foundation, either version 3 of the License, or (at your
8             # option) any later version.
9             #
10             # PFT is distributed in the hope that it will be useful, but WITHOUT ANY
11             # WARRANTY; without even the implied warranty of MERCHANTABILITY or
12             # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13             # for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with PFT. If not, see .
17             #
18             package PFT::Map::Node v1.3.0;
19              
20             =encoding utf8
21              
22             =head1 NAME
23              
24             PFT::Map::Node - Node of a PFT site map
25              
26             =head1 SYNOPSIS
27              
28             PFT::Map::Node->new($seqnr, $id, $content);
29             PFT::Map::Node->new($seqnr, $id, undef, $header);
30             PFT::Map::Node->new($seqnr, $id, $content, $header);
31              
32             =head1 DESCRIPTION
33              
34             Objects of type C are nodes of the site map. They are
35             created within a C object. Each node is identified by a unique
36             sequence number and by a mnemonic identifier.
37              
38             The first form of constructor in the B creates a
39             C without providing a header. This is possible because a
40             content item (C instance) is provided. The
41             constructor will make an attempt to read the header.
42              
43             The second and third forms shall be used when the header is already
44             available (as optimization to avoid the system to fetch it again), or in
45             those situation in which the header cannot be retrieved.
46              
47             The header cannot be retrieved from entries which do not correspond to a
48             real file (I). Nodes referring to I
49             are called I. They represent an auto-generated pages within
50             a PFT site (typical case: I and I.
51              
52             See the C implementation for further details.
53              
54             =cut
55              
56 3     3   18 use utf8;
  3         122  
  3         20  
57 3     3   98 use v5.16;
  3         10  
58 3     3   13 use strict;
  3         5  
  3         52  
59 3     3   12 use warnings;
  3         7  
  3         82  
60              
61 3     3   1180 use PFT::Text;
  3         10  
  3         95  
62              
63 3     3   20 use Carp;
  3         5  
  3         160  
64 3     3   18 use Scalar::Util qw/weaken/;
  3         6  
  3         4617  
65              
66             sub new {
67 25     25 0 65 my($cls, $seqnr, $id, $cont, $hdr) = @_;
68 25 50 33     134 confess 'Need content or header' unless $cont || $hdr;
69 25 50       141 confess "Not content: $cont" unless $cont->isa('PFT::Content::Base');
70              
71             bless {
72             seqnr => $seqnr,
73             id => $id,
74             cont => $cont,
75              
76             # Rule of the game: header might be obtained by content, but if
77             # content is virtual (i.e. !$coontent->exists) it must be
78             # provided. Only PFT::Content::Entry object have headers.
79             hdr => defined $hdr
80             ? $hdr
81             : $cont->isa('PFT::Content::Entry')
82 25 100       124 ? do {
    100          
83 15 50       38 $cont->exists or confess
84             "No header for virtual content $cont";
85 15         64 $cont->header
86             }
87             : undef
88             }, $cls
89             }
90              
91             =head2 Properties
92              
93             =over 1
94              
95             =item header
96              
97             Header associated with this node.
98              
99             This property could return C if the node is associated with a
100             non-textual content (something which C but not a
101             C).
102              
103             =cut
104              
105 105     105 1 242 sub header { shift->{hdr} }
106              
107             =item content
108              
109             The content associated with this node.
110              
111             This property could return undefined for the nodes which do not correspond
112             to any content.
113              
114             =cut
115              
116 20     20 1 98 sub content { shift->{cont} }
117              
118             =item date
119              
120             Returns the date of the content, or undef if the content is not recording
121             any date.
122              
123             =cut
124              
125             sub date {
126 50     50 1 80 my $hdr = shift->header;
127 50 50       154 $hdr ? $hdr->date : undef
128             }
129              
130             =item seqnr
131              
132             Returns the sequential id of the node.
133              
134             Reported verbatim as by constructor parameter.
135              
136             =cut
137              
138 43     43 1 178 sub seqnr { shift->{seqnr} }
139              
140             =item id
141              
142             Returns the mnemonic identifier, unique for the whole site.
143              
144             Reported verbatim as by constructor parameter.
145              
146             =cut
147              
148 62     62 1 223 sub id { shift->{id} }
149              
150             =item title
151              
152             Returns the title of the content.
153              
154             The title is retrieved from the header. Content items like pictures do not
155             have a header, so they don't have a title: C is returned if this is
156             the case.
157              
158             =cut
159              
160             sub title {
161 13     13 1 74 my $self = shift;
162 13         25 my $hdr = $self->header;
163 13 100       29 unless (defined $hdr) { return undef }
  2         7  
164 11         23 my $title = $hdr->title;
165 11 100 66     31 if (!defined($title) && $self->content->isa('PFT::Content::Month')) {
166 1         3 sprintf("%04d / %02d", @{$hdr->date}[0, 1])
  1         2  
167             } else {
168 10         45 $title;
169             }
170             }
171              
172             =item author
173              
174             Returns the author of the content.
175              
176             The author is retrieved from the header. Content items like pictures do not
177             have a header, so they don't have an author: C is returned if this is
178             the case.
179              
180             =cut
181              
182             sub author {
183 0     0 1 0 my $hdr = shift->header;
184 0 0       0 defined $hdr ? $hdr->author : undef
185             }
186              
187             =item virtual
188              
189             Returns 1 if the node is I.
190              
191             =cut
192              
193 46     46 1 150 sub virtual { !shift->{cont}->exists }
194              
195             =item content_type
196              
197             Returns the type of the content. Short for Ccontent)>
198              
199             This has nothing to do with HTTP content-type header (nor with HTTP at all).
200              
201             =cut
202              
203 0     0 1 0 sub content_type { ref(shift->content) }
204              
205             =back
206              
207             =head2 Routing properties
208              
209             Routing properties allow to access other nodes. For instance, the C
210             property of a node will correspond to the previous node in chronological
211             sense. They can be C (e.g. if the node does not have a
212             predecessor).
213              
214             The properties are:
215              
216             =over
217              
218             =item C: previous node;
219              
220             =item C: next node;
221              
222             =item C: list of tag nodes, possibly virtual;
223              
224             =item C: non-empty only for tag nodes, list of tagged nodes;
225              
226             =item C: non-empty only for month nodes, list of days in the month;
227              
228             =item C: list of nodes whose text is pointing to this node;
229              
230             =item C: links of node pointed by the text of this node;
231              
232             =item C: union of C and C
233              
234             =item C: list of symbols referenced in the text, sorted by
235             occourence
236              
237             Other methods are defined as setters for the mentioned properties. They
238             are currently not documented, but used in C.
239              
240             =back
241              
242             =cut
243              
244 13     13 1 31 sub next { shift->{next} }
245              
246             sub prev {
247 27     27 0 37 my $self = shift;
248 27 100       81 return $self->{prev} unless @_;
249              
250 9         15 my $p = shift;
251 9         24 weaken($self->{prev} = $p);
252 9         26 weaken($p->{next} = $self);
253             }
254              
255             sub month {
256 23     23 1 30 my $self = shift;
257 23 100       43 unless (@_) {
258 13 100       38 exists $self->{month} ? $self->{month} : undef;
259             } else {
260             confess 'Must be dated and date-complete'
261 10 50       22 unless eval{ $self->{hdr}->date->complete };
  10         24  
262              
263 10         18 my $m = shift;
264 10         32 weaken($self->{month} = $m);
265              
266 10         16 push @{$m->{days}}, $self;
  10         21  
267 10         30 weaken($m->{days}[-1]);
268             }
269             }
270              
271             sub _add {
272 19     19   42 my($self, $linked, $ka, $kb) = @_;
273              
274 19         25 push @{$self->{$ka}}, $linked;
  19         64  
275 19         70 weaken($self->{$ka}[-1]);
276              
277 19         27 push @{$linked->{$kb}}, $self;
  19         38  
278 19         98 weaken($linked->{$kb}[-1]);
279             }
280              
281             sub add_outlink {
282 15     15 0 30 my($self, $node) = @_;
283              
284             # An out-link can be either another node or a string to be placed on
285             # the page as it is. It can be also undef, meaning that we were not
286             # able to resolve that symbol.
287 15 100 66     38 if ($node && $node->isa('PFT::Map::Node')) {
288             # Building back-link if a node.
289 11         35 $self->_add($node, 'olns', 'inls')
290             } else {
291 4 50       10 confess "Invalid outlink: $node" if ref($node);
292             # Directly adding if a string or undef.
293 4         7 push @{$self->{'olns'}}, $node
  4         15  
294             }
295             }
296              
297 8     8 0 20 sub add_tag { shift->_add(shift, 'tags', 'tagged') }
298              
299             sub _list {
300 45     45   87 my($self, $name) = @_;
301             exists $self->{$name}
302 45 50       131 ? wantarray ? @{$self->{$name}} : $self->{$name}
  14 50       44  
    100          
303             : wantarray ? () : undef
304             }
305              
306 13     13 0 22 sub tags { shift->_list('tags') }
307 13     13 1 18 sub tagged { shift->_list('tagged') }
308 13     13 1 24 sub days { shift->_list('days') }
309 0     0 0 0 sub inlinks { shift->_list('ilns') }
310 6     6 0 15 sub outlinks { shift->_list('olns') }
311              
312             sub children {
313 0     0 0 0 my $self = shift;
314 0         0 $self->_list('tagged'),
315             $self->_list('days'),
316             }
317              
318             sub _text {
319 23     23   34 my $self = shift;
320 23 100       56 if (exists $self->{text}) {
321             $self->{text}
322 6         19 } else {
323 17         36 $self->{text} = PFT::Text->new($self->content)
324             }
325             }
326              
327 17     17 1 40 sub symbols { shift->_text->symbols }
328              
329             sub add_symbol_unres {
330 4     4 0 12 my($self, $symbol, $reason) = @_;
331              
332 4         11 $self->{unres_syms_flush} ++;
333 4         7 push @{$self->{unres_syms}}, [$symbol, $reason];
  4         22  
334             }
335              
336             # NOTE:
337             #
338             # Unresolved symbols should be notified to the user. Since this is a library,
339             # the calling code is responsible for notifying the user.
340             #
341             # As 'relaxed enforcement' we warn on STDERR if the list of unresolved symbols
342             # is never retrieved.
343             sub symbols_unres {
344 15     15 0 38 my $self = shift;
345 15         20 delete $self->{unres_syms_flush};
346              
347             # Returns a list of pairs [symbol, reason]
348             exists $self->{unres_syms}
349 15 100       31 ? @{$self->{unres_syms}}
  3         11  
350             : ()
351             }
352              
353             sub DESTROY {
354 13     13   8448 my $self = shift;
355 13 50       79 return unless exists $self->{unres_syms_flush};
356 0         0 warn 'Unnoticed unresolved symbols for PFT::Map::Node ', $self->id,
357             '. Please use PFT::Map::Node::symbols_unres'
358             }
359              
360             =head2 More complex methods
361              
362             =over 1
363              
364             =item html
365              
366             Expand HTML of the content, translating outbound links into
367             hyper-references (hrefs).
368              
369             Requires as parameter a callback mapping a C object into a
370             string representing path within the site. The callback is applied to all
371             symbols, and the resulting string will replace the symbol placeholder in
372             the HTML.
373              
374             Returns a string HTML, or an empty string if the node is virtual.
375              
376             =cut
377              
378             sub html {
379 6     6 1 41 my $self = shift;
380 6 50       17 return undef if $self->virtual;
381              
382 6 50       22 my $mkhref = shift or confess "Missing mkref parameter";
383             $self->_text->html_resolved(
384             map {
385 6 0       16 defined($_)
  12 50       51  
    100          
386             ? $_->isa('PFT::Map::Node')
387             ? $mkhref->($_) # Create reference of node
388             : ref($_)
389             ? confess "Not PFT::Map::Node: $_"
390             : $_ # Keep string as it is
391             : undef # Symbol could not be resolved.
392             } $self->outlinks
393             );
394             }
395              
396             use overload
397             '<=>' => sub {
398 75     75   115 my($self, $oth, $swap) = @_;
399 75         100 my $out = $self->{seqnr} <=> $oth->{seqnr};
400 75 50       182 $swap ? -$out : $out;
401             },
402             'cmp' => sub {
403 0     0   0 my($self, $oth, $swap) = @_;
404 0         0 my $out = $self->{cont} cmp $oth->{cont};
405 0 0       0 $swap ? -$out : $out;
406             },
407             '""' => sub {
408 40     40   73 my $self = shift;
409 40 100       87 'PFT::Map::Node[id=' . $self->id
410             . ', virtual=' . ($self->virtual ? 'yes' : 'no')
411             . ']'
412             },
413 3     3   26 ;
  3         7  
  3         37  
414              
415             =back
416              
417             =cut
418              
419             1;