#!/usr/bin/perl -T
# -*- cperl -*-
=begin comment
Copyright (C) 2004-2010 Jimmy Olsen, Steve Schnepp
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; version 2 dated June,
1991.
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/>.
=end comment
=cut
use strict;
use warnings;
use POSIX qw(strftime);
use CGI::Fast qw(:cgi);
use CGI::Carp qw(fatalsToBrowser);
use Time::HiRes qw(time);
use Munin::Master::HTMLConfig;
use Munin::Master::HTMLOld;
use Munin::Master::Utils;
use Munin::Master::Logger;
use Log::Log4perl qw( :easy );
use Data::Dumper;
my @times = ("day", "week", "month", "year");
my $config;
my $lastchanged = 0;
my @params;
push @params, "--config", $ENV{'MUNIN_CONFIG'}
if (defined $ENV{'MUNIN_CONFIG'});
# grab config
html_startup(\@params);
while(new CGI::Fast){
print header("text/html");
$config = get_config(1);
show_page();
}
sub show_page {
my @path = split(/\//, $ENV{PATH_INFO});
emit_page(\@path);
}
sub get_next_part {
my $path = shift;
my $part;
do {
$part = shift(@$path);
} while(defined $part && $part eq "");
return $part;
}
sub emit_page {
my $path = shift;
my $group = $config;
#process groups
$group = traverse_groups($path, $group);
update_timestamp();
if(!defined $group->{"depth"} || $group->{"depth"} == 0){ #root url
my $problems = get_next_part($path);
if(defined $problems && $problems eq "problems.html"){
emit_problem_template(1);
} else {
unshift(@$path, $problems);
(my $category, my $time) = get_global_category($path, $group);
if(defined $category){
emit_category_template($category, $time, 1);
} else {
emit_main_index($group->{"groups"},0,1);
}
}
} elsif(!$group->{"ncategories"}) { # group
my $cmp_time = get_comparison_group($path, $group);
if(defined $cmp_time){ # comparison template
emit_comparison_template($group, $cmp_time, 1);
} else { #group page
emit_group_template($group, 1);
}
} else { #node
my $service = get_node_service($path, $group);
if(defined $service){
emit_service_template($service, 1);
} else {
emit_graph_template($group, 1);
}
}
}
sub traverse_groups {
my ($path, $group) = @_;
my $part = get_next_part($path);
while(defined $part && (defined $group->{"groups_hash"}->{$part})) {
$group = $group->{"groups_hash"}->{$part};
$part = get_next_part($path);
}
if(defined $part){
unshift(@$path,$part); # put the unprocessed part back on
}
return $group;
}
sub get_comparison_group {
my ($path, $group) = @_;
if(!$group->{"compare"}){ return undef; } # group is not a comparison group
my $part = get_next_part($path);
if(defined $part && $part =~ m/^comparison-([a-z]+)\.html/i){
if(grep /^$1$/, @times){ return lc $1; }
}
if(defined $part){
unshift(@$path, $part); #put the unprocessed part back on
}
return undef;
}
sub get_global_category {
my ($path, $group) = @_;
my $part = get_next_part($path);
if(!defined $part){
return undef;
}
foreach my $category (@{$group->{"globalcats"}}) {
foreach my $time (@times) {
if($category->{"url" . $time} eq $part){
return ($category, $time);
}
}
}
return undef;
}
sub get_node_service {
my ($path, $group) = @_;
my $part = get_next_part($path);
if(!defined $part){
return undef;
}
foreach my $category (@{$group->{"categories"}}) {
foreach my $service (@{$category->{"services"}}) {
if($part eq $service->{"node"}.".html"){
return $service;
}
}
}
return undef;
}
# CGI in perl 5.20 is now seriously broken as it doesn't import into the namespace.
# So we have to delegate explicitly. It's easier than prefixing with CGI:: each use.
# This workaround is applied only if "header" is undefined (i.e. for perl >= 5.20).
if(!defined &header){
*header = sub { return CGI::header(@_); };
*path_info = sub { return CGI::path_info(@_); };
*url = sub { return CGI::url(@_); };
*script_name = sub { return CGI::script_name(@_); };
}
Mini Shell