Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100755 123 lines (91 sloc) 3.096 kb
6b34bf4 @nniclausse merge from 1.3.1 branch
nniclausse authored
1 #!/usr/bin/perl
2 #
3 # Copyright (C) 2009 Bearstech http://www.bearstech.com/
4 # Copyright (C) 2009 Rodolphe Quiédeville
5 #
6 # This program is free software: you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation, either version 2 of the License, or
9 # (at your option) any later version.
10 #
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License
17 # along with this program. If not, see <http://www.gnu.org/licenses/>.
18
19 # Auteur: Rodolphe Quiédeville (rodolphe@quiedeville.org)
20 # Version: $Id$
21
22 # purpose: create rrd files with tsung log datas
23
24 use strict;
25 use RRDs;
26 use Getopt::Long;
27
28 use vars qw ($help *verbose $version $log_file $output);
29
30 $log_file = "tsung.log";
31 $output = ".";
32
33 GetOptions( "help",\$help,
34 "verbose",\$verbose,
35 "log=s",\$log_file,
36 "output=s",\$output,
37 "version",\$version
38 );
39
40 # check options
41 printf "dir %s doesn't exists\n",$output if (!-d $output);
42 printf "file %s doesn't exists\n",$log_file if (!-f $log_file);
43
44 # do the job
45 open (FILE, $log_file ) or die "Cannot open : $!";
46 while (<FILE>) {
47
48 my $date = $1 if (/stats: dump at (\d+)/);
49
50 users($date, $1, "users") if (/^stats: users (\d+) (\d+)$/);
51 users($date, $1, "connected") if (/^stats: connected (\d+) (\d+)$/);
52
53 codes($date, $1, $2) if (/^stats: (\d+) (\d+) (\d+)$/);
54
55 generic($date, $1, $2) if (/^stats: (page) (\d+)/);
56 generic($date, $1, $2) if (/^stats: (session) (\d+)/);
57
58 generic($date, $1, $2) if (/^stats: (request) (\d+)/);
59 generic($date, $1, $2) if (/^stats: (connect) (\d+)/);
60
61 generic($date, $1, $2) if (/^stats: (size_\w+) (\d+)/);
62
63 generic($date, $1, $2) if (/^stats: (users_count) (\d+)/);
64 generic($date, $1, $2) if (/^stats: (finish_users_count) (\d+)/);
65 }
66 close FILE;
67
68 # users data
69 sub users {
70 my ($date,$value, $stat) = @_;
71
72 RRDs::update ("users.rrd", "--template", $stat, "$date:$value");
73 }
74
75 #
76 # HTTP return code
77 #
78 sub codes {
79 my ($date, $code, $value) = @_;
80
81 my $file = "$output/code-$code.rrd";
82
83 create_rrd ($file) if (! -f $file);
84
85 RRDs::update ($file, "--template", "value", "$date:$value");
86 }
87
88 #
89 # Some generic datas
90 #
91 sub generic {
92 my ($date, $data, $value) = @_;
93
94 my $file = "$output/$data.rrd";
95
96 create_rrd ($file) if (! -f $file);
97
98 RRDs::update ($file, "--template", "value", "$date:$value");
99 }
100
101 #
102 # Create RRD file
103 #
104 sub create_rrd {
105
106 my ($file) = @_;
107
108 printf "Create %s\n",$file if $verbose;
109
110 my @parms = ("$file",
111 "--start",1240488000,
112 "--step", 10,
113 "DS:value:GAUGE:20:0:671744",
114 "RRA:AVERAGE:0.5:1:2400",
115 "RRA:AVERAGE:0.5:2:1200");
116
117 RRDs::create (@parms);
118
119 if (my $ERROR = RRDs::error) {
120 die "RRDs ERROR: $ERROR\n";
121 };
122 }
Something went wrong with that request. Please try again.