/[rrd-simple-monitoring]/cgi-bin/devel/rrd-export.cgi
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /cgi-bin/devel/rrd-export.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations)
Thu Jul 16 18:48:19 2009 UTC (11 years, 6 months ago) by dpavlin
File size: 7659 byte(s)
import upstream http://rrd.me.uk/rrd-simple-monitoring.tar.gz

without prerequisities

1 #!/usr/bin/perl -w
2 ############################################################
3 #
4 # $Id: rrd-browse.cgi 692 2006-06-26 19:11:14Z nicolaw $
5 # rrd-browse.cgi - Graph browser CGI script for RRD::Simple
6 #
7 # Copyright 2006,2007 Nicola Worthington
8 #
9 # Licensed under the Apache License, Version 2.0 (the "License");
10 # you may not use this file except in compliance with the License.
11 # You may obtain a copy of the License at
12 #
13 # http://www.apache.org/licenses/LICENSE-2.0
14 #
15 # Unless required by applicable law or agreed to in writing, software
16 # distributed under the License is distributed on an "AS IS" BASIS,
17 # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
18 # See the License for the specific language governing permissions and
19 # limitations under the License.
20 #
21 ############################################################
22 # vim:ts=4:sw=4:tw=78
23
24 # User defined constants
25 use constant BASEDIR => '/home/nicolaw/webroot/www/rrd.me.uk';
26 use constant RRDURL => '';
27 use constant CACHE => 1;
28
29 ############################################################
30
31
32
33
34 use 5.8.0;
35 use warnings;
36 use strict;
37 use CGI;
38 use CGI::Carp qw(fatalsToBrowser);
39 use HTML::Template::Expr;
40 use File::Basename qw(basename);
41 use File::Spec::Functions qw(tmpdir catdir catfile);
42 use vars qw(%LIST_CACHE %GRAPH_CACHE);
43
44 use lib (BASEDIR.'/cgi-bin');
45 use RRDBrowseCommon qw(slurp by_domain alpha_period list_dir graph_def read_graph_data);
46
47 # Enable some basic caching
48 if (CACHE) {
49 # Cache calls to list_dir() and graph_def()
50 require Memoize;
51 Memoize::memoize('list_dir', LIST_CACHE => [HASH => \%LIST_CACHE]);
52 Memoize::memoize('graph_def', SCALAR_CACHE => [HASH => \%GRAPH_CACHE]);
53 }
54
55
56 # Grab CGI paramaters
57 my $cgi = new CGI;
58 my %q = $cgi->Vars;
59
60 # cd to the righr location and define directories
61 my %dir = map { ( $_ => BASEDIR."/$_" ) } qw(data etc graphs cgi-bin thumbnails);
62 chdir $dir{'cgi-bin'} || die sprintf("Unable to chdir to '%s': %s", $dir{'cgi-bin'}, $!);
63
64 # Create the initial %tmpl data hash
65 my %tmpl = %ENV;
66 $tmpl{template} = defined $q{template} && -f $q{template} ? $q{template} : 'export.tmpl';
67 $tmpl{title} = ucfirst(basename($tmpl{template},'.tmpl')); $tmpl{title} =~ s/[_\-]/ /g;
68 $tmpl{self_url} = $cgi->self_url(-absolute => 1, -query_string => 0, -path_info => 0);
69 $tmpl{rrd_url} = RRDURL;
70
71 # Generate and send an XLS document
72 if ($q{HOST} && $q{RRD}) {
73 my $xls = '';
74 eval { $xls = generate_xls(catfile($dir{data},$q{HOST},$q{RRD})); };
75
76 if ($@ || !defined($xls) || !length($xls)) {
77 $tmpl{error} = $@;
78 $tmpl{template} = 'error.tmpl';
79
80 } else {
81 print $cgi->header(
82 -type => 'application/vnd.ms-excel',
83 -content_disposition => sprintf('attachment; filename=%s', 'filename.xls'),
84 -content_length => length($xls),
85 -cache_control => 'no-cache',
86 -expires => '0',
87 );
88 print $xls;
89 exit;
90 }
91 }
92
93 # Go read a bunch of stuff from disk to pump in to %tmpl in a moment
94 my $gdefs = read_graph_data("$dir{etc}/graph.defs");
95 my @graphs = list_dir($dir{graphs});
96 my $tmpl_cache = { hosts => [], };
97 my $html = { last_update => 0, html => '' };
98
99 # Build the data
100 for my $host (sort by_domain list_dir($dir{data})) {
101 next unless -d catfile($dir{data},$host);
102
103 # NEECHI-HACK!
104 next if defined($q{HOST}) && $q{HOST} ne $host;
105 next if defined($q{LIKE}) && $tmpl{template} =~ /^by_host\.[^\.]+$/i && $host !~ /$q{LIKE}/i;
106
107 (my $node = $host) =~ s/\..*//;
108 (my $domain = $host) =~ s/^.*?\.//;
109 (my $domain2 = $domain) =~ s/[^a-zA-Z0-9\_]/_/g;
110 (my $host2 = $host) =~ s/[^a-zA-Z0-9\_]/_/g;
111
112 my %host = ( node => $node,
113 host => $host, host2 => $host2,
114 domain => $domain, domain2 => $domain2, );
115
116 # Build a hash of potential files that users can slurp() or include
117 # in their output template on a per host basis.
118 for my $file (grep(/\.(?:te?xt|s?html?|xslt?|xml|css|tmpl)$/i,
119 glob("$dir{data}/$host/include*.*"))) {
120 (my $base = basename($file)) =~ s/\./_/g;
121 $host{$base} = $file;
122 }
123
124 push @{$tmpl_cache->{hosts}}, \%host;
125 }
126
127 # Merge cache data in
128 $tmpl{hosts} = $tmpl_cache->{hosts};
129
130 # Render the output
131 if (exists $q{DEBUG} && $q{DEBUG} eq 'insecure') {
132 require Data::Dumper;
133 $tmpl{DEBUG} = Data::Dumper::Dumper(\%tmpl);
134 }
135 my $template = HTML::Template::Expr->new(
136 filename => $tmpl{template},
137 associate => $cgi,
138 case_sensitive => 1,
139 loop_context_vars => 1,
140 max_includes => 5,
141 global_vars => 1,
142 die_on_bad_params => 0,
143 functions => {
144 slurp => \&slurp,
145 like => sub { return defined($_[0]) && defined($_[1]) && $_[0] =~ /$_[1]/i ? 1 : 0; },
146 not => sub { !$_[0]; },
147 equal_or_like => sub {
148 return 1 if (!defined($_[1]) || !length($_[1])) && (!defined($_[2]) || !length($_[2]));
149 #(warn "$_[0] eq $_[1]\n" && return 1) if defined $_[1] && "$_[0]" eq "$_[1]";
150 (return 1) if defined $_[1] && "$_[0]" eq "$_[1]";
151 return 1 if defined $_[2] && "$_[0]" =~ /$_[2]/;
152 return 0;
153 },
154 },
155 );
156 $template->param(\%tmpl);
157
158 $html->{html} = $template->output();
159 $html->{last_update} = time;
160 print $cgi->header(-content => 'text/html'), $html->{html};
161
162 exit;
163
164 1;
165
166
167 sub generate_xls {
168 my $rrdfile = shift;
169 return unless defined($rrdfile) && -f $rrdfile;
170
171 require RRDs;
172 require RRD::Simple;
173 require Spreadsheet::WriteExcel;
174
175 # Create an RRD object
176 my $rrd = RRD::Simple->new(file => $rrdfile)
177 || die "Unable to instanciate RRD::Simple object for file '$rrdfile'";
178 my @sources = $rrd->sources;
179 my $info = $rrd->info;
180
181 # Create a workbook
182 open my $fh, '>', \my $xls or die "Failed to open filehandle: $!";
183 my $workbook = Spreadsheet::WriteExcel->new($fh);
184
185 my %labels = (
186 '300-1' => 'Daily',
187 '300-6' => 'Weekly',
188 '300-24' => 'Monthly',
189 '300-288' => 'Annual',
190 );
191
192 # Create the overview worksheet
193 my @sheet;
194 OVERVIEW: {
195 my $sheet = $workbook->add_worksheet('Summary');
196 $sheet->set_zoom(80);
197 $sheet->freeze_panes(1, 1);
198 my ($row, $col) = (0, 0);
199
200 my @fields = sort(keys(%{$info->{rra}->[0]}));
201 $sheet->write_row($row, $col, [( '', @fields )] );
202
203 for my $rra (@{$info->{rra}}) { $row++;
204 my $label = sprintf('%s %s',
205 (exists $labels{"$info->{step}-$rra->{pdp_per_row}"} ?
206 $labels{"$info->{step}-$rra->{pdp_per_row}"} : rand(999) ),
207 ucfirst(lc($rra->{cf})));
208 $sheet->write_row($row, $col, [( $label, map { $rra->{$_} } @fields )] );
209 }
210
211 push @sheet, $sheet;
212 }
213
214 # Create the detail worksheets
215 for my $rra (@{$info->{rra}}) {
216 my $label = sprintf('%s %s',
217 (exists $labels{"$info->{step}-$rra->{pdp_per_row}"} ?
218 $labels{"$info->{step}-$rra->{pdp_per_row}"} : rand(999) ),
219 ucfirst(lc($rra->{cf})));
220
221 my $sheet = $workbook->add_worksheet($label);
222 $sheet->set_zoom(80);
223 $sheet->freeze_panes(1, 1);
224 my ($row, $col) = (0, 0);
225
226 my ($start,$step,$names,$data) = RRDs::fetch($rrdfile, $rra->{cf}, '-s', 60*60*24*365*10);
227 $sheet->write_row($row, $col, [( '', @{$names} )] );
228 for my $line (@{$data}) { $row++;
229 $sheet->write_row($row, $col, [( '', @{$line} )] );
230 }
231
232 # my ($start,$step,$names,$data) = RRDs::fetch ...
233 # print "Start: ", scalar localtime($start), " ($start)\n";
234 # print "Step size: $step seconds\n";
235 # print "DS names: ", join (", ", @$names)."\n";
236 # print "Data points: ", $#$data + 1, "\n";
237 # print "Data:\n";
238 # foreach my $line (@$data) {
239 # print " ", scalar localtime($start), " ($start) ";
240 # $start += $step;
241 # foreach my $val (@$line) {
242 # printf "%12.1f ", $val;
243 # }
244 # print "\n";
245 # }
246
247 push @sheet, $sheet;
248 }
249
250 $workbook->close;
251 return $xls;
252 }
253

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26