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   97 use strict;
  14         31  
  14         702  
15              
16             ########################################################################
17             package Log::Agent::Message;
18              
19             use overload
20 14     14   18459 qw("" stringify);
  14         15956  
  14         92  
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 113     113 1 279 my $self = bless [], shift; # Array for minimal overhead
34 113         709 $self->[0] = $_[0];
35 113         243 return $self;
36             }
37              
38             #
39             # Attribute access
40             #
41              
42 108     108 0 777 sub str { $_[0]->[0] }
43 65     65 0 121 sub prepend_list { $_[0]->[1] }
44 39     39 0 73 sub append_list { $_[0]->[2] }
45              
46             #
47             # Attribute setting
48             #
49              
50 74     74 0 191 sub set_str { $_[0]->[0] = $_[1] }
51 31     31 0 65 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 31     31 1 53 my $self = shift;
62 31         54 my ($str) = @_;
63              
64 31         73 my $array = $self->prepend_list;
65 31 50       112 $array = $self->set_prepend_list([]) unless $array;
66              
67 31         51 push(@{$array}, $str);
  31         94  
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 11 my $self = shift;
93 5         10 my ($str) = @_;
94              
95 5         24 my $array = $self->append_list;
96 5 50       24 $array = $self->set_append_list([]) unless $array;
97              
98 5         13 unshift(@{$array}, $str);
  5         16  
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 141     141 1 286 my $self = shift;
125 141 100       197 return $self->[0] if @{$self} == 1; # Optimize usual case
  141         1751  
126              
127 34         103 my $prepend = $self->prepend_list;
128 34         113 my $append = $self->append_list;
129              
130             return
131 31         139 ($prepend ? join('', @{$prepend}) : '') .
132             $self->str .
133 34 100       81 ($append ? join('', @{$append}) : '');
  5 100       158  
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 11 my $self = shift;
144 6         17 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         21  
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__