htsheet.pm 4.5KB

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