<%doc>
############################################################################
###    (C)opyright 2003 - 2008 RIPE NCC
###    This file is part of DNSMon
###
###    DNSMon 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, either version 3 of the License, or
###    (at your option) any later version.
###
###    DNSMon 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 DNSMon.  If not, see <http://www.gnu.org/licenses/>.
############################################################################


Common Components for RRD Plotting.
These are the ones useful for other Mason Components,
e.g. somehow related to web-site output.

All other things are, or should be, in RIPE::DNSMon::RRD.pm. 

dfk - June 2003

</%doc>
<%once>
# more convenient access to second constants
#
$ENV{'TZ'} = 'UTC';	# We deal with global time only
use Time::Piece;
use Time::Seconds;
use POSIX;
use Socket;
use Socket6;


my $HOUR = Time::Piece->ONE_HOUR;
my $DAY = Time::Piece->ONE_DAY;
my $WEEK = Time::Piece->ONE_WEEK;

my $LASTVAL_SERVER = 'k.root-servers.net';

# XXX get from $RIPE::DNSMon::RRD::LASTTROUNDDOWN
my $LASTTROUNDDOWN = $RIPE::DNSMon::RRD::LASTTROUNDDOWN;

my @types = (	# types of plots
	'delays',
	'drops',
	'delays-500',
	'delays-50',
	'delays-10',
  );

my @stypes = (	# types of server plots
	'delays',
	'drops',
	'delays-500',
	'delays-50',
	'delays-10',
  );

my @periods = ( # time periods available for plots (shortest to longest!)
	'2h',
	'3h',
	'4h',
	'6h',
	'12h',
	'24h',
	'48h',
	'2 days',
	'4 days',
	'7 days',
	'2 weeks',
	'1 month',
	'2 months',
	'3 months',
	'4 months',
	'6 months',
  );

my %period_secs = ();

foreach $_ (@periods) {
	if (/^([0-9]+)h$/) {
		$period_secs{$_} = (($1 * $HOUR)-1);
	}
	elsif (/^([0-9]+) day/) {
		$period_secs{$_} = (($1 * $DAY)-1);
	}
	elsif (/^([0-9]+) week/) {
		$period_secs{$_} = (($1 * $WEEK)-1);
	}
	elsif (/^([0-9]+) month/) {
		$period_secs{$_} = (($1 * 30 * $DAY)-1);
	}
}
</%once>

<%method plot_s_delay>
	<%doc>
	Wrapper for making delay plots for servers
	</%doc>
	<%attr>
	ajax => 1		# ajax
	</%attr>
	<%args>
	$start			# start time
	$stop			# stop time
	$fuzzy			# try to use previous if no cached image
	$srv			# server name
	$scale => ''		# width info for html tag (legacy)
	$xscale => ''		# width info for html tag
	$yscale => ''		# height info for html tag
	$type => 'drops'
	$opt_h => 500
	$maxms => 250
	$af => 'ipv4'
	%plotargs => ()		# plot modifiers
	</%args>
	<%perl>

	$start = ref($start) eq 'Time::Piece' ? $start : new Time::Piece($start);
	$stop = ref($stop) eq 'Time::Piece' ? $stop : new Time::Piece($stop);

	my $afn = $af eq "ipv6" ? &AF_INET6 : &AF_INET;

	if ($TICKET && exists($ARGS{refresh})) {
		$plotargs{'refresh'} = 'yes';
	}

	$srv = RIPE::DNSMon::RRD::ser_alias($srv) ? RIPE::DNSMon::RRD::ser_alias($srv) : $srv;

	my $msg = RIPE::DNSMon::RRD::plot_server(
		start => $start,
		stop => $stop,
		srv => $srv,
		fuzzy => $fuzzy,
		opt_h => $opt_h,
		maxms => $maxms,
		af => $afn,
		%plotargs
	  );

	if ($msg =~ /^M /) {	# user digestable error
		$msg =~ s/^M //;
		$m->print($msg);
		return;
	}
	elsif ($msg =~ /^(F|P|C) /) {	# plot succeeded
		$m->print('(more recent data available)<br />') if $msg =~ /^P /;
		$msg =~ s/^. //;
		my $url= sprintf "../server/plot?server=$srv;type=delays;tstart=%d;tstop=%d;af=$af", $start->epoch, $stop->epoch;

		$m->print("<a href=\"$url\"> ");
		if ($scale) {
			$m->print("<img alt=\"Delay plot for server $srv\" src=\"$msg\" width=\"$scale\" />");
		}
		elsif ($xscale & $yscale) {
			$m->print("<img alt=\"Delay plot for server $srv\" src=\"$msg\" width=\"$xscale\" height=\"$yscale\" />");
		}
		else {
			$m->print("<img alt=\"Delay plot for server $srv\" src=\"$msg\" />");
		}
		$m->print("</a>");
		$m->flush_buffer;
	}
	else {
		$m->print("<h2>Plot returned a fatal error, please notify site administrator.<h2><br /><pre>$msg</pre>");
		return;
	}
	</%perl>
</%method>

<%method plot_s_instance>
	<%doc>
	Wrapper for making instance plots for servers
	</%doc>
	<%attr>
	ajax => 1		# ajax
	</%attr>
	<%args>
	$start			# start time
	$stop			# stop time
	$fuzzy			# try to use previous if no cached image
	$srv			# server name
	$scale => ''		# width info for html tag
	$af => 'ipv4'
	%plotargs => ()		# plot modifiers
	</%args>

This is a QUICK HACK. It uses a lot of resources.
Please use prudently.
<br />
<pre>
The list below is sorted by probe and time.
It lists the first observed ID in the period.
After that it lists the first appearance of
any different ID.

<%perl>
	$m->flush_buffer;

	$start = ref($start) eq 'Time::Piece' ? $start : new Time::Piece($start);
	$stop = ref($stop) eq 'Time::Piece' ? $stop : new Time::Piece($stop);

	my $afn = $af eq "ipv6" ? &AF_INET6 : &AF_INET;

	my @mons = sort (RIPE::DNSMon::RRD::raw_mons($afn));

	$srv = RIPE::DNSMon::RRD::ser_alias($srv) ? RIPE::DNSMon::RRD::ser_alias($srv) : $srv;

	foreach my $mon (@mons) {
		$m->print(RIPE::DNSMon::RRD::inst_rep(
				srv => $srv,
				start => $start,
				stop => $stop,
				probe => $mon,
				af => $afn,
			  ));
		$m->flush_buffer;
	}
</%perl>
</pre>
</%method>

<%method plot_p_delay>
	<%doc>
	Wrapper for making delay plots for probes
	</%doc>
	<%attr>
	ajax => 1		# ajax
	</%attr>
	<%args>
	$start			# start time
	$stop			# stop time
	$fuzzy			# try to use previous if no cached image
	$probe			# probe name
	$scale => ''		# width info for html tag (legacy)
	$xscale => ''		# width info for html tag
	$yscale => ''		# height info for html tag
	$type => 'drops'
	$opt_h => 500
	$maxms => 250
	$af => 'ipv4'
	%plotargs => ()		# plot modifiers
	</%args>
	<%perl>

	$start = ref($start) eq 'Time::Piece' ? $start : new Time::Piece($start);
	$stop = ref($stop) eq 'Time::Piece' ? $stop : new Time::Piece($stop);

	my $afn = $af eq "ipv6" ? &AF_INET6 : &AF_INET;

	if ($TICKET && exists($ARGS{refresh})) {
		$plotargs{'refresh'} = 'yes';
	}

	my $msg = RIPE::DNSMon::RRD::plot_mon(
		start => $start,
		stop => $stop,
		mon => $probe,
		fuzzy => $fuzzy,
		opt_h => $opt_h,
		maxms => $maxms,
		af => $afn,
		%plotargs
	  );

	if ($msg =~ /^M /) {	# user digestable error
		$msg =~ s/^M //;
		$m->print($msg);
		return;
	}
	elsif ($msg =~ /^(F|P|C) /) {	# plot succeeded
		$m->print('(more recent data available)<br />') if $msg =~ /^P /;
		$msg =~ s/^. //;
		my $url= sprintf "../probe/plot?probe=$probe;tstart=%d;tstop=%d;af=$af", $start->epoch, $stop->epoch;

		$m->print("<a href=\"$url\"> ");
		if ($scale) {
			$m->print("<img alt=\"Plot for probe $probe\" src=\"$msg\" width=\"$scale\" />");
		}
		elsif ($xscale & $yscale) {
			$m->print("<img alt=\"Plot for probe $probe\" src=\"$msg\" width=\"$xscale\" height=\"$yscale\" />");
		}
		else {
			$m->print("<img alt=\"Plot for probe $probe\" src=\"$msg\" />");
		}
		$m->print("</a>");
		$m->flush_buffer;
	}
	else {
		$m->print("<h2>Plot returned a fatal error, please notify site administrator.<h2><br /><pre>$msg</pre>");
		return;
	}
	</%perl>
</%method>

<%method plot_s_drops>
	<%doc>
	Wrapper for making delay plots for servers
	</%doc>
	<%attr>
	ajax => 1		# ajax
	</%attr>
	<%args>
	$start			# start time
	$stop			# stop time
	$fuzzy			# try to use previous if no cached image
	$srv			# server name
	$scale => ''		# width info for html tag (legacy)
	$xscale => ''		# width info for html tag
	$yscale => ''		# height info for html tag
	$af => 'ipv4'
	%plotargs => ()		# plot modifiers
	</%args>
	<%perl>

	$start = ref($start) eq 'Time::Piece' ? $start : new Time::Piece($start);
	$stop = ref($stop) eq 'Time::Piece' ? $stop : new Time::Piece($stop);

	my $afn = $af eq "ipv6" ? &AF_INET6 : &AF_INET;

	if ($TICKET && exists($ARGS{refresh})) {
		$plotargs{'refresh'} = 'yes';
	}

	$srv = RIPE::DNSMon::RRD::ser_alias($srv) ? RIPE::DNSMon::RRD::ser_alias($srv) : $srv;

	my $msg = RIPE::DNSMon::RRD::plot_server_drops(
		start => $start,
		stop => $stop,
		srv => $srv,
		fuzzy => $fuzzy,
		af => $afn,
		%plotargs
	  );

	if ($msg =~ /^M /) {	# user digestable error
		$msg =~ s/^M //;
		$m->print($msg);
		return;
	}
	elsif ($msg =~ /^(F|P|C) /) {	# plot succeeded
		$m->print('(more recent data available)<br />') if $msg =~ /^P /;
		$msg =~ s/^. //;
		my $url= sprintf "../server/plot?server=$srv;type=drops;tstart=%d;tstop=%d;af=$af", $start->epoch, $stop->epoch;

		$m->print("<a href=\"$url\"> ");
		if ($scale) {
			$m->print("<img alt=\"Drop plot for server $srv\" src=\"$msg\" width=\"$scale\" />");
		}
		elsif ($xscale & $yscale) {
			$m->print("<img alt=\"Drop plot for server $srv\" src=\"$msg\" width=\"$xscale\" height=\"$yscale\" />");
		}
		else {
			$m->print("<img alt=\"Drop plot for server $srv\" src=\"$msg\" />");
		}
		$m->print("</a>");
		$m->flush_buffer;
	}
	else {
		$m->print("<h2>Plot returned a fatal error, please notify site administrator.<h2><br /><pre>$msg</pre>");
		return;
	}
	</%perl>
</%method>

<%method plot_p_drops>
	<%doc>
	Wrapper for making delay plots for probes
	</%doc>
	<%attr>
	ajax => 1		# ajax
	</%attr>
	<%args>
	$start			# start time
	$stop			# stop time
	$fuzzy			# fuzzy plotting
	$probe			# probe name
	$scale => ''		# width info for html tag (legacy)
	$xscale => ''		# width info for html tag
	$yscale => ''		# height info for html tag
	$af => 'ipv4'
	%plotargs => ()		# plot modifiers
	</%args>
	<%perl>

	$start = ref($start) eq 'Time::Piece' ? $start : new Time::Piece($start);
	$stop = ref($stop) eq 'Time::Piece' ? $stop : new Time::Piece($stop);

	my $afn = $af eq "ipv6" ? &AF_INET6 : &AF_INET;

	if ($TICKET && exists($ARGS{refresh})) {
		$plotargs{'refresh'} = 'yes';
	}

	my $msg = RIPE::DNSMon::RRD::plot_mon_drops(
		start => $start,
		stop => $stop,
		mon => $probe,
		fuzzy => $fuzzy,
		af => $afn,
		%plotargs
	  );

	if ($msg =~ /^M /) {	# user digestable error
		$msg =~ s/^M //;
		$m->print($msg);
		return;
	}
	elsif ($msg =~ /^(F|P|C) /) {	# plot succeeded
		$m->print('(more recent data available)<br />') if $msg =~ /^P /;
		$msg =~ s/^. //;
		my $url= sprintf "../probe/plot?probe=$probe;type=drops;tstart=%d;tstop=%d;af=$af", $start->epoch, $stop->epoch;

		$m->print("<a href=\"$url\"> ");
		if ($scale) {
			$m->print("<img alt=\"Drop plot for probe $probe\" src=\"$msg\" width=\"$scale\" />");
		}
		elsif ($xscale & $yscale) {
			$m->print("<img alt=\"Drop plot for probe $probe\" src=\"$msg\" width=\"$xscale\" height=\"$yscale\" />");
		}
		else {
			$m->print("<img alt=\"Drop plot for probe $probe\" src=\"$msg\" />");
		}
		$m->print("</a>");
		$m->flush_buffer;
	}
	else {
		$m->print("<h2>Plot returned a fatal error, please notify site administrator.<h2><br /><pre>$msg</pre>");
		return;
	}
	</%perl>
</%method>

<%method plot_domain>
	<%attr>
	ajax => 1		# ajax
	</%attr>
	<%args>
	$start			# start time
	$stop			# stop time
	$fuzzy			# fuzzy plotting
	$domain			# domain name
	$scale => ''		# width info for html tag (legacy)
	$xscale => ''		# width info for html tag
	$yscale => ''		# height info for html tag
	$af => 'ipv4'
	%plotargs => ()		# plot modifiers
	</%args>
	<%perl>

	$start = ref($start) eq 'Time::Piece' ? $start : new Time::Piece($start);
	$stop = ref($stop) eq 'Time::Piece' ? $stop : new Time::Piece($stop);

	my $afn = $af eq "ipv6" ? &AF_INET6 : &AF_INET;

	if ($TICKET && exists($ARGS{refresh})) {
		$plotargs{'refresh'} = 'yes';
	}

	my $msg = RIPE::DNSMon::RRD::plot_domain(
		start => $start,
		stop => $stop,
		domain => $domain,
		fuzzy => $fuzzy,
		af => $afn,
		%plotargs
	  );

	if ($msg =~ /^M /) {	# user digestable error
		$msg =~ s/^M //;
		$m->print($msg);
		return;
	}
	elsif ($msg =~ /^(F|P|C) /) {	# plot succeeded
		$m->print('(more recent data available)<br />') if $msg =~ /^P /;
		$msg =~ s/^. //;
		my $url= sprintf "plot?domain=$domain;tstart=%d;tstop=%d;af=$af", $start->epoch, $stop->epoch;

		$m->print("<a href=\"$url\"> ");
		if ($scale) {
			$m->print("<img alt=\"Domain plot for $domain\" src=\"$msg\" width=\"$scale\" />");
		}
		elsif ($xscale & $yscale) {
			$m->print("<img alt=\"Domain plot for $domain\" src=\"$msg\" width=\"$xscale\" height=\"$yscale\" />");
		}
		else {
			$m->print("<img alt=\"Domain plot for $domain\" src=\"$msg\" />");
		}
		$m->print("</a>");
		$m->flush_buffer;
	}
	else {
		$m->print("<h2>Plot returned a fatal error, please notify site administrator.<h2><br /><pre>$msg</pre>");
		return;
	}
	</%perl>
</%method>

<%method known_server>	
	<%args>
	$srv 
	$af => 'ipv4'
	</%args>
	<%perl>
	my $afn = $af eq "ipv6" ? &AF_INET6 : &AF_INET;
	return(RIPE::DNSMon::RRD::known_server($srv, $afn));
	</%perl>
</%method>

<%method known_probe>	
	<%args>
	$mon 
	$af => 'ipv4'
	</%args>
	<%perl>
	my $afn = $af eq "ipv6" ? &AF_INET6 : &AF_INET;
	return(RIPE::DNSMon::RRD::known_mon($mon, $afn));
	</%perl>
</%method>

<%method known_domain>	
	<%args>
	$domain
	$af => 'ipv4'
	</%args>
	<%perl>
	my $afn = $af eq "ipv6" ? &AF_INET6 : &AF_INET;
	my $known =0;
	foreach my $srv (RIPE::DNSMon::RRD::domain_servers($domain,$afn)) {
		$known ||= RIPE::DNSMon::RRD::known_server($srv, $afn);
		last if $known;
	}
	return $known;
	</%perl>
</%method>

<%method select_server>
	<%args>
	$af => 'ipv4'
	</%args>
	<select id="select_server_select" name="server">
	<%perl>
	my $afn = $af eq "ipv6" ? &AF_INET6 : &AF_INET;
	foreach my $srv (RIPE::DNSMon::RRD::all_servers($afn)) {
		$m->print("<option value=\"$srv\">$srv</option>\n");
	}
	</%perl>
	</select>
</%method>

<%method select_af>
	<%args>
	$af => 'ipv4'
	</%args>
	<select id="select_af_select" name="af">
	<%perl>
	foreach my $af qw(ipv4 ipv6) {
		$m->print("<option value=\"$af\">$af</option>\n");
	}
	</%perl>
	</select>
</%method>

<%method select_probe>
	<%args>
	$af => 'ipv4'
	</%args>
	<select id="select_probe_select" name="probe">
	<%perl>
	my $afn = $af eq "ipv6" ? &AF_INET6 : &AF_INET;
	foreach my $probe (RIPE::DNSMon::RRD::all_mons($afn)) {
		$m->print("<option value=\"$probe\">$probe</option>\n");
	}
	</%perl>
	</select>
</%method>

<%method select_domain>
	<%args>
	$af => 'ipv4'
	</%args>
	<select id="select_domain_select" name="domain">
	<%perl>
	my $afn = $af eq "ipv6" ? &AF_INET6 : &AF_INET;
	foreach my $dom (RIPE::DNSMon::RRD::all_domains($afn)) {
		$m->print("<option value=\"$dom\">$dom</option>\n");
	}
	</%perl>
	</select>
</%method>

<%method select_time>
	<select id="select_day_select" name="day">
	<%perl>
	foreach my $d ((1..31)) {
		$m->print("<option value=\"$d\">$d</option>\n");
	}
	</%perl>
	</select>
	<b>.</b>
	<select id="select_month_select" name="month">
	<%perl>
	foreach my $d ((1..12)) {
		$m->print("<option value=\"$d\">$d</option>\n");
	}
	</%perl>
	</select>
	<b>.</b>
	<select id="select_year_select" name="year">
	<%perl>
	foreach my $d (2003..strftime("%Y",gmtime)) {
		$m->print("<option value=\"$d\">$d</option>\n");
	}
	</%perl>
	</select>
	&nbsp;&nbsp;<select id="select_hour_select" name="hour">
	<%perl>
	foreach my $d ((0..23)) {
		$m->print("<option value=\"$d\">$d</option>\n");
	}
	</%perl>
	</select>
	<b>h</b>
</%method>

<%method select_shift>
	<%perl>
	my @times = (
		'p-month',
		'p-week',
		'p-day',
		'-24h',
		'-12h',
		'-6h',
		'+6h',
		'+12h',
		'+24h',
		'n-day',
		'n-week',
		'n-month',
	  );

	foreach my $t (@times) {
		if ($t eq 'now') {
			$m->print("&nbsp;&nbsp;&nbsp;&nbsp;<input type=\"submit\" value=\"   NOW   \" name=\"plot\" />&nbsp;&nbsp;&nbsp;&nbsp;");
		}
		else {
			$m->print("<input type=\"submit\" value=\"$t\" name=\"shift\" />");
		}
	}
	</%perl>
</%method>

<%method select_period>
	<select id="select_period_select" name="period">
	<option value="lastval">until last</option>
	<option value="undef"></option>
	<%perl>
	foreach my $p (@periods) {
		$m->print("<option value=\"$p\">$p</option>\n");
	}
	</%perl>
	</select>
</%method>

<%method select_type>
	<select id="select_type_select" name="type">
	<%perl>
	foreach my $p (@types) {
		$m->print("<option value=\"$p\">$p</option>\n");
	}
	</%perl>
	</select>
</%method>

<%method select_stype>
	<select id="select_stype_select" name="type">
	<%perl>
	foreach my $p (@stypes) {
		$m->print("<option value=\"$p\">$p</option>\n");
	}
	</%perl>
	</select>
</%method>

<%method select_refresh_plot>
	Refresh&nbsp;cached&nbsp;plot&nbsp;<input type="checkbox" id="select_select_refresh_plot" name="refresh" value="yes" />
</%method>

<%method calc_t1>	
	<%doc> 
	Wrapper around _calc_t1. The wrapper enforces the time delay
	for non-logged-in users

	Returns a Time::Piece object
	</%doc>
	<%perl>
	my $t1 = $m->comp('/lib/rrdplots:_calc_t1', %ARGS );
	return $m->comp('/lib/rrdplots:enforce_delay', time_piece => $t1, %ARGS );
	</%perl>
</%method>

<%method _calc_t1>	
	<%doc> 
	calculate t1, the plot start time 

	Calculate Time Interval for Plots

	This has a very flexible interface allowing a number of calling methods:

		1) from the form with hour,day,month,year,period,shift
		2) from anytime with tstart
		3) default: 24h before lastval

	Returns a Time::Piece object
	</%doc>
	<%args>
	$lastval => localtime(0)
    $tstart => 0
    $day => '' 
    $month => '' 
    $year => '' 
    $hour => '' 
    $shift => '' 
	</%args>
	<%perl>

	# 3) default: 24h before lastval
	if ($day eq '' && $tstart == 0) {
		return ($lastval - $DAY);
	}

	# 2) from anytime with tstart
	if ($tstart) {
		return(Time::Piece->strptime($tstart, '%s'));
	}

	# 1) from the form with hour,day,month,year,period,shift
	my $t1 = Time::Piece->strptime("$day.$month.$year $hour:00", '%d.%m.%Y %H:%M');
	if ($shift) {
		my $shiftsecs = $m->comp('.shift_2_secs', 'shift'=>$shift, t1=>$t1);
		$t1 += $shiftsecs;
	}
	return($t1);
	</%perl>
</%method>


<%method calc_t2>	
    <%doc> 
	Wrapper around _calc_t2. The wrapper enforces the time delay
	for non-logged-in users

	Returns a Time::Piece object
    </%doc>
	<%perl>
	my $t2 = $m->comp('/lib/rrdplots:_calc_t2', %ARGS );
	return $m->comp('/lib/rrdplots:enforce_delay', time_piece => $t2, %ARGS );
	</%perl>
</%method>

<%method _calc_t2>	
    <%doc> 
	calculate t2, the plot end time 

	Calculate Time Interval for Plots

	This has a very flexible interface allowing a number of calling methods:

		1) from the form with hour,day,month,year,period,shift
		2) from anytime with tstart
		3) default: 1 sec before lastval

	Returns a Time::Piece object
    </%doc>
	<%args>
	$lastval => localtime(0)
	$tstart => 0
	$tstop => 0
	$day => '' 
	$month => '' 
	$year => '' 
	$hour => '' 
	$shift => '' 
	$period => '24h'
	</%args>
	<%perl>

	# 3) default: 1 sec before lastval
	if ($day eq '' && $tstart == 0) {
		return ($lastval-1)
	}

	# 3) default: 1 sec before lastval
	if ($period eq 'lastval' && ! $m->comp('.shift_2_period', shift=>$shift)) {
		return ($lastval-1)
	}

	# 2) from anytime with tstart. XXX assumes tstop if tstart...
	if ($tstart) {
		return Time::Piece->strptime($tstop, '%s');
	}

	# 1) from the form with hour,day,month,year,period,shift
	my $t1 = Time::Piece->strptime("$day.$month.$year $hour:00", '%d.%m.%Y %H:%M');

	my $t2 = $t1 + $m->comp('/lib/rrdplots:period_2_secs', period=>$period);

	if ($shift) {

		my $shiftsecs = $m->comp('.shift_2_secs', shift=>$shift, t1=>$t1);
		$t1 += $shiftsecs;

		if (my $period = $m->comp('.shift_2_period', shift=>$shift)) {
			$t2 = $t1 + $m->comp('/lib/rrdplots:period_2_secs', period=>$period);
		}
		else {
			$t2 += $shiftsecs;
		}
	}
	return($t2);
	</%perl>
</%method>
<%method warn_long_timeframe>
	<%args>
		$start
		$stop
		$threshold => ONE_WEEK
	</%args>
	<%doc>
		Prints a friendly reminder when selecting long time periods
	</%doc>
%		if ($stop - $start > $threshold) {
The time period you selected is of considerable length. Please be patient while the system gathers all data
%		} 
</%method>

<%method check_membership>
	<%args>
		$domain => ''
		$srv => ''
		$probe => ''
		$af => 'ipv4'
	</%args>
	<%doc>
	Check whether the principal (a RIPE::Security::Principal::DNSMonUser object )in
	$TICKET may access $domain or $ticket

	returns TRUE or FALSE

	</%doc>
	<%perl>
	my $allowed = 0;
	my $principals = $TICKET->subject->getPrincipals if ($TICKET && $TICKET->subject);
	my $afn = $af eq "ipv6" ? &AF_INET6 : &AF_INET;

	if ($principals && $principals->[0]) {
		my @groups = $principals->[0]->getGroups();

		if (!($allowed = grep { $_ eq 'ALL' } @groups)) {
			if (!$domain && $srv) {
				my @allowed_servers = map { RIPE::DNSMon::RRD::domain_servers($_,$afn) } grep { $_ ne 'ALL' } @groups;
				push(@allowed_servers, $LASTVAL_SERVER);

				$allowed = grep { $_ eq $srv } (@allowed_servers, @groups) ;
			} elsif ($domain) {
				$allowed = grep { $_ eq $domain } @groups;
			} elsif ($probe) {
				$allowed = 1;
			} 
		}
	}
	return $allowed;
	</%perl>
</%method>

<%method enforce_delay>	
    <%doc> 
        Enforce time delay for non-paying users
    </%doc>
	<%args>
	$time_piece
	$domain => ''
	$srv => ''
	$probe => ''
	</%args>

	<%perl>
    # if they have a TICKET then they are logged in. no delay in this case
    return $time_piece if ($TICKET && $m->comp('/lib/rrdplots:check_membership', domain => $domain, srv => $srv, probe => $probe ));

    # check if they need a delay
    return $time_piece unless $CONFIG{time_delay};

    # are they after a time after the cut off time?
    my $cutoff = localtime(time()-$CONFIG{time_delay});
    if ($time_piece->epoch > $cutoff->epoch) {
        return $cutoff;                 # yup, so they get the cutoff.
    }
    return $time_piece;                 # no problems
	</%perl>
</%method>

<%method limit_view>	
    <%doc> 
	Limit view of unauthorized objects depending on user class
    </%doc>
	<%args>
	$object
	$time_piece
	</%args>
	<%perl>

	my ($user,@group);
	# Get user & group credentials
	# See whether the object belongs to the group the user belongs to, otherwise cut off date

    # if they have a TICKET then they are logged in. no delay in this case
    return $time_piece if $TICKET;

    # check if they need a delay
    return $time_piece unless $CONFIG{time_delay};

    # are they after a time after the cut off time?
    my $cutoff = localtime(time()-$CONFIG{time_delay});
    if ($time_piece->epoch > $cutoff->epoch) {
        return $cutoff;                 # yup, so they get the cutoff.
    }
    return $time_piece;                 # no problems
	</%perl>
</%method>

<%method last_val>
    <%doc> 
	Same as last_val except enforces time delay for non-paying users.
	Takes a server name and finds the latest time value. 
	If we have a logged in user, the global $TICKET will be defined; so
	simply return the last value. Otherwise check if the time is greater
	than the time_delay permitted for non-paying users, and truncate if
	so.

	Time returned is rounded down to the nearest hour

	Returns a Time::Piece object
    </%doc>

	<%args>
	$srv 
	$af => 'ipv4'
	</%args>

	<%perl>
	# get last_val. note, this value is already rounded
	# down to the nearest hour
	my $afn = $af eq "ipv6" ? &AF_INET6 : &AF_INET;
	my $last_val = localtime(RIPE::DNSMon::RRD::last_val($srv,$afn));

	# enforce delay
	my $delayed =
	  $m->comp('/lib/rrdplots:enforce_delay', time_piece => $last_val, %ARGS );

	# round it down to the nearest hour. this is important for caching
	my $rounded = $delayed - ($delayed->epoch % $LASTTROUNDDOWN);

	return $rounded;
	</%perl>
</%method>

<%method last_val_probe>
    <%doc>
	Same as last_val_probe except enforces time delay for non-paying users.
	Takes a server name and finds the latest time value. 
	If we have a logged in user, the global $TICKET will be defined; so
	simply return the last value. Otherwise check if the time is greater
	than the time_delay permitted for non-paying users, and truncate if
	so.

	Time returned is rounded down to the nearest hour

	Returns a Time::Piece object
    </%doc>
	<%args>
	$probe 
	$af => 'ipv4'
	</%args>

	<%perl>
	# get last_val. note, this value is already rounded
	# down to the nearest hour
	my $afn = $af eq "ipv6" ? &AF_INET6 : &AF_INET;
	my $last_val_mon = localtime(RIPE::DNSMon::RRD::last_val_mon($probe,$afn));

	# enforce delay
	my $delayed =
	  $m->comp('/lib/rrdplots:enforce_delay', time_piece => $last_val_mon, %ARGS );

	# round it down to the nearest hour. this is important for caching
	my $rounded = $delayed - ($delayed->epoch % $LASTTROUNDDOWN);

	return $rounded;
	</%perl>
</%method>

<%method calc_period>	
	<%doc> 
	calculate the plot period for display in the 'period' menu 
	</%doc>
	<%args>
	$t1
	$t2
	$period
	$shift => ''
	$lastval => localtime(0)
	</%args>
	<%perl>
	if ($m->comp('.shift_2_period', shift=>$shift) eq '') {
		return($period) if $period eq 'lastval';
		return('lastval') if $period eq '' && ($lastval->epoch()-1) == $t2->epoch;
	}
	return($m->comp('/lib/rrdplots:secs_2_period', secs=> ($t2-$t1)));
	</%perl>
</%method>


<%def .shift_2_secs>	<%doc> calculate time shift in seconds from shift string </%doc>
	<%args>
	$shift => ''
	$t1
	</%args>

	<%perl>
	return(0) unless $shift;

	my $shiftsecs;
	if ($shift eq '-6h') {
		$shiftsecs = -6 * $HOUR;
	}
	elsif ($shift eq '-12h') {
		$shiftsecs = -12 * $HOUR;
	}
	elsif ($shift eq '-24h') {
		$shiftsecs = -24 * $HOUR;
	}
	elsif ($shift eq 'p-day') {
		$shiftsecs = -24 * $HOUR - ($t1->epoch % $DAY);
	}
	elsif ($shift eq 'p-week') {
		$shiftsecs = -7 * $DAY - ($t1->epoch % $DAY);
	}
	elsif ($shift eq 'p-month') {
		$shiftsecs = -31 * $DAY - ($t1->epoch % $DAY);
	}
	elsif ($shift eq '+6h') {
		$shiftsecs = 6 * $HOUR;
	}
	elsif ($shift eq '+12h') {
		$shiftsecs = 12 * $HOUR;
	}
	elsif ($shift eq '+24h') {
		$shiftsecs = 24 * $HOUR;
	}
	elsif ($shift eq 'n-day') {
		$shiftsecs = 24 * $HOUR - ($t1->epoch % $DAY);
	}
	elsif ($shift eq 'n-week') {
		$shiftsecs = 7 * $DAY - ($t1->epoch % $DAY);
	}
	elsif ($shift eq 'n-month') {
		$shiftsecs = 31 * $DAY - ($t1->epoch % $DAY);
	}
	return($shiftsecs);
	</%perl>
</%def>


<%def .shift_2_period>		<%doc> calculate new period default from shift string </%doc>
	<%args>
	$shift => ''
	</%args>
	<%perl>
	return('24h') if ($shift =~ /-day$/);
	return('7 days') if ($shift =~ /-week$/);
	return('1 month') if ($shift =~ /-month$/);
	return('');
	</%perl>
</%def>


<%method period_2_secs>		<%doc> length of period in seconds </%doc>
	<%args>
	$period
	</%args>
	<%perl>
	return($period_secs{$period});
	</%perl>
</%method>

<%method secs_2_period>		<%doc> most appropriate period string from seconds </%doc>
	<%args>
	$secs
	</%args>
	<%perl>
	my($i);

	foreach ($i=0; $i<=$#periods; $i++) {
		return($periods[$i]) if ($secs<=$period_secs{$periods[$i]});
	}
	return($periods[$#periods]);
	</%perl>
</%method>

<%method lookup_address><%doc>Look up an address in either AF_INET or AF_INET6</%doc>
	<%args>
	$name
	$af
	</%args>
	<%perl>
	my $afn = $af eq "ipv6" ? &AF_INET6 : &AF_INET;
	my $addr = RIPE::DNSMon::RRD::server_addr($name,$afn);
	if (!$addr) {
		my ($family, $socktype, $proto, $saddr, $canonname, @res) = getaddrinfo($name, undef, $afn);
		$addr = defined $saddr ? (getnameinfo($saddr, NI_NUMERICHOST))[0] : undef;
	}
	return $addr;
	</%perl>
</%method>

<%method ris_url><%doc></%doc>
<%args>
	$name
	$af
	$start
	$stop
</%args>
<%perl>
	my $url = '';

	$start = ref($start) eq 'Time::Piece' ? $start : new Time::Piece($start);
	$stop = ref($stop) eq 'Time::Piece' ? $stop : new Time::Piece($stop);
	
	my $addr = $m->comp('SELF:lookup_address', name => $name, af => $af);

	if ($addr) {
		$url = $m->scomp('/lib/url', host => 'www.ris.ripe.net',
			path=> '/perl-risapp/risearch-result.html',
			query => {
				as=> sprintf("$addr%s", $af eq "ipv6" ? "/128" : "/32"),
				ipv=> $af eq "ipv6" ? 6 : 4,
				preftype=>"lspec",
				submit=>"Search",
				startday=> $start->strftime("%Y%m%d"),
				starthour=>$start->hour,
				startmin=>$start->min,
				startsec=>$start->sec,
				enday=> $stop->strftime("%Y%m%d"),
				endhour=>$stop->hour,
				endmin=>$stop->min,
				endsec=>$stop->sec,
				rrc_id=>"1000",
				peer=>"ALL",
				utype=>"B",
				outype=>"html",
				sumupd=>"n",
				arrow=>"west",
				rank=>"100",
				graphsize=>"--",
			});
		}
</%perl>
%	if ($url) {
Experimental feature, <a target="_blank" href="<% $url %>">look up RIS activity for this address</a>
%	}
</%method>

<%method server_domains><%doc>Reverse map servers back to their domain</%doc>
<%args>
	$srv
	$af
</%args>
<%perl>
	my $afn = $af eq "ipv6" ? &AF_INET6 : &AF_INET;
	my @domains = RIPE::DNSMon::RRD::server_domains($srv,$afn);
	return @domains;
</%perl>
</%method>
