1#!@@PERL@@ -T
2# -*- cperl -*-
3
4=begin comment
5
6Copyright (C) 2004-2010 Jimmy Olsen, Steve Schnepp
7
8This program is free software; you can redistribute it and/or
9modify it under the terms of the GNU General Public License
10as published by the Free Software Foundation; version 2 dated June,
111991.
12
13This program is distributed in the hope that it will be useful, but
14WITHOUT ANY WARRANTY; without even the implied warranty of
15MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
16General Public License for more details.
17
18You should have received a copy of the GNU General Public License
19along with this program.  If not, see <http://www.gnu.org/licenses/>.
20
21=end comment
22
23=cut
24
25use strict;
26use warnings;
27
28use POSIX qw(strftime);
29
30use CGI::Fast qw(:cgi);
31use CGI::Carp qw(fatalsToBrowser);
32use Time::HiRes qw(time);
33
34use Munin::Master::HTMLConfig;
35use Munin::Master::HTMLOld;
36use Munin::Master::Utils;
37
38use Munin::Master::Logger;
39use Log::Log4perl qw( :easy );
40
41use Data::Dumper;
42
43my @times = ("day", "week", "month", "year");
44my $config;
45my $lastchanged = 0;
46
47my @params;
48push @params, "--config", $ENV{'MUNIN_CONFIG'}
49        if (defined $ENV{'MUNIN_CONFIG'});
50
51# grab config
52html_startup(\@params);
53while(new CGI::Fast){
54	print header("text/html");
55	$config = get_config(1);
56	show_page();
57}
58
59sub show_page {
60  my @path = split(/\//, $ENV{PATH_INFO});
61  emit_page(\@path);
62}
63
64sub get_next_part {
65  my $path = shift;
66  my $part;
67  do {
68   	$part = shift(@$path);
69  } while(defined $part && $part eq "");
70  return $part;
71}
72
73sub emit_page {
74  my $path = shift;
75  my $group = $config;
76
77  #process groups
78  $group = traverse_groups($path, $group);
79
80  update_timestamp();
81  if(!defined $group->{"depth"} || $group->{"depth"} == 0){ #root url
82	my $problems = get_next_part($path);
83	if(defined $problems && $problems eq "problems.html"){
84		emit_problem_template(1);
85	} else {
86		unshift(@$path, $problems);
87		(my $category, my $time) = get_global_category($path, $group);
88		if(defined $category){
89			emit_category_template($category, $time, 1);
90		} else {
91			emit_main_index($group->{"groups"},0,1);
92		}
93	}
94  } elsif(!$group->{"ncategories"}) { # group
95	my $cmp_time = get_comparison_group($path, $group);
96	if(defined $cmp_time){ # comparison template
97		emit_comparison_template($group, $cmp_time, 1);
98	} else { #group page
99		emit_group_template($group, 1);
100	}
101  } else { #node
102	my $service = get_node_service($path, $group);
103	if(defined $service){
104		emit_service_template($service, 1);
105	} else {
106		emit_graph_template($group, 1);
107	}
108  }
109}
110
111sub traverse_groups {
112  my ($path, $group) = @_;
113  my $part = get_next_part($path);
114  while(defined $part && (defined $group->{"groups_hash"}->{$part})) {
115	$group = $group->{"groups_hash"}->{$part};
116	$part = get_next_part($path);
117  }
118  if(defined $part){
119	  unshift(@$path,$part); # put the unprocessed part back on
120  }
121  return $group;
122}
123
124sub get_comparison_group {
125  my ($path, $group) = @_;
126  if(!$group->{"compare"}){	return undef; } # group is not a comparison group
127  my $part = get_next_part($path);
128  if(defined $part && $part =~ m/^comparison-([a-z]+)\.html/i){
129    if(grep /^$1$/, @times){ return lc $1; }
130  }
131  if(defined $part){
132	unshift(@$path, $part); #put the unprocessed part back on
133  }
134  return undef;
135}
136
137sub get_global_category {
138	my ($path, $group) = @_;
139	my $part = get_next_part($path);
140	if(!defined $part){
141		return undef;
142	}
143	foreach my $category (@{$group->{"globalcats"}}) {
144		foreach my $time (@times) {
145			if($category->{"url" . $time} eq $part){
146				return ($category, $time);
147			}
148		}
149	}
150	return undef;
151}
152
153sub get_node_service {
154	my ($path, $group) = @_;
155	my $part = get_next_part($path);
156	if(!defined $part){
157		return undef;
158	}
159	foreach my $category (@{$group->{"categories"}}) {
160		foreach my $service (@{$category->{"services"}}) {
161			if($part eq $service->{"node"}.".html"){
162				return $service;
163			}
164		}
165	}
166	return undef;
167}
168
169# CGI in perl 5.20 is now seriously broken as it doesn't import into the namespace.
170# So we have to delegate explicitly. It's easier than prefixing with CGI:: each use.
171# This workaround is applied only if "header" is undefined (i.e. for perl >= 5.20).
172if(!defined &header){
173	*header = sub { return CGI::header(@_); };
174	*path_info = sub { return CGI::path_info(@_); };
175	*url = sub { return CGI::url(@_); };
176	*script_name = sub { return CGI::script_name(@_); };
177}
178