File Coverage

blib/lib/Data/Freq/Record.pm
Criterion Covered Total %
statement 66 70 94.2
branch 29 36 80.5
condition n/a
subroutine 13 13 100.0
pod 6 6 100.0
total 114 125 91.2


line stmt bran cond sub pod time code
1 5     5   55672 use 5.006;
  5         21  
2 5     5   24 use strict;
  5         9  
  5         84  
3 5     5   19 use warnings;
  5         10  
  5         227  
4              
5             package Data::Freq::Record;
6              
7             =head1 NAME
8              
9             Data::Freq::Record - Represents a record added to Data::Freq counting
10              
11             =head1 VERSION
12              
13             Version 0.04
14              
15             =cut
16              
17             our $VERSION = '0.04';
18              
19 5     5   24 use base 'Exporter';
  5         45  
  5         483  
20 5     5   29 use Carp qw(croak);
  5         10  
  5         285  
21 5     5   483 use Date::Parse qw(str2time);
  5         6168  
  5         3893  
22              
23             our @EXPORT_OK = qw(logsplit);
24              
25             =head1 EXPORT
26              
27             =head2 logsplit
28              
29             Splits a text that represents a line in a log file.
30              
31             use Data::Freq::Record qw(logsplit);
32            
33             logsplit("12.34.56.78 - user1 [01/Jan/2012:01:02:03 +0000] "GET / HTTP/1.1" 200 44");
34            
35             # Returns an array with:
36             # [0]: '12.34.56.78'
37             # [1]: '-'
38             # [2]: '[01/Jan/2012:01:02:03 +0000]'
39             # [3]: '"GET / HTTP/1.1"'
40             # [4]: '200'
41             # [5]: '44'
42              
43             A log line is typically whitespace-separated, while anything inside
44             brackets C<[...]>, braces C<{...}>, parentheses C<(...)>, double quotes C<"...">,
45             or single quotes C<'...'> is considered as one chunk as a whole
46             even if whitespaces may be included inside.
47              
48             The C function is intended to split such a log line into an array.
49              
50             =cut
51              
52             sub logsplit {
53 34     34 1 1673 my $log = shift;
54 34         46 my @ret = ();
55            
56 34         467 push @ret, $1 while $log =~ m/ (
57             " (?: \\" | "" | [^"] )* " |
58             ' (?: \\' | '' | [^'] )* ' |
59             \[ (?: \\[\[\]] | \[\[ | \]\] | [^\]] )* \] |
60             \( (?: \\[\(\)] | \(\( | \)\) | [^\)] )* \) |
61             \{ (?: \\[\{\}] | \{\{ | \}\} | [^\}] )* \} |
62             \S+
63             ) /gx;
64            
65 34         145 return @ret;
66             }
67              
68             =head1 METHODS
69              
70             =head2 new
71              
72             Usage:
73              
74             # Text
75             Data::Freq::Record->new("text");
76            
77             Data::Freq::Record->new("an input line from a log file\n");
78             # Line break at the end will be stripped off
79            
80             # Array ref
81             Data::Freq::Record->new(['an', 'array', 'ref']);
82            
83             # Hash ref
84             Data::Freq::Record->new({key => 'hash ref'});
85              
86             Constructs a record object, which carries an input data
87             in the form of a text, an array ref, or a hash ref.
88             Each form of the input (or a converted value) can be retrieved
89             by the L, L, or L function.
90              
91             When an array ref is required via the L() method
92             while a text is given as the input, the array ref is created internally
93             by the L function.
94              
95             When a text is required via the L method
96             while an array ref is given as the input, the text is taken
97             from the first element of the array.
98              
99             The hash form is incompatible with the other forms, and whenever an incompatible
100             form is required, the return value is C.
101              
102             If the text input has a line break at the end, it is stripped off.
103             If the line break should not be stripped off, use an array ref with the first element
104             set to the text.
105              
106             =cut
107              
108             sub new {
109 186     186 1 9466 my ($class, $input) = @_;
110            
111 186         506 my $self = bless {
112             init => undef,
113             text => undef,
114             array => undef,
115             hash => undef,
116             date => undef,
117             date_tried => 0,
118             }, $class;
119            
120 186 50       452 if (!defined $input) {
    100          
    100          
    50          
121 0         0 $self->{text} = '';
122 0         0 $self->{init} = 'text';
123             } elsif (!ref $input) {
124 121         239 $input =~ s/\r?\n$//;
125 121         186 $self->{text} = $input;
126 121         174 $self->{init} = 'text';
127             } elsif (ref $input eq 'ARRAY') {
128 60         84 $self->{array} = $input;
129 60         69 $self->{init} = 'array';
130             } elsif (ref $input eq 'HASH') {
131 5         10 $self->{hash} = $input;
132 5         11 $self->{init} = 'hash';
133             } else {
134 0         0 croak "invalid argument type: ".ref($input);
135             }
136            
137 186         363 return $self;
138             }
139              
140             =head2 text
141              
142             Retrieves the text form of the input.
143              
144             If the input was an array ref, the first element of the array is returned.
145              
146             =cut
147              
148             sub text {
149 98     98 1 118 my $self = shift;
150 98 100       244 return $self->{text} if defined $self->{text};
151            
152 4 100       12 if (defined $self->{array}) {
153 2         4 $self->{text} = $self->{array}[0];
154 2         6 return $self->{text};
155             }
156            
157 2         6 return undef;
158             }
159              
160             =head2 array
161              
162             Retrieves the array ref form of the input.
163              
164             If the input was a text, it is split by the L function..
165              
166             =cut
167              
168             sub array {
169 158     158 1 180 my $self = shift;
170 158 100       424 return $self->{array} if defined $self->{array};
171            
172 30 100       51 if (defined $self->{text}) {
173 28         57 $self->{array} = [logsplit $self->{text}];
174 28         98 return $self->{array};
175             }
176            
177 2         8 return undef;
178             }
179              
180             =head2 hash
181              
182             Retrieves the hash ref form of the input.
183              
184             =cut
185              
186             sub hash {
187 5     5 1 9 my $self = shift;
188 5 100       22 return $self->{hash} if defined $self->{hash};
189 2         7 return undef;
190             }
191              
192             =head2 date
193              
194             Extracts a date/time from the input and returns the timestamp value.
195              
196             The date/time is retrieved from the array ref form (or from a split text),
197             where the first element enclosed by a pair of brackets C<[...]> is
198             parsed by the L function.
199              
200             =cut
201              
202             sub date {
203 18     18 1 50 my $self = shift;
204 18 50       44 return $self->{date} if $self->{date_tried};
205            
206 18         22 $self->{date_tried} = 1;
207            
208 18 50       33 my $array = $self->array or return undef;
209            
210 18 100       38 if (my $pos = shift) {
211 1         5 my $str = "@$array[@$pos]";
212 1         3 $str =~ s/^ \[ (.*) \] $/$1/x;
213 1 50       4 return $self->{date} = $str if $str !~ /\D/;
214 1         3 return $self->{date} = _str2time($str);
215             }
216            
217 17         28 for my $item (@$array) {
218 44 100       92 if ($item =~ /^ \[ (.*) \] $/x) {
219 17         34 my $t = _str2time($1);
220 17 50       110 return $self->{date} = $t if defined $t;
221             }
222             }
223            
224 0         0 return undef;
225             }
226              
227             sub _str2time {
228 18     18   27 my $str = shift;
229            
230 18 100       49 my $msec = $1 if $str =~ s/[,\.](\d+)$//;
231 18         48 my $t = str2time($str);
232 18 50       3571 return undef unless defined $t;
233            
234 18 100       34 $t += "0.$msec" if $msec;
235 18         64 return $t;
236             }
237              
238             =head1 AUTHOR
239              
240             Mahiro Ando, C<< >>
241              
242             =head1 LICENSE AND COPYRIGHT
243              
244             Copyright 2012 Mahiro Ando.
245              
246             This program is free software; you can redistribute it and/or modify it
247             under the terms of either: the GNU General Public License as published
248             by the Free Software Foundation; or the Artistic License.
249              
250             See http://dev.perl.org/licenses/ for more information.
251              
252             =cut
253              
254             1;