#!/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(@_); };
}