#!/usr/bin/env perl
## Copyright © 2010-2012 by Daniel Friesel <derf@finalrewind.org>
## License: WTFPL <http://sam.zoy.org/wtfpl>
##   0. You just DO WHAT THE FUCK YOU WANT TO.
use strict;
use warnings;
use 5.010;

no if $] >= 5.018, warnings => 'experimental::smartmatch';

use App::Icli::ConfigData;
use Carp qw(croak);
use DateTime;
use DateTime::Format::Strptime;
use Getopt::Long qw/:config bundling/;
use List::MoreUtils qw(any firstval);
use POSIX qw(strftime);
use Term::ANSIColor;
use Term::Size;

our $VERSION = '0.47';

my ( $cache, $config, $data, $extra );
my $config_file = App::Icli::ConfigData->config('object_file');
my $status_file = App::Icli::ConfigData->config('status_file');
my $rw_file     = App::Icli::ConfigData->config('command_file');
my $context;
my $colours      = 1;
my $list_type    = 's';
my $verbosity    = 1;
my $overview     = 0;
my $match_output = undef;
my $action       = undef;
my $as_contact   = undef;
my $term_width   = Term::Size::chars();
my $cut_mode     = 'b';
my ( @for_hosts, @for_groups, @for_services, @list_hosts, @list_services );
my @action_args;
my @filters;

sub have_host {
	my ($host) = @_;
	if ( $list_type eq 's' ) {
		return exists $data->{services}->{$host};
	}
	else {
		return exists $data->{hosts}->{$host};
	}
}

sub have_service {
	my ( $host, $service ) = @_;

	foreach my $s ( @{ $data->{services}->{$host} } ) {
		if ( $s->{service_description} eq $service ) {
			return 1;
		}
	}
	return 0;
}

sub have_service_multi {
	my ( $host, @services ) = @_;

	foreach my $s (@services) {
		if ( have_service( $host, $s ) ) {
			return 1;
		}
	}
	return 0;
}

sub with_colour {
	my ( $text, $colour ) = @_;
	if ($colours) {
		return colored( $text, $colour );
	}
	else {
		return $text;
	}
}

sub pretty_date {
	my ($unix) = @_;

	if ( $unix == 0 ) {
		return 'never';
	}

	return strftime( '%Y-%m-%d %H:%M:%S', localtime($unix) );
}

sub pretty_duration {
	my ($since) = @_;
	my $now     = time();
	my $dif     = $now - $since;

	return sprintf( '%dd %dh %dm %ds',
		int( $dif / ( 24 * 3600 ) ),
		int( ( $dif / 3600 ) % 24 ),
		int( ( $dif / 60 ) % 60 ),
		$dif % 60, );
}

sub pretty_noyes {
	my ($bool) = @_;
	return (
		$bool
		? with_colour( 'YES', 'white on_red' )
		: with_colour( 'NO',  'black on_green' )
	);
}

sub pretty_yesno {
	my ($bool) = @_;
	return (
		$bool
		? with_colour( 'YES', 'black on_green' )
		: with_colour( 'NO',  'white on_red' )
	);
}

sub pretty_state {
	my ( $count, $state ) = @_;
	my $colour;

	given ($state) {
		when ('ok')       { $colour = 'black on_green' }
		when ('warning')  { $colour = 'black on_yellow' }
		when ('critical') { $colour = 'white on_red' }
		when ('unknown')  { $colour = 'white on_blue' }
	}

	if ( $count == 0 ) {
		return q{    };
	}
	if ($colour) {
		return with_colour( sprintf( '%4d', $count ), $colour );
	}
	return sprintf( '%4d', $count );
}

sub split_by_words {
	my ( $str, $padding, $max_w ) = @_;
	my @words = split( / /, $str );
	my @ret;

	while ( any { length($_) > $max_w } @words ) {
		for my $i ( 0 .. $#words ) {
			my $word = $words[$i];

			if ( length($word) > $max_w ) {
				splice(
					@words, $i, 1,
					substr( $word, 0, $max_w ),
					substr( $word, $max_w )
				);
				last;
			}
		}
	}

	while (@words) {
		my $cur_str  = q{};
		my $tr_space = 0;
		while (
			@words
			and
			( ( length($cur_str) + length( $words[0] ) + $tr_space ) <= $max_w )
		  )
		{
			if ($tr_space) {
				$cur_str .= ' ';
			}
			else {
				$tr_space = 1;
			}
			$cur_str .= shift(@words);
		}
		if (@ret) {
			$cur_str = ( ' ' x $padding ) . $cur_str;
		}
		push( @ret, $cur_str );
	}
	return @ret;
}

sub break_str {
	my ( $text, $waste ) = @_;
	my $cut = $term_width - $waste;

	if (   ( not defined $term_width )
		or ( $term_width == 0 )
		or ( $cut < 12 ) )
	{
		return $text;
	}

	if ( $cut_mode eq 'c' ) {
		return substr( $text, 0, $cut );
	}
	elsif ( $cut_mode eq 'b' ) {
		return join( "\n", split_by_words( $text, $waste, $cut ) );
	}
	else {
		return $text;
	}
}

sub check_is_soft {
	my ($x) = @_;

	return ( $x->{'last_hard_state'} != $x->{'current_state'} );
}

sub check_is_host_down {
	my ($s) = @_;

	return ( $data->{'hosts'}->{ $s->{'host_name'} }->{'current_state'} != 0 );
}

sub filter_generic {
	my ($x) = @_;
	my $filters_unfulfilled = @filters;

	if ( $match_output and not $x->{plugin_output} =~ $match_output ) {
		return 0;
	}

	foreach my $f (@filters) {
		if (
			   ( $f eq 'A'  and $x->{'problem_has_been_acknowledged'} )
			or ( $f eq '!A' and not $x->{'problem_has_been_acknowledged'} )
			or ( $f eq 'D'  and check_is_host_down($x) )
			or ( $f eq '!D' and not check_is_host_down($x) )
			or ( $f eq 'F'  and $x->{'is_flapping'} )
			or ( $f eq '!F' and not $x->{'is_flapping'} )
			or ( $f eq 'N'  and not $x->{'notifications_enabled'} )
			or ( $f eq '!N' and $x->{'notifications_enabled'} )
			or (    $f eq 'P'
				and $x->{'passive_checks_enabled'}
				and not $x->{'active_checks_enabled'} )
			or ( $f eq '!P' and $x->{'active_checks_enabled'} )
			or ( $f eq 'S'  and check_is_soft($x) )
			or ( $f eq '!S' and not check_is_soft($x) )
			or ( $f eq 'p'  and $x->{'has_been_checked'} == 0 )
			or ( $f eq '!p' and $x->{'has_been_checked'} != 0 )
			or ( $f eq 'o'  and $x->{'current_state'} == 0 )
			or ( $f eq '!o'
				and
				( $x->{'current_state'} != 0 or $x->{'has_been_checked'} == 0 )
			)
			or ( $f eq 'w'  and $x->{'current_state'} == 1 )
			or ( $f eq '!w' and $x->{'current_state'} != 1 )
			or ( $f eq 'c'  and $x->{'current_state'} == 2 )
			or ( $f eq '!c' and $x->{'current_state'} != 2 )
			or ( $f eq 'u'  and $x->{'current_state'} == 3 )
			or ( $f eq '!u' and $x->{'current_state'} != 3 )
			or ( $f eq 'd'  and $x->{'current_state'} == 1 )
			or ( $f eq '!d' and $x->{'current_state'} != 1 )
			or ( $f eq 'x'  and $x->{'current_state'} == 2 )
			or ( $f eq '!x' and $x->{'current_state'} != 2 )
			or

			0    # Terminator to ease adding new lines
		  )
		{
			$filters_unfulfilled--;
		}
	}

	if ($filters_unfulfilled) {
		return 0;
	}

	return 1;
}

sub filter_host {
	my ($h) = @_;

	if ( not filter_generic($h) ) {
		return 0;
	}

	return 1;
}

sub filter_service {
	my ($s) = @_;

	if ( not filter_generic($s) ) {
		return 0;
	}

	if ( @list_services
		and not( $s->{'service_description'} ~~ [@list_services] ) )
	{
		return 0;
	}

	if ( $as_contact and not has_contact( $s, $as_contact ) ) {
		return 0;
	}

	return 1;
}

sub has_contact {
	my ( $s, $contact ) = @_;

	my $conf_s
	  = firstval { $_->{service_description} eq $s->{service_description} }
	@{ $config->{services}{ $s->{host_name} } };

	return any { $_ eq $contact } @{ $conf_s->{contacts} };
}

sub read_objects_line {
	my ( $line, $ref ) = @_;

	if ( $line =~ / ^ (?:define \s )? (?<context> \w+) \s+ { /x ) {
		$context = $+{context};
	}
	elsif ( $line =~ / ^ \t (?<key> [^=\t]+ ) [=\t] \s* (?<value> .*) $ /x ) {
		$cache->{ $+{key} } = $+{value};
	}
	elsif ( $line =~ / ^ \t } $ /x ) {
		given ($context) {
			when ( [ 'info', 'programstatus' ] ) {
				${$ref}->{$context} = $cache;
			}
			when ('hoststatus') {
				${$ref}->{hosts}->{ $cache->{host_name} } = $cache;
			}
			when ('servicestatus') {
				push(
					@{ ${$ref}->{services}->{ $cache->{host_name} } },
					$cache
				);
			}
			when ('contactstatus') {
				push( @{ ${$ref}->{contacts} }, $cache );
			}
			when ('hostdowntime') {
				push( @{ ${$ref}->{hostdowntimes} }, $cache );
			}
			when ('servicedowntime') {
				push( @{ ${$ref}->{servicedowntimes} }, $cache );
			}
			when ('hostgroup') {
				${$ref}->{hostgroups}->{ $cache->{hostgroup_name} } = $cache;
			}
			when ('servicegroup') {
				${$ref}->{servicegroups}->{ $cache->{servicegroup_name} }
				  = $cache;
			}
			when ('hostcomment') {

				# TODO
			}
			when ('servicecomment') {

				# TODO
			}
			when ('host') {
				${$ref}->{hosts}->{ $cache->{host_name} } = $cache;
			}
			when ('service') {
				push(
					@{ ${$ref}->{services}->{ $cache->{host_name} } },
					$cache
				);
			}
			when ('contactgroup') {
				${$ref}->{contactgroups}->{ $cache->{contactgroup_name} }
				  = [ split( m{, *}, $cache->{members} // q{} ) ];
			}
			when (
				[
					qw[
					  timeperiod command contactgroup contact host service
					  servicedependency serviceescalation module hostdependency
					  ]
				]
			  )
			{

				# skipped for now
			}
			default {
				warn("Unknown field in $status_file: $context\n");
			}
		}
		$cache = undef;
	}
}

sub read_objects {
	my ( $file, $ref, $description, $opt ) = @_;

	open( my $fh, '<', $file )
	  or die( "Failed to read $description ($file): $!\n"
		  . "Set $opt to change it\n" );

	while ( my $line = <$fh> ) {
		chomp($line);
		read_objects_line( $line, $ref );
	}

	close($fh)
	  or warn("Failed to close $description ($file): $!\n");
}

sub enhance_status {
	HOST: for my $h ( keys %{ $data->{services} } ) {
		for my $s ( @{ $data->{services}->{$h} } ) {
			if ( $s->{current_state} != 0 ) {
				$extra->{$h}->{service_problem} = 1;
				next HOST;
			}
		}
	}
	HOST: for my $h ( keys %{ $config->{services} } ) {
		for my $s ( @{ $config->{services}->{$h} } ) {
			if ( $s->{contacts} ) {
				$s->{contacts} =~ s{^ *}{}o;
				$s->{contacts} = [ split( m{, *}, $s->{contacts} ) ];
			}
			for my $group ( split( m{, *}, $s->{contact_groups} ) ) {
				push(
					@{ $s->{contacts} },
					@{ $config->{contactgroups}{$group} }
				);
			}
		}
	}
}

sub parse_action {
	if ( not $action ) {
		return;
	}

	my @raw_args;

	my %actionmap = (
		a => 'acknowledge',
		d => 'downtime',
		r => 'recheck',
		R => 'force_recheck',
	);

	( $action, @raw_args ) = split( /:/, $action );
	@action_args = split( /,/, join( ':', @raw_args ) );
	$list_type = q{};

	if ( exists $actionmap{$action} ) {
		$action = $actionmap{$action};
	}
	elsif ( length($action) <= 2 ) {
		say STDERR "Note: Action shortcut '${action}' is unknown";
	}
}

sub compute_hostlist {
	for my $arg (@ARGV) {
		my ( $host, $service ) = split( qr{/}, $arg );

		if ( not any { $host } @for_hosts ) {
			push( @for_hosts, $host );
		}
		if ($service) {
			push( @for_services, $service );
		}
	}

	foreach my $host (@for_hosts) {
		if ( not exists $data->{services}->{$host} ) {
			die("Unknown host: ${host}\n");
		}
	}

	@list_hosts    = @for_hosts;
	@list_services = @for_services;

	foreach my $group (@for_groups) {
		if ( not exists $config->{'hostgroups'}->{$group} ) {
			die("Unknown hostgroup: ${group}\n");
		}
		foreach
		  my $host ( split /,/, $config->{'hostgroups'}->{$group}->{'members'} )
		{
			if ( not any { $_ eq $host } @list_hosts ) {
				push( @list_hosts, $host );
			}
		}
	}

	if ( @list_hosts == 0 ) {
		@list_hosts = sort keys %{ $data->{hosts} };
	}

	if (@list_services) {
		@list_hosts
		  = grep { have_service_multi( $_, @list_services ) } @list_hosts;
	}

	if ( $list_type eq 'h' ) {
		@list_hosts
		  = grep { filter_host( $data->{'hosts'}->{$_} ) } @list_hosts;
	}
}

sub service_state {
	my ($s)     = @_;
	my $checked = $s->{has_been_checked};
	my $digit   = $s->{current_state};

	if ( not $checked ) {
		return 'PENDING ';
	}

	given ($digit) {
		when (0) { return with_colour( '   OK   ', 'black on_green' ) }
		when (1) { return with_colour( ' WARNING', 'black on_yellow' ) }
		when (2) { return with_colour( 'CRITICAL', 'white on_red' ) }
		when (3) { return with_colour( ' UNKNOWN', 'white on_blue' ) }
		default { croak("Unknown service state: $digit\n") }
	}
}

sub host_state {
	my ($h)     = @_;
	my $checked = $h->{has_been_checked};
	my $digit   = $h->{current_state};

	if ( not $checked ) {
		return '  PENDING  ';
	}

	given ($digit) {
		when (0) { return with_colour( '    OK     ', 'black on_green' ) }
		when (1) { return with_colour( '   DOWN    ', 'white on_red' ) }
		when (2) { return with_colour( 'UNREACHABLE', 'white on_blue' ) }
		default  { croak("Unknown host state: $digit\n") }
	}
}

sub display_queue {
	my @queue = map { $_->[0] }
	  sort { $a->[1] <=> $b->[1] }
	  map { [ $_, $_->{next_check} ] } (
		values %{ $data->{hosts} },
		map { @{$_} } values %{ $data->{services} }
	  );

	@queue = grep { $_->{host_name} ~~ \@list_hosts } @queue;

	if (@list_services) {
		@queue = grep { $_->{service_description} ~~ \@list_services } @queue;
	}

	printf( "%-25.25s  %-20.20s  %-19s  %-19s\n",
		'Host', 'Service', 'Last Check', 'Next Check', );

	for my $e (@queue) {

		if ( $e->{next_check} == 0 ) {
			next;
		}

		printf(
			"%-25.25s  %-20.20s  %-19s  %-19s\n",
			$e->{host_name},
			$e->{service_description} // q{},
			pretty_date( $e->{last_check} ),
			pretty_date( $e->{next_check} ),
		);
	}
}

sub display_downtime {
	my ($d) = @_;
	my $v = $verbosity;

	printf( '%-27.27s', $d->{'host_name'} );

	if ( $v >= 3 ) {
		printf( ' %s %-10.10s',
			pretty_date( $d->{'entry_time'} ),
			$d->{'author'}, );
	}
	if ( $v >= 2 ) {
		printf( ' %-30.30s', $d->{'comment'} );
	}
	printf( ' %s %s',
		pretty_date( $d->{'start_time'} ),
		pretty_date( $d->{'end_time'} ),
	);
	if ( $v >= 2 ) {
		print( $d->{'fixed'} ? ' Fixed' : ' Flexi' );
	}

	print "\n";
}

sub display_x_verbose {
	my ( $x, $format ) = @_;
	my $v = $verbosity;

	if ( $v > 2 ) {
		printf( $format, 'Host', $x->{'host_name'}, );
		if ( $x->{'service_description'} ) {
			printf( $format, 'Service', $x->{'service_description'}, );
			printf(
				"%-16s : %s (for %s)%s\n",
				'Status',
				service_state($x),
				pretty_duration( $x->{'last_state_change'} ),
				(
					$x->{'problem_has_been_acknowledged'}
					? ' (Acknowledged)'
					: q{}
				),
			);
		}
		else {
			printf(
				"%-16s : %s (for %s)%s\n",
				'Status',
				host_state($x),
				pretty_duration( $x->{'last_state_change'} ),
				(
					$x->{'problem_has_been_acknowledged'}
					? ' (Acknowledged)'
					: q{}
				),
			);
		}

		printf( $format,
			'Plugin Output',
			break_str( $x->{'plugin_output'}, 19 ),
		);
		for my $line ( split( qr{\\n}, $x->{'long_plugin_output'} ) ) {
			printf( $format, q{}, break_str( $line, 19 ), );
		}
		printf( $format, 'Performance Data', $x->{'performance_data'}, );
		printf( "%-16s : %d/%d\n",
			'Current Attempt',
			$x->{'current_attempt'},
			$x->{'max_attempts'}, );
		printf( $format, 'Last Check Time', pretty_date( $x->{'last_check'} ),
		);
		printf( $format, 'Next Check', pretty_date( $x->{'next_check'} ), );
		printf(
			"%-16s : %s (%.1f%% state change)\n",
			'Flapping',
			pretty_noyes( $x->{'is_flapping'} ),
			$x->{'percent_state_change'},
		);
	}
	if ( $v > 3 ) {
		printf( $format,
			'Check Type', ( $x->{'check_type'} ? 'PASSIVE' : 'ACTIVE' ),
		);
		printf(
			"%-16s : %5.3fs\n%-16s : %5.3fs\n",
			'Check Latency',  $x->{'check_latency'},
			'Check Duration', $x->{'check_execution_time'},
		);
		if ( $x->{'service_description'} ) {
			printf(
				"%-16s : o %s   w %s   c %s   u %s\n",
				'Last State Times',
				pretty_date( $x->{'last_time_ok'} ),
				pretty_date( $x->{'last_time_warning'} ),
				pretty_date( $x->{'last_time_critical'} ),
				pretty_date( $x->{'last_time_unknown'} ),
			);
		}
		else {
			printf(
				"%-16s : o %s   d %s   u %s\n",
				'Last State Times',
				pretty_date( $x->{'last_time_up'} ),
				pretty_date( $x->{'last_time_down'} ),
				pretty_date( $x->{'last_time_unreachable'} ),
			);
		}
		printf( $format, 'In Downtime', 'FIXME' );
		printf( $format,
			'Active Checks',
			pretty_yesno( $x->{'active_checks_enabled'} ),
		);
		printf( $format,
			'Passive Checks',
			pretty_yesno( $x->{'passive_checks_enabled'} ),
		);
		printf( $format,
			'Obsessing',
			pretty_yesno(
				  $x->{'service_description'}
				? $x->{'obsess_over_service'}
				: $x->{'obsess_over_host'}
			),
		);
		printf( $format,
			'Notifications', pretty_yesno( $x->{'notifications_enabled'} ),
		);
		printf( $format,
			'Event Handler',
			pretty_yesno( $x->{'event_handler_enabled'} ),
		);
		printf( $format,
			'Flap Detection',
			pretty_yesno( $x->{'flap_detection_enabled'} ),
		);
	}
}

sub display_service {
	my ( $s, $tab ) = @_;

	my $v      = $verbosity;
	my $flags  = q{};
	my $format = "%-16s : %s\n";
	my $n_width;

	if ( $v < 3 ) {

		$n_width = 20 + 8 + 2;
		if ($tab) {
			$n_width += 8;
		}

		printf( '%-20.20s', $s->{service_description} );

		if ( $v >= 2 ) {
			$n_width += 5;

			if ( $s->{'problem_has_been_acknowledged'} ) {
				$flags .= 'A';
			}
			if ( $s->{'is_flapping'} ) {
				$flags .= 'F';
			}
			if ( $s->{'notifications_enabled'} == 0 ) {
				$flags .= 'N';
			}
			if (    $s->{'active_checks_enabled'} == 0
				and $s->{'passive_checks_enabled'} == 1 )
			{
				$flags .= 'P';
			}
			if (
				not(   $s->{'active_checks_enabled'}
					or $s->{'passive_checks_enabled'} )
			  )
			{
				$flags .= '!';
			}

			$flags = sprintf( ' %-3s', $flags );
			print with_colour( $flags, 'bold' );
		}

		printf( ' %s', service_state($s) );

		if ( $v >= 2 ) {
			printf( ' %d/%d', $s->{'current_attempt'}, $s->{'max_attempts'} );
			$n_width += 4;
		}

		print ' ';

		print break_str( $s->{plugin_output}, $n_width );

	}
	else {
		display_x_verbose( $s, $format );
	}
	print "\n";

}

sub display_host_services {
	my ( $host, $all ) = @_;
	my @services;
	my $h = $data->{hosts}->{$host};

	@services = grep { filter_service($_) } @{ $data->{'services'}->{$host} };

	if ( $all and @services and $verbosity < 3 ) {

		print "\n$host";

		if ( $h->{'current_state'} ) {
			print q{ };
		}
		if ( $h->{'current_state'} == 1 ) {
			print with_colour( 'DOWN', 'white on_red' );
		}
		elsif ( $h->{'current_state'} == 2 ) {
			print with_colour( 'UNREACHABLE', 'white on_blue' );
		}

		print "\n";
	}

	foreach my $service (@services) {

		if ( $all and $verbosity < 3 ) {
			print "\t";
		}
		elsif ($all) {
			print "\n";
		}

		display_service( $service, $all );
	}
}

sub display_host_single {
	my ($host) = @_;
	my $format = "%-16s : %s\n";
	my $h      = $data->{hosts}->{$host};
	my $v      = $verbosity;

	if ( $v < 3 ) {

		printf( '%-32.32s %s', $h->{host_name}, host_state($h) );

		if ( $v >= 2 ) {
			printf( ' %d/%d', $h->{'current_attempt'}, $h->{'max_attempts'} );
		}

		printf( ' %s', $h->{'plugin_output'} );
	}
	else {
		display_x_verbose( $h, $format );
	}
	print "\n";

}

sub display_host {
	my ( $host, $all ) = @_;

	if ( $list_type eq 'h' ) {
		display_host_single($host);
	}
	else {
		display_host_services( $host, $all );
	}
}

sub display_host_overview {
	my ($host) = @_;
	my ( $ok, $warn, $crit, $unk, $pend ) = (0) x 5;
	my $h = $data->{hosts}->{$host};

	my @services = grep { filter_service($_) } @{ $data->{services}->{$host} };

	for my $s (@services) {
		if ( $s->{has_been_checked} == 0 ) {
			$pend++;
		}
		else {
			given ( $s->{current_state} ) {
				when (0) { $ok++ }
				when (1) { $warn++ }
				when (2) { $crit++ }
				when (3) { $unk++ }
			}
		}
	}

	printf( '%-32.32s %s', $h->{host_name}, host_state($h) );

	printf(
		'  %s  %s  %s  %s  %s',
		pretty_state( $ok,   'ok' ),
		pretty_state( $warn, 'warning' ),
		pretty_state( $crit, 'critical' ),
		pretty_state( $unk,  'unknown' ),
		pretty_state( $pend, 'pending' ),
	);

	print "\n";
}

sub display_overview {
	my ( $h_ok, $h_d, $h_u, $h_p, $s_ok, $s_w, $s_c, $s_u, $s_p ) = (0) x 9;

	for my $h (@list_hosts) {
		if ( $data->{hosts}{$h}{has_been_checked} == 0 ) {
			$h_p++;
		}
		else {
			given ( $data->{hosts}{$h}{current_state} ) {
				when (0) { $h_ok++ }
				when (1) { $h_d++ }
				when (2) { $h_u++ }
			}
		}
		for my $s ( grep { filter_service($_) } @{ $data->{services}{$h} } ) {
			if ( $s->{has_been_checked} == 0 ) {
				$s_p++;
			}
			else {
				given ( $s->{current_state} ) {
					when (0) { $s_ok++ }
					when (1) { $s_w++ }
					when (2) { $s_c++ }
					when (3) { $s_u++ }
				}
			}
		}
	}

	printf( "%-16.16s  %4s\n", 'total hosts', $h_ok + $h_d + $h_u );
	printf( "%-16.16s  %s\n", 'up', pretty_state( $h_ok, 'ok' ) );
	printf( "%-16.16s  %s\n", 'down', pretty_state( $h_d, 'critical' ) );
	printf( "%-16.16s  %s\n", 'unreachable', pretty_state( $h_u, 'unknown' ) );
	printf( "%-16.16s  %s\n", 'pending',     pretty_state( $h_p, 'pending' ) );
	print "\n";
	printf( "%-16.16s  %4s\n", 'total services', $s_ok + $s_w + $s_c + $s_u );
	printf( "%-16.16s  %s\n", 'ok', pretty_state( $s_ok, 'ok' ) );
	printf( "%-16.16s  %s\n", 'warning', pretty_state( $s_w, 'warning' ) );
	printf( "%-16.16s  %s\n", 'critical', pretty_state( $s_c, 'critical' ) );
	printf( "%-16.16s  %s\n", 'unknown',  pretty_state( $s_u, 'unknown' ) );
	printf( "%-16.16s  %s\n", 'pending',  pretty_state( $s_p, 'pending' ) );
}

sub dispatch_command {
	my $str = join( ';', @_ );

	open( my $cmd_fh, '>', $rw_file )
	  or die( "Failed to open icinga command file ($rw_file): $!\n"
		  . "Set --rw-file to change it\n" );
	printf $cmd_fh ( '[%d] %s', time(), $str, );
	close($cmd_fh)
	  or warn("Failed to close $rw_file: $!\n");
}

sub action_on_host {
	my ($host) = @_;

	given ($action) {
		when ('downtime') {
			my ( $start, $end, $duration, $comment, @opts ) = @action_args;
			my $strp = DateTime::Format::Strptime->new(
				pattern   => '%Y-%m-%dT%H:%M:%S',
				time_zone => 'Europe/Berlin',       # TODO read from system
			);

			my $dt_start = $strp->parse_datetime($start);
			my $dt_end   = $strp->parse_datetime($end);
			my $fixed    = $duration ? 0 : 1;
			my $command  = 'SCHEDULE_HOST_DOWNTIME';
			my $addendum = q{};

			$duration *= 3600;

			if ( 'children' ~~ \@opts ) {
				$command  = 'SCHEDULE_AND_PROPAGATE_HOST_DOWNTIME';
				$addendum = ' and its children';
			}
			if ( 'trigger_children' ~~ \@opts ) {
				$command  = 'SCHEDULE_AND_PROPAGATE_TRIGGERED_HOST_DOWNTIME';
				$addendum = ' and its children (triggered)';
			}

			dispatch_command( $command, $host, $dt_start->epoch, $dt_end->epoch,
				$fixed, 0, $duration, 'cli', $comment );
			say "Scheduled host downtime for '$host'$addendum";
		}
		when ('recheck') {
			dispatch_command( 'SCHEDULE_HOST_SVC_CHECKS', $host, time() );
			say "Scheduled check of * on '$host'";
		}
		when ('force_recheck') {
			dispatch_command( 'SCHEDULE_FORCED_HOST_SVC_CHECKS', $host,
				time() );
			say "Scheduled forced check of * on '$host'";
		}
		default {
			say STDERR "Cannot run action '${action}' on a host"
		}
	}
}

sub action_on_service {
	my ( $host, $service ) = @_;

	if ( not have_service( $host, $service ) ) {
		return;
	}

	given ($action) {
		when ('downtime') {
			my ( $start, $end, $duration, $comment, @opts ) = @action_args;
			my $strp = DateTime::Format::Strptime->new(
				pattern   => '%Y-%m-%dT%H:%M:%S',
				time_zone => 'Europe/Berlin',       # TODO read from system
			);

			my $dt_start = $strp->parse_datetime($start);
			my $dt_end   = $strp->parse_datetime($end);
			my $fixed    = $duration ? 0 : 1;

			$duration *= 3600;

			dispatch_command( 'SCHEDULE_SVC_DOWNTIME', $host, $service,
				$dt_start->epoch, $dt_end->epoch,
				$fixed, 0, $duration, 'cli', $comment );
			say "Scheduled service downtime for '$service' on '$host'";
		}
		when ('recheck') {
			dispatch_command( 'SCHEDULE_SVC_CHECK', $host, $service, time() );
			say "Scheduled check of '$service' on '$host'";
		}
		when ('force_recheck') {
			dispatch_command( 'SCHEDULE_FORCED_SVC_CHECK', $host, $service,
				time() );
			say "Scheduled forced check of '$service' on '$host'";
		}
		when ('Acknowledge') {
			dispatch_command( 'ACKNOWLEDGE_SVC_PROBLEM', $host, $service, 2, 1,
				1, 'cli', $action_args[0] );
			say "Acknowledged $host/$service: $action_args[0]";
		}
		default {
			say STDERR "Cannot run action '${action}' on a service"
		}
	}
}

GetOptions(
	'a|action=s'      => \$action,
	'c|config=s'      => \$config_file,
	'C|no-colours'    => sub { $colours = 0 },
	'f|status-file=s' => \$status_file,
	'F|rw-file=s'     => \$rw_file,
	'g|hostgroup=s'   => sub { push( @for_groups, split( /,/, $_[1] ) ) },
	'h|host=s'        => sub { push( @for_hosts, split( /,/, $_[1] ) ) },
	'l|list=s'        => sub { $list_type = substr( $_[1], 0, 1 ) },
	'm|match=s' => sub { $match_output = qr{$_[1]}i },
	'o|overview'     => \$overview,
	's|service=s'    => sub { push( @for_services, split( /,/, $_[1] ) ) },
	'U|as-contact=s' => \$as_contact,
	'v|verbose+'     => \$verbosity,
	'V|version' => sub { say "icli version $VERSION"; exit 0 },
	'x|cut-mode=s' => sub { $cut_mode = substr( $_[1], 0, 1 ) },
	'z|filter=s' => sub { push( @filters, split( /,/, $_[1] ) ) },
) or die("Please see perldoc -F $0 for help\n");

read_objects( $status_file, \$data, 'icinga status_file', '--status-file' );
read_objects( $config_file, \$config, 'icinga object_cache_file', '--config' );
enhance_status();
parse_action();
compute_hostlist();

if ($overview) {
	if ( $list_type eq 'h' ) {
		for my $host (@list_hosts) {
			display_host_overview($host);
		}
	}
	else {
		display_overview();
	}
}
elsif ( $list_type ~~ [qw[s h]] ) {
	for my $host (@list_hosts) {
		display_host( $host, ( @list_hosts > 1 ) );
	}
}
elsif ( $list_type eq 'q' ) {
	display_queue();
}
elsif ( $list_type eq 'd' ) {
	foreach my $downtime ( @{ $data->{hostdowntimes} } ) {
		display_downtime($downtime);
	}
}
elsif ($action) {

	foreach my $host (@list_hosts) {
		if ( not @list_services and not @filters ) {
			action_on_host($host);
		}
		elsif ( not @list_services and @filters ) {
			foreach my $service ( grep { filter_service($_) }
				@{ $data->{'services'}->{$host} } )
			{
				action_on_service( $host, $service->{'service_description'} );
			}
		}
		else {
			foreach my $service (@list_services) {
				action_on_service( $host, $service );
			}
		}
	}
}
else {
	die("See perldoc -F $0\n");
}

__END__

=head1 NAME

B<icli> - Icinga Command Line Interface

=head1 SYNOPSIS

B<icli> [B<-v>|B<-vv>] [B<-z> I<filter>] [B<-h> I<hosts>] [B<-g> I<hostgroups>]
[B<-s> I<services>] [B<-c> I<config>] [B<-C>] [B<-f> I<status-file>]
[B<-F> I<rw-file>] [B<-r>|B<-u>|B<-lh>|B<-ls>|B<-lq>|B<-ld>]
[I<host>/I<service> I<...>]

=head1 VERSION

version 0.47

=head1 DESCRIPTION

B<icli> is a command line interface to B<Icinga>. By default it lists all
services and their states.

Note that when supplying custom config and status file paths, B<icli> also
works with B<Nagios>.  100% compatibility is not guaranteed, however.

B<icli> only works when executed on the host running the B<Icinga> daemon.  To
use it on another host, shell aliases (like C<< alias icli='ssh $icingahost
icli' >>) or similar are recommended.

You can narrow down the list of services you want displayed either using
B<filters> (like C<< icli -z!o >>), the B<-h>/B<-s> arguments (C<< icli -h
aneurysm -s Libraries,Websites >>) or commandline args (C<< icli
aneurysm/{Libraries,Websites} >> with shell expansion).

=head1 OPTIONS

=over

=item B<-a>|B<--action> I<action>[:I<args>]

Run I<action> on all matching hosts or services. I<args> is a comma-separated
list of action arguments and depends on the action in question. I<action> may
also be a one or two letter shortcut.

The following actions are supported:

=over

=item a|acknowledge I<comment>

Acknowledge service problems with string I<comment>. This creates a sticky
acknwoledgment with notification and no expire time. The comment will not be
persistent.

Note: Acknowledgement of host problems is not yet supported.

=item d|downtime I<start>,I<stop>,I<duration>,I<comment>[,I<opts>]

Schedule a non-triggered host or service (depending on the filter arguments)
downtime.  I<start> and I<stop> are timestamps and must be formatted as
YYYY-MM-DDTHH:MM:SS, where the "T" is literal. At this moment, they are always
interpreted in the Europe/Berlin timezone, this will change in the future.

If I<duration> is 0 (zero), a fixed downtime between I<start> and I<stop>
is scheduled. Otherwise, a flexible downtime which will start between
I<start> and I<stop> and last I<duration> hours is scheduled. I<duration>
may be a float.

If a host is selected and I<opts> contains "children", a downtime for all of
its children will be scheduled with the same parameters as the host's.
Likewise, if I<opts> contains "trigger_children", a triggered downtime for all
of the host's children will be scheduled.

I<comment> refers to the downtime's comment field and must not contain the
"," (comma) character.

=item r|recheck

Schedule an immediate recheck

=item R|force_recheck

Schedule a forced, immediate recheck

=back

=item B<-c>|B<--config> I<config>

Read config from I<file>

=item B<-C>|B<--no-colours>

Disable colours in output

=item B<-f>|B<--status-file> I<file>

Read the status from I<file>

=item B<-F>|B<--rw-file> I<file>

Use I<file> as external commands file.

=item B<-g>|B<--hostgroup> I<hostgroup>

Limit selection to hosts in I<hostgroup> (comma separated list)

=item B<-h>|B<--host> I<hosts>

Limit selection to I<hosts> (comma separated list)

=item B<-l>|B<--list> B<downtimes>|B<hosts>|B<services>|B<queue>

List either services (the default) or hosts.
Note that only the first character of the argument is checked, so C<< icli
-lh >>, C<< icli -ls >> etc. are also fine.

=item B<-m>|B<--match> I<regex>

Limit selection to hosts/services whose plugin output matches
I<regex> (perl regular expression, case insensitive. see L<perlre>).

=item B<-o>|B<--overview>

Display "tactical overview"-style overview.
By default (or when used with C<< -ls >>) the number of all hosts and services
(both total and divided by their state) is shown.

When used with C<< -lh >>, lists all hosts with the number of ok / warning /
... checks on each host.

=item B<-U>|B<--as-contact> I<name>

Only operate on service visible to I<name>. Doesn't work for B<-lh> yet,
most useful for B<-ls>.

NOTE: This is meant to help find out which services a user has access to. It is
NOT intended as a way to restrict access and should never be used that way.

=item B<-s>|B<--service> I<services>

Limit selection to I<services> (comma separated lists).  Can be combined with
B<-h>/B<-g> to further narrow down the selection, but may also be used
stand-alone.

=item B<-v>|B<--verbose>

Increase output verbosity.  Can be combined up to B<-vvv>

=item B<-V>|B<--version>

Show version information

=item B<-x>|B<--cut-mode> I<mode>

What to do with lines which are too long for the terminal: B<n>othing, B<c>ut
off, line B<b>reak (with proper indentation).  The default is line B<b>reaks

=item B<-z>|B<--filter> I<expression>

Limit selection to hosts/services passing the filter.  I<expression> is a comma
separated list of filters, only hosts/services to which all filters apply are
selected.  See also L</"FILTER EXPRESSIONS">

=back

=head1 OUTPUT

=head2 SERVICE LISTING

This is the standard output method. It contains the following:

=over

=item * Service description

=item * -v: Service Flags (B<A>cknowledged, B<F>lapping, B<P>assive, B<!>no
checks)

=item * Service state (ok / warning / critical / unknown)

=item * -v: Current attempt / Max attempts

=item * Plugin output

=back

=head2 HOST LISTING

Enabled with -ld

=over

=item * Host name

=item * Host state (ok / down / unreachable)

=item * -v: Current attempt / Max attempts

=item * Plugin output

=back

=head2 QUEUE LISTING

Enabled with -lq

=over

=item * Host name

=item * Service name

=item * Last check

=item * Next check

=back

=head1 FILTER EXPRESSIONS

Each expression can be negated with an exclamation mark, e.g. "!A" for all
non-acknowledged services.

=over

=item B<A>

Check state has been acknowledged

=item B<D>

The host this service belongs to is Down or Unreachable

=item B<F>

Service is flapping between states

=item B<N>

Notifications for this service are disabled

=item B<P>

Only passive checks are enabled.  Note that B<!P> simply means that active
checks are enabled, no matter the status of passive checks

=item B<S>

Check state is soft.  For instance, it used to be OK and is now critical, but
has not reached its maximum number and caused a notification yet.  Good to
find (or ignore) service problems which might just be temporary, non-critical
glitches.

=item B<o>

Host/Service state is OK

=item B<w>

Service state is Warning

=item B<c>

Service state is Critical

=item B<u>

Service state is Unknown

=item B<p>

Host or service state is Pending

=item B<d>

Host state is Down

=item B<x>

Host state is Unreachable

=back

=head1 EXIT STATUS

Zero, unless errors occured.

=head1 CONFIGURATION

None.

=head1 DEPENDENCIES

=over

=item * autodie (included with perl >= 5.10.1)

=item * DateTime

=item * DateTime::Format::Strptime

=item * Term::Size

=back

=head1 BUGS AND LIMITATIONS

When scheduling a downtime, the start and stop times are always interpreted
in the Europe/Berlin timezone. Also, the duration parameter is always
interpreted in hours.

It is probably not clear from the documentation when an action will operate
on hosts and when on services.

Note that this software is not yet stable. Command line options may be changed
/ removed and thus break backwards compatibility at any time.

=head2 REPORTING BUGS

Either via mail to E<lt>derf@finalrewind.orgE<gt> or on
E<lt>http://github.com/derf/icinga-cli/issuesE<gt>.

=head1 EXAMPLES

=over

=item C<< icli -r -s 'APT Updates' >>

Schedule a check of the "APT Updates" service on all hosts having it

=item C<< icli -lq -h aneurysm -g chaosdorf-hosts >>

List check queue for all hosts in the hostgroup "chaosdorf-hosts", plus the
host aneurysm

=item C<< icli -z!o,!A,!S,!D >>

Show all service problems which are already hard states and have not yet been
acknowledged.  Also weed out problem services on hosts which are down anyways

=back

=head1 AUTHOR

Copyright (C) 2010 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt>

=head1 LICENSE

  0. You just DO WHAT THE FUCK YOU WANT TO.