File Coverage

blib/lib/Log/Agent/Message.pm
Criterion Covered Total %
statement 40 61 65.5
branch 9 20 45.0
condition n/a
subroutine 13 15 86.6
pod 7 13 53.8
total 69 109 63.3


line stmt bran cond sub pod time code
1             ###########################################################################
2             #
3             # Message.pm
4             #
5             # Copyright (C) 1999 Raphael Manfredi.
6             # Copyright (C) 2002-2017 Mark Rogaski, mrogaski@cpan.org;
7             # all rights reserved.
8             #
9             # See the README file included with the
10             # distribution for license information.
11             #
12             ##########################################################################
13            
14 14     14   95 use strict;
  14         27  
  14         588  
15            
16             ########################################################################
17             package Log::Agent::Message;
18            
19             use overload
20 14     14   17514 qw("" stringify);
  14         15400  
  14         78  
21            
22             #
23             # ->make
24             #
25             # Creation routine.
26             #
27             # Attributes:
28             # str formatted message string coming from user
29             # prepend_list list of strings to prepend to `str'
30             # append_list list of strings to append to `str'
31             #
32             sub make {
33 107     107 1 273 my $self = bless [], shift; # Array for minimal overhead
34 107         703 $self->[0] = $_[0];
35 107         235 return $self;
36             }
37            
38             #
39             # Attribute access
40             #
41            
42 107     107 0 770 sub str { $_[0]->[0] }
43 63     63 0 119 sub prepend_list { $_[0]->[1] }
44 38     38 0 76 sub append_list { $_[0]->[2] }
45            
46             #
47             # Attribute setting
48             #
49            
50 74     74 0 188 sub set_str { $_[0]->[0] = $_[1] }
51 30     30 0 67 sub set_prepend_list { $_[0]->[1] = $_[1] }
52 5     5 0 11 sub set_append_list { $_[0]->[2] = $_[1] }
53            
54             #
55             # ->prepend
56             #
57             # Add string to the prepend list, at its TAIL.
58             # (i.e. the first to prepend gets output first)
59             #
60             sub prepend {
61 30     30 1 58 my $self = shift;
62 30         53 my ($str) = @_;
63            
64 30         74 my $array = $self->prepend_list;
65 30 50       129 $array = $self->set_prepend_list([]) unless $array;
66            
67 30         51 push(@{$array}, $str);
  30         86  
68             }
69            
70             #
71             # ->prepend_first
72             #
73             # Add string to the prepend list, at its HEAD.
74             #
75             sub prepend_first {
76 0     0 1 0 my $self = shift;
77 0         0 my ($str) = @_;
78            
79 0         0 my $array = $self->prepend_list;
80 0 0       0 $array = $self->set_prepend_list([]) unless $array;
81            
82 0         0 unshift(@{$array}, $str);
  0         0  
83             }
84            
85             #
86             # ->append
87             #
88             # Add string to the append list, at its HEAD.
89             # (i.e. the first to append gets output last)
90             #
91             sub append {
92 5     5 1 9 my $self = shift;
93 5         11 my ($str) = @_;
94            
95 5         19 my $array = $self->append_list;
96 5 50       24 $array = $self->set_append_list([]) unless $array;
97            
98 5         12 unshift(@{$array}, $str);
  5         15  
99             }
100            
101             #
102             # ->append_last
103             #
104             # Add string to the append list, at its TAIL.
105             #
106             sub append_last {
107 0     0 1 0 my $self = shift;
108 0         0 my ($str) = @_;
109            
110 0         0 my $array = $self->append_list;
111 0 0       0 $array = $self->set_append_list([]) unless $array;
112            
113 0         0 push(@{$array}, $str);
  0         0  
114             }
115            
116             #
117             # ->stringify
118             # (stringify)
119             #
120             # Returns complete string, with all prepended strings first, then the
121             # original string followed by all the appended strings.
122             #
123             sub stringify {
124 132     132 1 250 my $self = shift;
125 132 100       186 return $self->[0] if @{$self} == 1; # Optimize usual case
  132         1640  
126            
127 33         86 my $prepend = $self->prepend_list;
128 33         154 my $append = $self->append_list;
129            
130             return
131 30         135 ($prepend ? join('', @{$prepend}) : '') .
132             $self->str .
133 33 100       93 ($append ? join('', @{$append}) : '');
  5 100       157  
134             }
135            
136             #
137             # ->clone
138             #
139             # Clone object
140             # (not a deep clone, but prepend and append lists are also shallow-cloned.)
141             #
142             sub clone {
143 6     6 1 10 my $self = shift;
144 6         19 my $other = bless [], ref $self;
145 6         14 $other->[0] = $self->[0];
146 6 50       9 return $other if @{$self} == 1; # Optimize usual case
  6         25  
147            
148 0 0         if (defined $self->[1]) {
149 0           my @array = @{$self->[1]};
  0            
150 0           $other->[1] = \@array;
151             }
152 0 0         if (defined $self->[2]) {
153 0           my @array = @{$self->[2]};
  0            
154 0           $other->[2] = \@array;
155             }
156            
157 0           return $other;
158             }
159            
160             1; # for require
161             __END__