File Coverage

blib/lib/Protocol/Yadis/Document/Service.pm
Criterion Covered Total %
statement 72 73 98.6
branch 16 24 66.6
condition 1 2 50.0
subroutine 12 12 100.0
pod 8 8 100.0
total 109 119 91.6


line stmt bran cond sub pod time code
1             package Protocol::Yadis::Document::Service;
2              
3 5     5   24323 use strict;
  5         13  
  5         215  
4 5     5   31 use warnings;
  5         10  
  5         289  
5              
6 5     5   1912 use overload '""' => sub { shift->to_string }, fallback => 1;
  5     4   1268  
  5         52  
  4         16  
7              
8             sub new {
9 1     1 1 15 my $class = shift;
10              
11 1         2 my $self = {@_};
12 1         4 bless $self, $class;
13              
14 1   50     42 $self->{attrs} ||= [];
15 1         3 $self->{_elements} = [];
16              
17 1         3 return $self;
18             }
19              
20 18 100   18 1 69 sub attrs { defined $_[1] ? $_[0]->{attrs} = $_[1] : $_[0]->{attrs} }
21              
22 1     1 1 3 sub Type { shift->element('Type') }
23 2     2 1 7 sub URI { shift->element('URI') }
24              
25             sub element {
26 6     6 1 10 my $self = shift;
27 6         7 my $name = shift;
28 6 50       14 return unless $name;
29              
30 6 50       6 if (my @elements = grep { $_->name eq $name } @{$self->elements}) {
  18         41  
  6         11  
31 6         28 return [@elements];
32             }
33             }
34              
35             sub elements {
36 15     15 1 19 my $self = shift;
37              
38 15 100       33 if (@_) {
39 2         21 $self->{_elements} = [];
40              
41 2         14 foreach my $element (@{$_[0]}) {
  2         5  
42 8         5 push @{$self->{_elements}}, $element;
  8         20  
43             }
44             }
45             else {
46 32         87 my @priority =
47 13         13 grep { defined $_->attr('priority') } @{$self->{_elements}};
  13         28  
48 32         72 my @other =
49 13         16 grep { not defined $_->attr('priority') } @{$self->{_elements}};
  13         22  
50              
51 1         4 my @sorted =
52 13         26 sort { $a->attr('priority') cmp $b->attr('priority') } @priority;
53 13         20 push @sorted, @other;
54              
55 13         35 return [sort { $a->name cmp $b->name } @sorted];
  36         74  
56             }
57             }
58              
59             sub attr {
60 3     3 1 7 my $self = shift;
61 3         5 my $name = shift;
62 3 50       9 return unless $name;
63              
64 3         7 my $attrs = $self->attrs;
65              
66 3         3 my $i = 0;
67 3         10 for (; $i < @$attrs; $i += 2) {
68 3 50       9 last if $attrs->[$i] eq $name;
69             }
70              
71 3 100       8 if (@_) {
72 2         4 my $value = shift;
73 2 50       5 if ($i >= @$attrs) {
74 0 0       0 push @$attrs, ($name => $value) if $value;
75             }
76             else {
77 2         5 $attrs->[$i + 1] = $value;
78             }
79 2         5 return $self;
80             }
81              
82 1 50       4 return if $i >= @$attrs;
83              
84 1         5 return $attrs->[$i + 1];
85             }
86              
87             sub to_string {
88 4     4 1 5 my $self = shift;
89              
90 4         8 my $attrs = '';
91 4         7 for (my $i = 0; $i < @{$self->attrs}; $i += 2) {
  7         37  
92 3 100       5 next unless $self->attrs->[$i + 1];
93 2         3 $attrs .= ' ';
94 2         5 $attrs .= $self->attrs->[$i] . '="' . $self->attrs->[$i + 1] . '"';
95             }
96              
97 4         5 my $elements = '';
98 4         6 foreach my $element (@{$self->elements}) {
  4         10  
99 5         6 $elements .= "\n";
100 5         12 $elements .= " $element";
101             }
102 4 100       13 $elements .= "\n" if $elements;
103              
104 4         29 return "$elements";
105             }
106              
107             1;
108             __END__