htsheet.pm 4.6KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185
  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. #TODO: Make them global
  67. my $DIV_FIELD =";";
  68. my $DIV_VALUE ="=";
  69. # split to fields
  70. my @fields = split $DIV_FIELD, $message;
  71. %$data = map {
  72. my @fld = split $DIV_VALUE, $_;
  73. ( 2 == scalar @fld ? @fld : (dummy => 'non-parseable') )
  74. } @fields;
  75. # merge field ames with those already found
  76. $self->{data}->{data_columns}->{$_}++ foreach (keys %$data);
  77. return $data;
  78. }
  79. #################
  80. # parse all lines
  81. sub parse_all {
  82. my ($self) = @_;
  83. foreach (@{$self->{lines}}) {
  84. push @{$self->{data}->{rows}}, $self->parse_line($_);
  85. }
  86. return $self->{parsed} = 1;
  87. }
  88. ###########################################
  89. # render (non-tabular) rows into CSV string
  90. sub to_csv {
  91. my $self = shift;
  92. my $output;
  93. # parse if it hasn't already been
  94. $self->{parsed} or $self->parse_all;
  95. # create list of columns
  96. my @columns = (
  97. @{$self->{data}->{main_columns}},
  98. sort keys %{$self->{data}->{data_columns}},
  99. );
  100. $output .= $self->array_to_csv(@columns);
  101. foreach my $row (@{$self->{data}->{rows}}) {
  102. my @line;
  103. foreach (@columns) {
  104. push @line, (defined $row->{$_} ? $row->{$_} : "" );
  105. }
  106. $output .= $self->array_to_csv(@line);
  107. }
  108. return $output;
  109. }
  110. ################
  111. # CSV line maker
  112. sub array_to_csv {
  113. my $self = shift;
  114. my @out;
  115. foreach (@_) {
  116. push @out, "\"$_\"";
  117. };
  118. return join(";" , @out) . "\n";
  119. }
  120. ######################################
  121. # get list of unique values for column
  122. sub get_unique_values_of {
  123. my ($self, $column) = @_;
  124. # parse if it hasn't already been
  125. $self->{parsed} or $self->parse_all;
  126. # count how many times which value is seen
  127. my %values;
  128. $values{$_->{$column}}++
  129. foreach @{ $self->{data}->{rows} };
  130. return [ keys %values ];
  131. }
  132. ##################################################
  133. # create your clone only with lines matching regex
  134. sub grep {
  135. my ($self, $query) = @_;
  136. my $copy;
  137. $copy->{data}->{main_columns} = [ @{$self->{data}->{main_columns}} ];
  138. $copy->{lines} = [ grep {m|$query|} @{$self->{lines}} ];
  139. carp "grep returned zero lines" unless @{$copy->{lines}};
  140. bless $copy, ref $self;
  141. return $copy;
  142. }
  143. 1;