#!/usr/bin/perl
################################################################################
# cacti2zabbix converter
############################################# vim: set tabstop=4 filetype=perl #
use strict;
use warnings;

my $KEY_CF_AVERAGE = 'AVERAGE';

my $FILENAME_PROHIBITED_CHARS = '\s\'"#|;:@`\[\]\$\%\&\~\?\{\}\+\*\/\.\\\\';



################################################################################
# Prototypes
################################################################################

sub walk_rrd($);
sub walk_ds($);
sub walk_rra($);
sub walk_database($);

sub prompt($);
sub trim($);

# Print information message.
sub info($);

# Print warning message.
sub warning($);

# Print error message.
sub error($);

# Print Usage.
sub usage($);

################################################################################
# Main
################################################################################

##
# Check args.
#
if ($#ARGV != 0) {
	usage('Invalid number of arguments.');
	exit 1;
}

my $infile = shift(@ARGV);

if (!(-f $infile)) {
	error('"${infile}"??');
	exit 2;
}

##
# Load rrd-xml (rrdtool dump xxx.rrd > xxx.xml)
#
my $fp_in;

if (!open($fp_in, '<', $infile)) {
	error("Cannot open file: '${infile}'.");
	exit 3;
}

info("Start load '${infile}'.");

my $rrd;

while (my $line = <$fp_in>) {
	if ($line =~ m|^\s*<rrd>|o) {
		$rrd = walk_rrd($fp_in);
	}
}


close($fp_in);

if (! $rrd) {
	error('Conversion failed.');
	exit 4;
}


##
# Generate file for zabbix-sender.
#
my $hostname;

until ($hostname = prompt('hostname ?')) {
	warning('Hostname is mandatory parameter.');
}

my $idx = 0;
foreach my $ds (@{$rrd->{'dss'}}) {

	my $itemkey = prompt("itemkey of ds:${ds} ?");

	if (! $itemkey) {
		$idx++;
		next;
	}

	$itemkey =~ s/"/\\"/g;

	my $data_format = prompt(
		"data format string for 'sprintf' (eg : %s, %d, %f ...) ?");

	# numeric(16,4) on postgres.
	$data_format = '%.4f' if ($data_format eq '%f');

	eval {
		my $test = sprintf($data_format, 1);
	};

	if ($@) {
		error($@);
		next;
	}

	my $outfile = "${hostname}_${itemkey}";
	$outfile =~ s/[${FILENAME_PROHIBITED_CHARS}]/_/og;
	$outfile =~ s/_{2,}/_/g;
	$outfile .= '.zbx';

	info("Set file name to '${outfile}'.");
	info("Start process to collect data.");

	my %datas = ();
	my $min_pdp_per_row = 999999;

	foreach my $rra (@{$rrd->{'rras'}}) {

		next if ($rra->{'cf'} ne $KEY_CF_AVERAGE);

		my $pdp_per_row = $rra->{'pdp_per_row'};
		my $overwrite = 0;

		if ($pdp_per_row < $min_pdp_per_row) {
			$min_pdp_per_row = $pdp_per_row;
			$overwrite = 1;
		}

		foreach my $data (@{$rra->{'database'}}) {

			next if (
				exists($datas{$data->{'unix_ts'}}) &&
				!($overwrite)
			);
			$datas{$data->{'unix_ts'}} = ${$data->{'values'}}[$idx];
		}
	}

	info("Start sort and output zabbix-data to '${outfile}'.");

	my $fp_out;

	if (!open($fp_out, '>', $outfile)) {
		error("Cannot open '${outfile}' for write.");
		next;
	}

	foreach my $unix_ts (sort keys %datas) {
		print $fp_out
			"\"${hostname}\" ",
			"\"${itemkey}\" ",
			"${unix_ts} ",
			sprintf($data_format, $datas{$unix_ts}), "\n";
	}

	info("Finished to convert '${ds}' to '${itemkey}'.");
}


exit 0;

################################################################################
# Sub routines
################################################################################

sub walk_rrd($) {

	my $fp = shift(@_);
	my @dss;
	my @rras;
	my $step = 300;

	while (my $line = <$fp>) {

		if ($line =~ m|^\s*</rrd>|o) {
			return {
				'dss' => \@dss,
				'rras' => \@rras,
			};
		}



		if ($line =~ m|^\s*<step>(\d+)</step>|) {
			$step = int($1);
		}

		if ($line =~ m|^\s*<ds>|o) {

			my $child = walk_ds($fp);

			if (! $child) {
				error('Syntax error: <ds> not closed.');
				return undef;
			}

			if ($child->{'name'}) {
				push(@dss, trim($child->{'name'}));
				info("Found <ds> named '${dss[$#dss]}'.");
			} else {
				error('<ds> not contains <name>.');
				return undef;
			}
		} 

		if ($line =~ m|^\s*<rra>|) {

			my $rra = walk_rra($fp);

			if (! $rra) {
				error('<rra> not closed.');
				return undef;
			}

			my $cf = $rra->{'cf'};
			my $sec_per_row = int($rra->{'pdp_per_row'}) * $step;

			push(@rras, $rra);
			info("Found <rra> [cf:${cf}, sec_per_row:${sec_per_row}].");
		}
	}

	error('<rrd> not closed.');
	return undef;
}

sub walk_ds($) {

	my $fp = shift(@_);
	my %elements = ();

	while (my $line = <$fp>) {

		return \%elements if ($line =~ m|^\s*</ds>|o);

		if ($line =~ m|^\s*<([a-z_]+)>(.+)</\1>|o) {
			my $element = $1;
			my $value = $2;

			chomp($value);
			$elements{$element} = $value;

		}
	}

	error('<ds> not closed.');
	return undef;
}

sub walk_rra($) {

	my $fp = shift(@_);
	my $cf = undef;
	my $pdp_per_row = undef;
	my @database;

	while (my $line = <$fp>) {

		if ($line =~ m|^\s*</rra>|o) {
			error('<cf> not found.') unless(defined($cf));
			error('<pdp_per_row> not found.') unless(defined($pdp_per_row));
			error('<database> not found.') unless(@database);

			if (defined($cf) && defined($pdp_per_row) && @database) {
				return {
					'cf' => $cf,
					'pdp_per_row' => $pdp_per_row,
					'database' => \@database,
				};
			} else {
				return undef;
			}
		}



		if ($line =~ m|^\s*<cf>(.+)</cf>|o) {
			$cf = trim($1);
		} 

		if ($line =~ m|^\s*<pdp_per_row>(\d+)</pdp_per_row>|o) {
			$pdp_per_row = trim($1);
		}

		if ($line =~ m|^\s*<database>|o) {
			@database = walk_database($fp);
		}
	}

	error('<rra> not closed');
	return undef;
}

sub walk_database($) {

	my $fp = shift(@_);
	my @database;

	while (my $line = <$fp>) {

		return @database if ($line =~ m|^\s*</database>|);

		my ($ts, $unix_ts) =
			$line =~ m|^\s*<!--\s*([0-9A-Z\s:-]+)\s+/\s+(\d+)\s+-->|o;

##
# hmm...
#		my @values =
#			$line =~ m|<row>\s*(?:<v>([0-9eE\+\.\-]+)</v>)+\s*</row>\s*$|go;
#
		my ($values_part) =
			$line =~ m|<row>((?:<v>[0-9eE\+\.\-]+</v>)+)</row>|o;

		next unless ($values_part);

		my @values =
			$values_part =~ m|<v>([0-9eE\+\.\-]+)</v>|og;
		next unless (@values);


		push (
			@database, 
			{
				'unix_ts' => $unix_ts,
				'values' => \@values,
			}
		);
	}

	error('<database> not closed.');
	return undef;
}

sub prompt($) {

	print STDOUT "\n", $_[0], ' ';

	my $in = <STDIN>;

	print STDOUT "\n";
	return trim($in);
}

sub trim($) {
	my $trimed = $_[0];
	$trimed =~ s/^\s+//o;
	$trimed =~ s/\s+$//o;
	return $trimed;
}

sub info($) {
	_printMessage('II', $_[0]);
}

sub warning($) {
	_printMessage('WW', $_[0]);
}

sub error($) {
	_printMessage('EE', $_[0]);
}

sub _printMessage($$) {
	my ($type, $message) = @_;
	print STDERR localtime(time()), " [${type}] ${message}\n";
}

sub usage($) {
	print STDERR "\n", $_[0], "\n\n" if ($_[0]);
	print STDERR 
<<EOF;
Usage:

    # cacti2zabbix <rrd file>

EOF


}