1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798 |
- #! perl -w
-
- ## Author: Alois Mahdal at zxcvb cz
- # Analyzer for a very primitive remote logging system Front-end is htlogr.pm,
- # back-end is htlog.cgi
-
- # This program is free software: you can redistribute it and/or modify
- # it under the terms of the GNU General Public License as published by
- # the Free Software Foundation, either version 3 of the License, or
- # (at your option) any later version.
-
- # This program is distributed in the hope that it will be useful,
- # but WITHOUT ANY WARRANTY; without even the implied warranty of
- # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- # GNU General Public License for more details.
-
- # You should have received a copy of the GNU General Public License
- # along with this program. If not, see <http://www.gnu.org/licenses/>.
-
- use htsheet;
- use strict;
- use warnings;
-
- use Getopt::Long;
-
- sub guess_subsets;
-
- $| = 1;
- my $LOGFILE = "";
- my $STORAGE = "split_csv";
- my $PREFIX = "";
- my @SUBSETS = qw//;
-
- GetOptions(
- "input=s" => \$LOGFILE,
- "storage=s" => \$STORAGE,
- "prefix=s" => \$PREFIX,
- "subset=s" => \@SUBSETS
- );
-
- unless ($LOGFILE) {
- warn "usage: $0 --input=htlog.log [--prefix=mytest] [--storage=csv_render] [--subset=pattern]*\n";
- exit 1;
- }
- unless (@SUBSETS) {
- warn "no --subset(s) specified, will try to guess from tag";
- }
-
- print "loading log...";
- my $s = htsheet->load({file => $LOGFILE});
- print "OK\n";
-
- print "parsing log...";
- $s->parse_all;
- my @tags = @{$s->get_unique_values_of("Tag")};
- print "OK\n";
-
-
- mkdir $STORAGE;
- print "processing tags:\n";
- # take each tag and process data from it based on subsets
- # so that within tag we have control over which lines contain parseable data
- TAG: foreach my $tag (@tags) {
- print " $tag...";
-
- my $t = $s->grep($tag);
-
- my @subsets_to_go = guess_subsets($tag)
- or warn "no subsets available for tag $tag\n";
-
- SUBSET: foreach my $subset (@subsets_to_go) {
- # grep down from tag to subset
- my $s = $t->grep($subset);
- $s->parse_all;
-
- # save to separate CSV
- my $fname = sprintf(
- "%s/%s%s--%s.csv",
- $STORAGE,
- ($PREFIX ? "$PREFIX--" : ""),
- $tag,
- $subset
- );
- open my $fh, ">", $fname or die "could not clobber $fname: $!\n";
- print $fh $s->to_csv;
- close $fh or die "could not close file $_: $!";
- }
- print "OK\n";
- }
-
-
- sub guess_subsets {
- my $_ = shift;
- return @SUBSETS if @SUBSETS;
- return qw/ rendered pmfree / if m|sunspider|;
- return qw/ avg_rr_queue / if m|showlist_pl|;
- }
|