1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798
  1. #!/usr/bin/perl
  2. ## Author: Alois Mahdal at zxcvb cz
  3. # Analyzer for a very primitive remote logging system Front-end is htlogr.pm,
  4. # back-end is 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. use htsheet;
  16. use strict;
  17. use warnings;
  18. use Getopt::Long;
  19. sub guess_subsets;
  20. $| = 1;
  21. my $LOGFILE = "";
  22. my $STORAGE = "split_csv";
  23. my $PREFIX = "";
  24. my @SUBSETS = qw//;
  25. GetOptions(
  26. "input=s" => \$LOGFILE,
  27. "storage=s" => \$STORAGE,
  28. "prefix=s" => \$PREFIX,
  29. "subset=s" => \@SUBSETS
  30. );
  31. unless ($LOGFILE) {
  32. warn "usage: $0 --input=htlog.log [--prefix=mytest] [--storage=csv_render] [--subset=pattern]*\n";
  33. exit 1;
  34. }
  35. unless (@SUBSETS) {
  36. warn "no --subset(s) specified, will try to guess from tag";
  37. }
  38. print "loading log...";
  39. my $s = htsheet->load({file => $LOGFILE});
  40. print "OK\n";
  41. print "parsing log...";
  42. $s->parse_all;
  43. my @tags = @{$s->get_unique_values_of("Tag")};
  44. print "OK\n";
  45. mkdir $STORAGE;
  46. print "processing tags:\n";
  47. # take each tag and process data from it based on subsets
  48. # so that within tag we have control over which lines contain parseable data
  49. TAG: foreach my $tag (@tags) {
  50. print " $tag...";
  51. my $t = $s->grep($tag);
  52. my @subsets_to_go = guess_subsets($tag)
  53. or warn "no subsets available for tag $tag\n";
  54. SUBSET: foreach my $subset (@subsets_to_go) {
  55. # grep down from tag to subset
  56. my $s = $t->grep($subset);
  57. $s->parse_all;
  58. # save to separate CSV
  59. my $fname = sprintf(
  60. "%s/%s%s--%s.csv",
  61. $STORAGE,
  62. ($PREFIX ? "$PREFIX--" : ""),
  63. $tag,
  64. $subset
  65. );
  66. open my $fh, ">", $fname or die "could not clobber $fname: $!\n";
  67. print $fh $s->to_csv;
  68. close $fh or die "could not close file $_: $!";
  69. }
  70. print "OK\n";
  71. }
  72. sub guess_subsets {
  73. my $_ = shift;
  74. return @SUBSETS if @SUBSETS;
  75. return qw/ rendered pmfree / if m|sunspider|;
  76. return qw/ avg_rr_queue / if m|showlist_pl|;
  77. }