File Coverage

blib/lib/Log/FreeSWITCH/Line.pm
Criterion Covered Total %
statement 35 35 100.0
branch 6 6 100.0
condition 3 3 100.0
subroutine 9 9 100.0
pod 2 2 100.0
total 55 55 100.0


line stmt bran cond sub pod time code
1             package Log::FreeSWITCH::Line;
2              
3 4     4   141352 use base qw(Exporter);
  4         43  
  4         465  
4 4     4   27 use strict;
  4         8  
  4         77  
5 4     4   17 use warnings;
  4         8  
  4         119  
6              
7 4     4   1937 use Error::Pure qw(err);
  4         27171  
  4         76  
8 4     4   1928 use Log::FreeSWITCH::Line::Data;
  4         11  
  4         121  
9 4     4   27 use Readonly;
  4         8  
  4         187  
10 4     4   24 use Scalar::Util qw(blessed);
  4         7  
  4         1923  
11              
12             Readonly::Array our @EXPORT_OK => qw{parse serialize};
13             Readonly::Scalar our $LOG_REGEXP => qr{(\d{4}-\d{2}-\d{2})\s+(\d{2}:\d{2}:\d{2}\.?\d*)\s+\[(\w+)\]\s+([^:]+):(\d+)\s+(.*)};
14             Readonly::Scalar our $SPACE => q{ };
15              
16             our $VERSION = 0.08;
17              
18             # Parse FreeSWITCH log line.
19             sub parse {
20 4     4 1 28961 my $data = shift;
21 4         8 my $data_o;
22 4 100       87 if ($data =~ m/^$LOG_REGEXP$/ms) {
23 3         20 $data_o = Log::FreeSWITCH::Line::Data->new(
24             'date' => $1,
25             'file' => $4,
26             'file_line' => $5,
27             'message' => $6,
28             'raw' => $data,
29             'time' => $2,
30             'type' => $3,
31             );
32             } else {
33 1         16 err 'Cannot parse data.',
34             'Data', $data;
35             }
36 3         236 return $data_o;
37             }
38              
39             # Serialize Log::FreeSWITCH::Line::Data object to FreeSWITCH log line.
40             sub serialize {
41 5     5 1 26256 my $data_o = shift;
42              
43             # Check object.
44 5 100 100     52 if (! blessed($data_o) || ! $data_o->isa('Log::FreeSWITCH::Line::Data')) {
45 2         57 err "Serialize object must be 'Log::FreeSWITCH::Line::Data' object.";
46             }
47              
48             # Serialize.
49 3         12 my $data = $data_o->date.
50             $SPACE.$data_o->time.
51             $SPACE.'['.$data_o->type.']'.
52             $SPACE.$data_o->file.':'.$data_o->file_line.
53             $SPACE;
54 3 100       97 if (defined $data_o->message) {
55 2         15 $data .= $data_o->message;
56             }
57 3         26 $data_o->raw($data);
58 3         25 return $data;
59             }
60              
61             1;
62              
63             __END__
64              
65             =pod
66              
67             =encoding utf8
68              
69             =head1 NAME
70              
71             Log::FreeSWITCH::Line - FreeSWITCH log line parsing and serializing.
72              
73             =head1 SYNOPSIS
74              
75             use Log::FreeSWITCH::Line qw(parse serialize);
76              
77             my $data_o = parse($data);
78             my $data = serialize($data_o);
79              
80             =head1 SUBROUTINES
81              
82             =head2 C<parse>
83              
84             my $data_o = parse($data);
85              
86             Parse FreeSWITCH log line.
87              
88             Returns Log::FreeSWITCH::Line::Data object.
89              
90             =head2 C<serialize>
91              
92             my $data = serialize($data_o);
93              
94             Serialize Log::FreeSWITCH::Line::Data object to FreeSWITCH log line.
95              
96             Returns string.
97              
98             =head1 ERRORS
99              
100             parse():
101             Cannot parse data.
102             Data: %s
103              
104             serialize():
105             Serialize object must be 'Log::FreeSWITCH::Line::Data' object.
106              
107             =head1 EXAMPLE1
108              
109             =for comment filename=parse_log_line.pl
110              
111             use strict;
112             use warnings;
113              
114             use Data::Printer;
115             use Log::FreeSWITCH::Line qw(parse);
116              
117             # Log record.
118             my $data = '2014-07-01 13:37:53.973562 [DEBUG] sofia.c:4045 inbound-codec-prefs [PCMA]';
119              
120             # Parse.
121             my $data_o = parse($data);
122              
123             # Dump.
124             p $data_o;
125              
126             # Output:
127             # Log::FreeSWITCH::Line::Data {
128             # Parents Mo::Object
129             # public methods (0)
130             # private methods (1) : _datetime
131             # internals: {
132             # date "2014-07-01",
133             # file "sofia.c",
134             # file_line 4045,
135             # message "inbound-codec-prefs [PCMA]",
136             # raw "2014-07-01 13:37:53.973562 [DEBUG] sofia.c:4045 inbound-codec-prefs [PCMA]",
137             # time "13:37:53.973562",
138             # type "DEBUG"
139             # }
140             # }
141              
142             =head1 EXAMPLE2
143              
144             =for comment filename=serialize_log_structure.pl
145              
146             use strict;
147             use warnings;
148              
149             use Log::FreeSWITCH::Line qw(serialize);
150             use Log::FreeSWITCH::Line::Data;
151              
152             # Data.
153             my $record = Log::FreeSWITCH::Line::Data->new(
154             'date' => '2014-07-01',
155             'file' => 'sofia.c',
156             'file_line' => 4045,
157             'message' => 'inbound-codec-prefs [PCMA]',
158             'time' => '13:37:53.973562',
159             'type' => 'DEBUG',
160             );
161              
162             # Serialize and print to stdout.
163             print serialize($record)."\n";
164              
165             # Output:
166             # 2014-07-01 13:37:53.973562 [DEBUG] sofia.c:4045 inbound-codec-prefs [PCMA]
167              
168             =head1 DEPENDENCIES
169              
170             L<Error::Pure>,
171             L<Exporter>,
172             L<Log::FreeSWITCH::Line::Data>,
173             L<Readonly>,
174             L<Scalar::Util>.
175              
176             =head1 SEE ALSO
177              
178             =over
179              
180             =item L<Log::FreeSWITCH::Line::Data>
181              
182             Data object which represents FreeSWITCH log line.
183              
184             =back
185              
186             =head1 REPOSITORY
187              
188             L<https://github.com/michal-josef-spacek/Log-FreeSWITCH-Line>
189              
190             =head1 AUTHOR
191              
192             Michal Josef Špaček L<mailto:skim@cpan.org>
193              
194             L<http://skim.cz>
195              
196             =head1 LICENSE AND COPYRIGHT
197              
198             © 2014-2022 Michal Josef Špaček
199              
200             BSD 2-Clause License
201              
202             =head1 VERSION
203              
204             0.08
205              
206             =cut