|
@@ -0,0 +1,181 @@
|
|
1
|
+#!perl -w
|
|
2
|
+
|
|
3
|
+## Author: Alois Mahdal at zxcvb cz
|
|
4
|
+# Helper class to help parse logs from a very primitive remote logging
|
|
5
|
+# service. Used by minions/bin/mksheet.pl to parse logs from htlog.cgi
|
|
6
|
+
|
|
7
|
+# This program is free software: you can redistribute it and/or modify
|
|
8
|
+# it under the terms of the GNU General Public License as published by
|
|
9
|
+# the Free Software Foundation, either version 3 of the License, or
|
|
10
|
+# (at your option) any later version.
|
|
11
|
+
|
|
12
|
+# This program is distributed in the hope that it will be useful,
|
|
13
|
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
14
|
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
15
|
+# GNU General Public License for more details.
|
|
16
|
+
|
|
17
|
+# You should have received a copy of the GNU General Public License
|
|
18
|
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
19
|
+
|
|
20
|
+
|
|
21
|
+package htsheet;
|
|
22
|
+use strict;
|
|
23
|
+use warnings;
|
|
24
|
+use Carp;
|
|
25
|
+
|
|
26
|
+
|
|
27
|
+##############
|
|
28
|
+# load logfile
|
|
29
|
+sub load {
|
|
30
|
+ my ($class, $args) = @_;
|
|
31
|
+
|
|
32
|
+ # make yourself
|
|
33
|
+ my $self = {};
|
|
34
|
+ $self->{data}->{main_columns} = [ qw/Time Origin Tag I/ ];
|
|
35
|
+ $self->{parsed} = 0;
|
|
36
|
+ $self->{lines} = [];
|
|
37
|
+ $self->{file} = $args->{file}
|
|
38
|
+ or croak("missing mandatory option: file");
|
|
39
|
+
|
|
40
|
+ # slurp the file
|
|
41
|
+ open my $fh, "<", $self->{file}
|
|
42
|
+ or croak("could not open file: $!");
|
|
43
|
+ @{$self->{lines}} = <$fh>;
|
|
44
|
+ chomp @{$self->{lines}};
|
|
45
|
+ close $fh or croak("could not close file: $!");
|
|
46
|
+ carp("zero lines loaded") unless @{$self->{lines}};
|
|
47
|
+
|
|
48
|
+ # bless and go
|
|
49
|
+ bless $self, $class;
|
|
50
|
+ return $self;
|
|
51
|
+}
|
|
52
|
+
|
|
53
|
+
|
|
54
|
+###############################################
|
|
55
|
+# parse out common fields and message from line
|
|
56
|
+sub parse_line {
|
|
57
|
+ my ($self, $line) = @_;
|
|
58
|
+ my $row;
|
|
59
|
+ my $row_head;
|
|
60
|
+ my $row_data;
|
|
61
|
+
|
|
62
|
+ ($row_head->{Time}) = $line
|
|
63
|
+ =~ m|Time: (\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d);|;
|
|
64
|
+ ($row_head->{Origin}) = $line =~ m|Origin: (\S*);|;
|
|
65
|
+ ($row_head->{Tag}) = $line =~ m|Tag: (.*?);|;
|
|
66
|
+ ($row_head->{I}) = $line =~ m|I: (.*?);|;
|
|
67
|
+ ($row_head->{Message}) = $line =~ m|Message: (.*)$|;
|
|
68
|
+
|
|
69
|
+ # parse oout Message: and throw it away
|
|
70
|
+ $row_data = $self->parse_message($row_head->{Message});
|
|
71
|
+ delete $row_head->{Message};
|
|
72
|
+
|
|
73
|
+ # merge head and data
|
|
74
|
+ %$row = (%$row_head, %$row_data);
|
|
75
|
+ return $row;
|
|
76
|
+}
|
|
77
|
+
|
|
78
|
+
|
|
79
|
+################################
|
|
80
|
+# parse data part of the message
|
|
81
|
+sub parse_message {
|
|
82
|
+ my ($self, $message) = @_;
|
|
83
|
+ my $data;
|
|
84
|
+
|
|
85
|
+ # split to fields
|
|
86
|
+ my @fields = split ";", $message;
|
|
87
|
+ %$data = map {
|
|
88
|
+ my @fld = split "=", $_;
|
|
89
|
+ ( 2 == scalar @fld ? @fld : (dummy => 'non-parseable') )
|
|
90
|
+ } @fields;
|
|
91
|
+
|
|
92
|
+ # merge field ames with those already found
|
|
93
|
+ $self->{data}->{data_columns}->{$_}++ foreach (keys %$data);
|
|
94
|
+
|
|
95
|
+ return $data;
|
|
96
|
+}
|
|
97
|
+
|
|
98
|
+
|
|
99
|
+#################
|
|
100
|
+# parse all lines
|
|
101
|
+sub parse_all {
|
|
102
|
+ my ($self) = @_;
|
|
103
|
+ foreach (@{$self->{lines}}) {
|
|
104
|
+ push @{$self->{data}->{rows}}, $self->parse_line($_);
|
|
105
|
+ }
|
|
106
|
+ return $self->{parsed} = 1;
|
|
107
|
+}
|
|
108
|
+
|
|
109
|
+
|
|
110
|
+###########################################
|
|
111
|
+# render (non-tabular) rows into CSV string
|
|
112
|
+sub to_csv {
|
|
113
|
+ my $self = shift;
|
|
114
|
+ my $output;
|
|
115
|
+
|
|
116
|
+ # parse if it hasn't already been
|
|
117
|
+ $self->{parsed} or $self->parse_all;
|
|
118
|
+
|
|
119
|
+ # create list of columns
|
|
120
|
+ my @columns = (
|
|
121
|
+ @{$self->{data}->{main_columns}},
|
|
122
|
+ sort keys %{$self->{data}->{data_columns}},
|
|
123
|
+ );
|
|
124
|
+
|
|
125
|
+ $output .= $self->array_to_csv(@columns);
|
|
126
|
+
|
|
127
|
+ foreach my $row (@{$self->{data}->{rows}}) {
|
|
128
|
+ my @line;
|
|
129
|
+ foreach (@columns) {
|
|
130
|
+ push @line, (defined $row->{$_} ? $row->{$_} : "" );
|
|
131
|
+ }
|
|
132
|
+ $output .= $self->array_to_csv(@line);
|
|
133
|
+ }
|
|
134
|
+ return $output;
|
|
135
|
+}
|
|
136
|
+
|
|
137
|
+
|
|
138
|
+################
|
|
139
|
+# CSV line maker
|
|
140
|
+sub array_to_csv {
|
|
141
|
+ my $self = shift;
|
|
142
|
+ my @out;
|
|
143
|
+ foreach (@_) {
|
|
144
|
+ push @out, "\"$_\"";
|
|
145
|
+ };
|
|
146
|
+ return join(";" , @out) . "\n";
|
|
147
|
+}
|
|
148
|
+
|
|
149
|
+
|
|
150
|
+######################################
|
|
151
|
+# get list of unique values for column
|
|
152
|
+sub get_unique_values_of {
|
|
153
|
+ my ($self, $column) = @_;
|
|
154
|
+
|
|
155
|
+ # parse if it hasn't already been
|
|
156
|
+ $self->{parsed} or $self->parse_all;
|
|
157
|
+
|
|
158
|
+ # count how many times which value is seen
|
|
159
|
+ my %values;
|
|
160
|
+ $values{$_->{$column}}++
|
|
161
|
+ foreach @{ $self->{data}->{rows} };
|
|
162
|
+
|
|
163
|
+ return [ keys %values ];
|
|
164
|
+}
|
|
165
|
+
|
|
166
|
+
|
|
167
|
+##################################################
|
|
168
|
+# create your clone only with lines matching regex
|
|
169
|
+sub grep {
|
|
170
|
+ my ($self, $query) = @_;
|
|
171
|
+ my $copy;
|
|
172
|
+
|
|
173
|
+ $copy->{data}->{main_columns} = [ @{$self->{data}->{main_columns}} ];
|
|
174
|
+ $copy->{lines} = [ grep {m|$query|} @{$self->{lines}} ];
|
|
175
|
+ carp "grep returned zero lines" unless @{$copy->{lines}};
|
|
176
|
+
|
|
177
|
+ bless $copy, ref $self;
|
|
178
|
+ return $copy;
|
|
179
|
+}
|
|
180
|
+
|
|
181
|
+1;
|