File Coverage

blib/lib/XML/Loy/Atom/Threading.pm
Criterion Covered Total %
statement 51 53 96.2
branch 21 28 75.0
condition 2 5 40.0
subroutine 9 9 100.0
pod 4 4 100.0
total 87 99 87.8


line stmt bran cond sub pod time code
1             package XML::Loy::Atom::Threading;
2 3     3   3062 use strict;
  3         7  
  3         121  
3 3     3   15 use warnings;
  3         20  
  3         144  
4              
5             our $PREFIX;
6 3     3   87 BEGIN { $PREFIX = 'thr' };
7              
8 3         14 use XML::Loy with => (
9             prefix => $PREFIX,
10             namespace => 'http://purl.org/syndication/thread/1.0'
11 3     3   15 );
  3         7  
12              
13 3     3   20 use Carp qw/carp/;
  3         7  
  3         1907  
14              
15              
16             # No constructor
17             sub new {
18 1     1 1 347 carp 'Only use ' . __PACKAGE__ . ' as an extension to Atom';
19 1         480 return;
20             };
21              
22              
23             # Set 'in-reply-to' element
24             sub in_reply_to {
25 10     10 1 20 my ($self, $ref, $param) = @_;
26              
27             # Add in-reply-to
28 10 100       58 if ($ref) {
29              
30             # No ref defined
31 4 50       10 return unless defined $ref;
32              
33             # Adding a related link as advised in the spec
34 4 50       10 if (defined $param->{href}) {
35 4         14 my $link = $self->link(related => $param->{href});
36 4 100       14 $link->attr->{type} = $param->{type} if $param->{type};
37             };
38              
39 4         30 $param->{ref} = $ref;
40 4         10 return $self->add('in-reply-to' => $param );
41             };
42              
43             # Current node is root
44 6 100       18 unless ($self->parent) {
45 2         28 return $self->at('*')->children('in-reply-to');
46             };
47              
48             # Return collection
49 4         77 return $self->children('in-reply-to');
50             };
51              
52              
53             # Add 'link' element for replies
54             sub replies {
55 6     6 1 10 my $self = shift;
56 6         9 my $href = shift;
57              
58             # Add link
59 6 100       13 if ($href) {
60              
61 3         5 my %param = %{ shift(@_) };
  3         11  
62              
63 3         10 my %new_param = (href => $href);
64 3 50       9 if (exists $param{count}) {
65 3         8 $new_param{$PREFIX . ':count'} = delete $param{count};
66             };
67              
68             # updated parameter exists
69 3 100       9 if (exists $param{updated}) {
70 2         5 my $date = delete $param{updated};
71              
72             # Date is no object
73 2 50       23 $date = XML::Loy::Date::RFC3339->new($date) unless ref $date;
74              
75             # Set parameter
76 2         9 $new_param{$PREFIX . ':updated'} = $date->to_string;
77             };
78              
79 3   33     29 $new_param{type} = $param{type} // $self->mime;
80              
81             # Add atom link
82 3         13 return $self->link(rel => 'replies', %new_param );
83             };
84              
85             # Get replies
86 3         7 my $replies = $self->link('replies');
87              
88             # Return first link
89 3 50       57 return $replies->[0] if $replies->[0];
90              
91 0         0 return;
92             };
93              
94              
95             # Add total value
96             sub total {
97 10     10 1 20 my ($self, $count, $param) = @_;
98              
99             # Set count
100 10 100       20 if ($count) {
101              
102             # Set new total element
103 5   50     28 return $self->set(total => ($param || {}) => $count);
104             };
105              
106             # Get total
107 5         6 my $total;
108              
109             # Current node is root
110 5 100       11 unless ($self->parent) {
111 1         11 $total = $self->at('*')->children('total');
112             }
113              
114             # Current node is entry or something
115             else {
116 4         77 $total = $self->children('total');
117             };
118              
119             # No total set
120 5 50       37 return 0 unless $total = $total->[0];
121              
122             # Return count
123 5 50       27 return $total->text if $total->text;
124              
125 0           return 0;
126             };
127              
128              
129             1;
130              
131              
132             __END__