#!/usr/bin/env perl

=head1 NAME

tstatd - Logs real-time accounting daemon

=cut

use strict;
use warnings qw(all);

use Cwd qw(getcwd realpath);
use Data::Dumper;
use DateTime;
use File::Basename qw(fileparse);
use FindBin;
use Getopt::Long qw(:config no_auto_abbrev bundling);
use JSON::XS;
use List::Util qw(min);
use Log::Dispatch;
use Log::Dispatch::File;
use Log::Dispatch::Screen;
use Log::Dispatch::Syslog;
use Pid::File::Flock;
use POE qw(Wheel::FollowTail Wheel::ListenAccept Wheel::ReadWrite);
use POSIX qw(setsid setuid strftime);
use Socket;
use Tail::Stat;
use Tie::Hash::Indexed;

# parse command line
my %opts;
GetOptions(\%opts, qw/
	agregate-zone|a=s
	basename
	database-file|b=s
	change-dir|c=s
	debug|d
	foreground|f
	log-facility=s
	log-file=s
	log-level=s
	expand-period|e=i
	help|h
	identity|i=s
	listen|l=s
	windows-num|n=i
	multiple
	options|o=s
	override-from=s@
	parse-error=s
	pid-file|p=s
	regex|r=s
	regex-from=s
	timer=s@
	store-period|s=i
	user|u=s
	version|v
	window-size|w=i
/) or die usage();

# explicitly requested help
die usage() if $opts{help};

# version requested
print version() and exit if $opts{version};

# no arguments
die usage() if @ARGV < 2;

# try to load requested plugin
my $pname  = shift @ARGV;
my $pclass = "Tail::Stat::Plugin::$pname";
eval "require $pclass" or die "can't load plugin '$pname': $@\n";


# parameters defaults & validation
if (exists $opts{'agregate-zone'}) {
	die "invalid zone: '$opts{'agregate-zone'}'\n"
		if $opts{'agregate-zone'} =~ /[^a-z0-9_-]/;
}

if (exists $opts{identity}) {
	die "invalid identity: '$opts{identity}'\n" if $opts{identity} =~ /[^\w]/;
}

$opts{'database-file'} ||= $FindBin::RealScript.($opts{identity} ? '-'.$opts{identity} : '').'.db';
$opts{'database-file'} = realpath $opts{'database-file'};

if (exists $opts{'change-dir'}) {
	die "no such directory: '$opts{'change-dir'}'\n"
		unless -d $opts{'change-dir'};
}

$opts{'log-facility'} ||= 'daemon';
die "invalid log facility: '$opts{'log-facility'}'\n"
	unless $opts{'log-facility'} =~ /^(auth|authpriv|cron|daemon|kern|local0 through local7|mail|news|syslog|user|uucp)$/;

$opts{'log-level'} ||= 'notice';
die "invalid log level: '$opts{'log-level'}'\n"
	unless $opts{'log-level'} =~ /^(debug|info|notice|warning|error|critical|alert|emergency)$/;

if ($opts{debug}) {
	$opts{'log-level'} = 'debug';
	delete $opts{'log-file'};
	$opts{foreground}  = 1;
}

$opts{'log-file'} = realpath $opts{'log-file'} if exists $opts{'log-file'};

$opts{'expand-period'} = 60 unless exists $opts{'expand-period'};
die "invalid expand period: '$opts{'expand-period'}'\n"
	if $opts{'expand-period'} =~ /[^\d]/;

$opts{'listen'} ||= '127.0.0.1:3638';

$opts{'windows-num'} = 60  unless exists $opts{'windows-num'};
die "invalid windows number: '$opts{'windows-num'}'\n"
	if $opts{'windows-num'} =~ /[^\d]/;

$opts{'store-period'} = 10 unless exists $opts{'store-period'};
die "invalid store period: '$opts{'store-period'}'\n"
	if $opts{'store-period'} =~ /[^\d]/;

$opts{'window-size'} = 10 unless exists $opts{'window-size'};
die "invalid window size: '$opts{'window-size'}'\n"
	if $opts{'window-size'} =~ /[^\d]/;

$opts{'parse-error'} ||= $pclass->parse_error;
die "invalid parse error: '$opts{'parse-error'}'\n"
	unless $opts{'parse-error'} =~ /^(debug|info|none|notice|warning|error|critical|alert|emergency)$/;

$opts{'pid-file'} ||= $FindBin::RealScript.($opts{identity} ? '-'.$opts{identity} : '').'.pid';
$opts{'pid-file'} = realpath $opts{'pid-file'};

if (exists $opts{'regex-from'}) {
	die "options regex and regex-from are mutually exclusive\n"
		if exists $opts{regex};
	local $/;
	open FH, $opts{'regex-from'} or
		die "can't read regex: $!\n";
	$opts{regex} = <FH>;
}

# loading overrides
for ( @{ $opts{'override-from'} } ) {
	local $/;
	open FH, $_ or
		die "can't read override from '$_': $!\n";
	eval "package $pclass; use strict; use warnings qw(all); ".<FH>;
	die "can't apply overrides from '$_': $@\n" if $@;
}

defined (my $uid = $opts{'user'} ? getpwnam($opts{'user'}) : $>) or
	die "unknown user: $opts{'user'}\n";

# grouping log files by zones, order does matter
# due to support '--multiple' option
my %zones;
tie %zones, 'Tie::Hash::Indexed';
for (@ARGV) {
	/^([\w\d\_-]+):(.+)/ && do {
		push @{$zones{$1}}, $2;
		next;
	};
	push @{$zones{
		$opts{'agregate-zone'} ||
		( $opts{basename} ? fileparse($_,qr/\.[^\.]+/) : $_ )
	}}, $_;
}

# parsing timers
my %timers;
my %units = (
	w => [ 'week',   7 * 86_400 ],
	d => [ 'day',    86_400 ],
	h => [ 'hour',   3_600 ],
	m => [ 'minute', 60 ],
	s => [ 'second', 1 ],
);
for (@{ $opts{timer} }) {
	my ($z,$n,$p,$u) = /^(\S+):(\S+):(\d+)(w|d|h|m|s)?$/ or
		die "invalid timer format: $_\n";
	die "no such zone '$z' for timer '$_'\n" unless exists $zones{$z};
	die "zone '$z' already has timer '$n'\n" if exists $timers{$z}{$n};

	$u ||= 's';
	$timers{$z}{$n} = [ $p * $units{$u}[1], $units{$u}[0] ];
}

# listen socket
my $sock = IO::Socket::INET->new(
	(
		$opts{'listen'} =~ /:/ ?
		( LocalAddr => $opts{'listen'} ) :
		( LocalPort => $opts{'listen'} )
	),
	Listen    => SOMAXCONN,
	ReuseAddr => 1,
) or die "can't create listen socket: $!\n";

# set process privileges
setuid $uid or die "can't setuid to $opts{'user'}: $!\n" unless $uid == $>;

# set process title
$0 = $FindBin::RealScript.': '.$pname.($opts{identity} ? ' ['.$opts{identity}.']' : '');

# fork
unless ($opts{foreground}) {
	defined(my $pid = fork) or die "can't fork: $!\n";
	exit if $pid;
}

# protecting against second instance running
Pid::File::Flock->new($opts{'pid-file'}) unless $opts{foreground};

# daemonize
unless ($opts{foreground}) {
	chdir '/' or die "can't chdir: $!\n";
	die "can't create new session: $!\n" if setsid == -1;
	open STDIN,  '</dev/null' or die "can't close stdin\n";
	open STDOUT, '>/dev/null' or die "can't close stdout\n";
	open STDERR, '>/dev/null' or die "can't close stderr\n";
}

# logger
(my $log = Log::Dispatch->new)->add(logger());
$log->notice("starting up");

# catch perl warnings
$SIG{__WARN__} = sub { $log->warning(@_) };

# main POE session
POE::Session->create(
	inline_states => {

		# initializing
		_start => sub {
			$log->debug("initializing POE session");

			# talk POE kernel adjust to the new situation
			$_[KERNEL]->has_forked unless $opts{foreground};

			# signals
			$log->debug("setting up signal handlers");
			$_[KERNEL]->sig(HUP  => 'hangup');
			$_[KERNEL]->sig(INT  => 'interrupt');
			$_[KERNEL]->sig(TERM => 'terminate');
			$_[KERNEL]->sig(USR1 => 'rotate');

			# statistics server
			$log->debug("creating TCP server");
			$_[HEAP]->{server} = POE::Wheel::ListenAccept->new(
				Handle      => $sock,
				AcceptEvent => 'server_accept',
				ErrorEvent  => 'server_error',
			);

			# serializer
			$log->debug("creating serializer");
			$_[HEAP]->{serial} = JSON::XS->new->pretty;

			# creating plugin instance
			my %popts;
			for (split /,/, $opts{options} || '') {
				my ($k,$v) = split /=/;
				$popts{$k} = $v // 1;
			}
			$popts{regex} = $opts{regex} if exists $opts{regex};
			$_[HEAP]->{plugin} = $pclass->new(%popts);

			# setting up zones
			$_[HEAP]->{zones} = \%zones;

			# load previous data
			if (-f $opts{'database-file'}) {
				$_[KERNEL]->call($_[SESSION], 'do_load') or return;
			}

			# create insufficient references
			for (keys %zones) {
				$_[HEAP]->{data}{$_}{public}     ||= {};
				$_[HEAP]->{data}{$_}{private}    ||= {};
				$_[HEAP]->{data}{$_}{windows}    ||= [];
				$_[HEAP]->{data}{$_}{windows}[0] ||= {};

				# call plugin initialization code
				$_[HEAP]->{plugin}->init_zone(
					$_,
					$_[HEAP]->{data}{$_}{public},
					$_[HEAP]->{data}{$_}{private},
					$_[HEAP]->{data}{$_}{windows}[0],
				);
			}

			# expanding zones wildcards
			$_[KERNEL]->call($_[SESSION], 'do_expand');

			# creating named timers
			$_[HEAP]->{timers} = \%timers;
			for my $z ( keys %{ $_[HEAP]->{timers} } ) {
				for my $n ( keys %{ $_[HEAP]->{timers}{$z} } ) {
					$_[KERNEL]->call($_[SESSION], 'set_timer', $z, $n);
				}
			}

			# schedule save task
			if ($opts{'store-period'}) {
				$log->debug("scheduling saving heartbeat at $opts{'store-period'} second(s)");
				$_[KERNEL]->delay( save_heartbeat => $opts{'store-period'} );
			}

			# schedule expanding wildcards
			if ($opts{'expand-period'}) {
				$log->debug("scheduling expanding heartbeat at $opts{'expand-period'} second(s)");
				$_[KERNEL]->delay( expand_heartbeat => $opts{'expand-period'} );
			}

			# schedule windows heartbeat
			if ($opts{'window-size'} && $opts{'windows-num'}) {
				$log->debug("scheduling windows heartbeat at $opts{'window-size'} second(s)");
				$_[KERNEL]->delay( windows_heartbeat => $opts{'window-size'} );
			}
		},

		# expanding task
		expand_heartbeat => sub {
			$log->debug("wildcards expanding heartbeat occurred");

			# expanding zones wildcards
			$_[KERNEL]->call($_[SESSION], 'do_expand');

			# schedule next call
			if ($opts{'expand-period'}) {
				$log->debug("scheduling expanding heartbeat at $opts{'expand-period'} second(s)");
				$_[KERNEL]->delay( expand_heartbeat => $opts{'expand-period'} );
			}
		},

		# setting named timer
		set_timer => sub {
			my $t = $_[HEAP]->{timers}{$_[ARG0]}{$_[ARG1]};
			my $next = DateTime->now(
				time_zone => 'local'
			)->add(
				seconds => $t->[0]
			)->truncate(
				to => $t->[1]
			);
			$log->debug("setting named timer '$_[ARG1]' for zone '$_[ARG0] at '".$next->strftime('%Y-%m-%d %H:%M:%S')."'");
			$_[KERNEL]->alarm_set( named_timer => $next->epoch, $_[ARG0], $_[ARG1] );
		},

		# named timer handler
		named_timer => sub {
			$log->debug("processing named timer '$_[ARG1]' for zone '$_[ARG0]");
			$_[HEAP]->{plugin}->process_timer(
				$_[ARG1],
				$_[HEAP]->{data}{$_[ARG0]}{public},
				$_[HEAP]->{data}{$_[ARG0]}{private},
				$_[HEAP]->{data}{$_[ARG0]}{windows}
			) ? do {
				$log->debug("renewing timer '$_[ARG1]' for zone '$_[ARG0]");
				$_[KERNEL]->call($_[SESSION], 'set_timer', $_[ARG0], $_[ARG1]);
			} : do {
				$log->debug("clearing timer '$_[ARG1]' for zone '$_[ARG0]'");
			};
		},

		# expanding wildcards
		do_expand => sub {
			$log->debug("begin expanding wildcards");

			my $cwd = getcwd;
			if ($opts{'change-dir'}) {
				chdir $opts{'change-dir'} or
					$log->warning("can't change directory to '$opts{'change-dir'}'");
			}

			my %exif;  # existing files
			for my $zone ( keys %{ $_[HEAP]->{zones} } ) {
				my @files;
				push @files, map { realpath $_ } grep { -f } glob $_
					for @{ $_[HEAP]->{zones}{$zone} };
				$log->debug("found ".scalar(@files)." file(s) in zone '$zone'");

				# create missing watchers
				FILE:
				for my $f (@files) {
					$exif{$f}++;

					# searching for already monitored file
					for my $w ( values %{ $_[HEAP]->{watchers} } ) {
						next unless $f eq $w->[0];

						unless ($opts{multiple}) {
							$log->debug("file '$f' already monitored for zone '$zone', ignoring");
							next FILE;
						}

						# searching for already subscribed zone
						for my $z ( @{ $w->[1] } ) {
							next unless $z eq $zone;
							$log->debug("zone already subscribed for '$f'");
							next FILE;
						}

						# subscribe to existing watcher
						push @{ $w->[1] }, $zone;
						$log->debug("zone subscribed for '$f'");
						next FILE;
					}

					# create new watcher and subscribe zone
					my $w = POE::Wheel::FollowTail->new(
						Filename   => $f,
						Filter     => POE::Filter::Line->new( InputLiteral => "\n" ),
						ErrorEvent => 'watcher_err',
						InputEvent => 'watcher_line',
						ResetEvent => 'watcher_roll',
					);
					$log->debug("created new watcher [".$w->ID."] for '$f'");
					$log->debug("zone subscribed for '$f'");
					$_[HEAP]->{watchers}{$w->ID} = [ $f, [ $zone ], $w ];
				}
			}

			# remove excess watchers
			for my $w (values %{ $_[HEAP]->{watchers} } ) {
				next if $exif{$w->[0]};  # file exists

				delete $_[HEAP]->{watchers}{$w->[2]->ID};
				$log->debug("excess watcher [".$w->[2]->ID."] removed for '".$w->[0]."'");
			}

			if ($opts{'change-dir'}) {
				chdir $cwd or
					$log->warning("can't restore directory to '$cwd'");
			}
		},

		# new log line
		watcher_line => sub {
			my $w = $_[HEAP]->{watchers}{$_[ARG1]};
			my @data = $_[HEAP]->{plugin}->process_line($_[ARG0]) or do {
				return $log->log(
					level   => $opts{'parse-error'},
					message => "can't parse: '$_[ARG0]' from '$w->[0]'"
				) unless $opts{'parse-error'} eq 'none';
			};
			# subscribers loop
			for my $z ( @{ $w->[1] } ) {
				$_[HEAP]->{plugin}->process_data(
					\@data,
					$_[HEAP]->{data}{$z}{public},
					$_[HEAP]->{data}{$z}{private},
					$_[HEAP]->{data}{$z}{windows}[0]
				);
			}
		},

		# log rotating occurred
		watcher_roll => sub {
			my $w = $_[HEAP]->{watchers}{$_[ARG0]};
			# clear tail fragment
			$w->[2][ POE::Wheel::FollowTail::SELF_FILTER ][ POE::Filter::Line::FRAMING_BUFFER ] =~ s/[^\n]+\z//
				if $w->[2][ POE::Wheel::FollowTail::SELF_FILTER ][ POE::Filter::Line::FRAMING_BUFFER ];
			$log->info("rolled over '$w->[0]'");
		},

		# log tailing error
		watcher_err => sub {
			my $w = $_[HEAP]->{watchers}{$_[ARG3]};
			$log->error("$_[ARG0] failed ($_[ARG1] during tail '$w->[0]': $_[ARG2]");
		},

		# windows processing
		windows_heartbeat => sub {
			$log->debug("windows heartbeat occurred");

			# schedule windows processing
			for ( keys %{ $_[HEAP]->{zones} } ) {
				$_[KERNEL]->yield( do_window => $_ );
			}

			# schedule next call
			$log->debug("scheduling windows heartbeat at $opts{'window-size'} second(s)");
			$_[KERNEL]->delay( windows_heartbeat => $opts{'window-size'} );
		},

		do_window => sub {
			# windows ring
			my $wins = $_[HEAP]->{data}{$_[ARG0]}{windows};

			# call plugin handler with last complete window
			$_[HEAP]->{plugin}->process_window(
				$_[HEAP]->{data}{$_[ARG0]}{public},
				$_[HEAP]->{data}{$_[ARG0]}{private},
				$wins
			);

			# slide windows
			unshift @$wins, {};
			$#$wins = min $#$wins, $opts{'windows-num'} - 1;
		},

		# periodically task
		save_heartbeat => sub {
			$log->debug("saving heartbeat occurred");

			# save accumulated data
			$_[KERNEL]->call($_[SESSION], 'do_save');

			# schedule next call
			$log->debug("scheduling saving heartbeat at $opts{'store-period'} second(s)");
			$_[KERNEL]->delay( save_heartbeat => $opts{'store-period'} );
		},

		# loading stored data
		do_load => sub {
			$log->debug("loading stored data");
			open FH, $opts{'database-file'} or do {
				$log->error("can't open database file: $!");
				return $_[KERNEL]->call($_[SESSION], 'shutdown');
			};
			local $/;
			my $d = $_[HEAP]->{serial}->decode(<FH>) or do {
				$log->error("can't read database file: $!");
				return $_[KERNEL]->call($_[SESSION], 'shutdown');
			};

			# assign
			$_[HEAP]->{data} = $d->{zones} || {};
		},

		# store accumulated data
		do_save => sub {
			$log->debug("storing accumulated data");
			open FH, '>', $opts{'database-file'}.'~' or do {
				return $log->warning("can't write database file: $!");
			};
			my $d = { zones => $_[HEAP]->{data} || {} };
			print FH $_[HEAP]->{serial}->encode($d);
			close FH;

			if (-f $opts{'database-file'}) {
				unlink $opts{'database-file'} or do {
					return $log->warning("can't remove old database file: $!");
				};
			};
			rename $opts{'database-file'}.'~', $opts{'database-file'} or do {
				return $log->warning("can't rename new database file: $!");
			};
		},

		# new client accepted
		server_accept => sub {
			my ($port,$addr) = sockaddr_in $_[ARG1];
			$log->debug("client accepted from ".inet_ntoa($addr).":$port");
			my $c = POE::Wheel::ReadWrite->new(
				Handle     => $_[ARG0],
				InputEvent => 'client_input',
				ErrorEvent => 'client_error',
			);
			$_[HEAP]->{clients}{$c->ID} = $c;
		},

		# server error occurred
		server_error => sub {
			$log->error("$_[ARG0] failed ($_[ARG1] during serving: $_[ARG2]");
			$_[KERNEL]->call($_[SESSION], 'shutdown');
		},

		# got client command
		client_input => sub {
			$log->debug("got client command: '$_[ARG0]'");
			my $cln = $_[HEAP]->{clients}{$_[ARG1]};

			for ($_[ARG0]) {

				# zones list (active & inactive zones)
				/^\s*zones\s*$/i and do {
					$cln->put(
						map { 'a:'.$_ }
						keys %{ $_[HEAP]->{zones} },
					);
					$cln->put(
						map { 'i:'.$_ }
						grep { ! exists $_[HEAP]->{zones}{$_} }
						keys %{ $_[HEAP]->{data} },
					);
					last;
				};

				# wildcards list (active zones only)
				/^\s*globs\s+(\S+)\s*$/i and do {
					my $z = $_[HEAP]->{zones}{$1} or do {
						$log->warning("invalid client globs query: '$1'");
						$cln->put('no such active zone');
						last;
					};
					$cln->put( sort @{ $z } );
					last;
				};

				# files list (active zones only)
				/^\s*files\s+(\S+)\s*$/i and do {
					$_[HEAP]->{zones}{$1} or do {
						$log->warning("invalid client files query: '$1'");
						$cln->put('no such active zone');
						last;
					};

					my @f;
					for my $w ( values %{ $_[HEAP]->{watchers} } ) {
						for my $z ( @{ $w->[1] } ) {
							next unless $z eq $1;
							push @f, [ $w->[0], $w->[2]->tell, -s $w->[0] ];
							last;
						}
					}
					for ( sort { $a->[0] cmp $b->[0] } @f ) {
						$cln->put( join ':', $_->[1] eq '0 but true' ? 0 : $_->[1], $_->[2], $_->[0] );
					}
					last;
				};

				# zone dump (active & inactive zones)
				/^\s*dump\s+(\S+)\s*$/i and do {
					$_[HEAP]->{zones}{$1} or $_[HEAP]->{data}{$1} or do {
						$log->warning("invalid client dump query: '$1'");
						$cln->put('no such zone');
						last;
					};
					my $wmax = $#{ $_[HEAP]->{data}{$1}{windows} };
					$cln->put( $_[HEAP]->{plugin}->dump_zone( $1,
						$_[HEAP]->{data}{$1}{public},
						$_[HEAP]->{data}{$1}{private},
						[ @{ $_[HEAP]->{data}{$1}{windows} }[1..$wmax] ],
					));
					last;
				};

				# zone statistics (active & inactive zones)
				/^\s*stats\s+(\S+)\s*$/i and do {
					$_[HEAP]->{zones}{$1} or $_[HEAP]->{data}{$1} or do {
						$log->warning("invalid client stats query: '$1'");
						$cln->put('no such zone');
						last;
					};
					my $wmax = $#{ $_[HEAP]->{data}{$1}{windows} };
					$cln->put( $_[HEAP]->{plugin}->stats_zone( $1,
						$_[HEAP]->{data}{$1}{public},
						$_[HEAP]->{data}{$1}{private},
						[ @{ $_[HEAP]->{data}{$1}{windows} }[1..$wmax] ],
					));
					last;
				};

				# remove zone statistics (inactive zones only)
				/^\s*wipe\s+(\S+)\s*$/i and do {
					if ($1 eq '*') {
						for ( keys %{ $_[HEAP]->{data} } ) {
							next if exists $_[HEAP]->{zones}{$_};
							delete $_[HEAP]->{data}{$_};
						}
					} else {
						$_[HEAP]->{data}{$1} or do {
							$log->warning("invalid client wipe query: '$1'");
							$cln->put('no such inactive zone');
							last;
						};
						$_[HEAP]->{zones}{$1} and do {
							$log->warning("invalid client wipe query: '$1'");
							$cln->put('zone is active');
							last;
						};
						delete $_[HEAP]->{data}{$1};
					}
					$cln->put( 'ok' );
					$_[KERNEL]->call($_[SESSION], 'do_save');
					last;
				};


				# disconnect request
				/^\s*quit\s*$/i and do {
					return delete $_[HEAP]->{clients}->{$_[ARG1]};
				};

				# invalid command
				$log->warning("invalid client command: '$_[ARG0]'");
				$_[HEAP]->{clients}{$_[ARG1]}->put('error');
			}

			# force buffer flush
			$_[HEAP]->{clients}{$_[ARG1]}->flush;
			$log->debug("buffer flushed");
		},

		# client errors (disconnect included)
		client_error => sub {
			$_[ARG1] ?
				$log->error("$_[ARG0] ($_[ARG1] from client: $_[ARG2]") :
				$log->debug("client disconnected");
			# drop client connection
			delete $_[HEAP]->{clients}->{$_[ARG3]};
		},

		# got SIGHUP
		hangup => sub {
			$log->notice("got SIGHUP, re-expanging zones wildcards");

			# expanding zones wildcards
			$_[KERNEL]->call($_[SESSION], 'do_expand');

			# keep signal handled
			$_[KERNEL]->sig_handled;
		},

		# got SIGINT
		interrupt => sub {
			$log->notice("got SIGINT, terminating");

			# keep signal handled
			$_[KERNEL]->sig_handled;

			# shutting down
			$_[KERNEL]->call($_[SESSION], 'shutdown');
		},

		# got SIGTERM
		terminate => sub {
			$log->notice("got SIGTERM, terminating");

			# shutting down
			$_[KERNEL]->call($_[SESSION], 'shutdown');

			# keep signal handled
			$_[KERNEL]->sig_handled;
		},

		# got SIGUSR1
		rotate => sub {
			$log->notice("got SIGUSR1, re-opening log file");

			# drop & create logger
			$log->remove('main');
			$log->add(logger());

			# keep signal handled
			$_[KERNEL]->sig_handled;
		},

		# graceful exit
		shutdown => sub {
			$log->debug("gracefully shutting down");

			# store statistics
			$_[KERNEL]->call($_[SESSION], 'do_save');

			# drop timers
			$log->debug("removing alarms");
			$_[KERNEL]->alarm_remove_all;

			# drop server
			$log->debug("shutting down server");
			delete $_[HEAP]->{server};

			# drop clients
			$log->debug("disconnecting clients");
			delete $_[HEAP]->{clients}{$_} for keys %{ $_[HEAP]->{clients} };

			# drop watchers
			$log->debug("shutting down watchers");
			for (values %{ $_[HEAP]->{watchers} }) {
				delete $_[HEAP]->{watchers}{$_->[2]->ID};
				$log->debug("shutdown watcher [".$_->[2]->ID."] for '$_->[0]'");
			}
		},
	},
);


# go!
POE::Kernel->run;

$log->notice("exit");

# log object create
sub logger {
	return Log::Dispatch::Screen->new(
		name      => 'main',
		callbacks => [ \&pfmt, \&lfmt, \&dfmt ],
		min_level => $opts{'log-level'},
		stderr    => 1
	) if $opts{foreground};

	return Log::Dispatch::File->new(
		name      => 'main',
		callbacks => [ \&pfmt, \&lfmt, \&dfmt ],
		min_level => $opts{'log-level'},
		filename  => $opts{'log-file'},
		mode      => '>>'
	) if $opts{'log-file'};

	return Log::Dispatch::Syslog->new(
		name      => 'main',
		callbacks => [ \&pfmt, ],
		min_level => $opts{'log-level'},
		facility  => $opts{'log-facility'},
		ident     => $FindBin::RealScript.($opts{identity} ? '-'.$opts{identity} : '' )
	);
};

# log formatting routines
sub pfmt {
	my %m = @_;
	sprintf "$$: %s\n", $m{message};
}
sub lfmt {
	my %m = @_;
	sprintf "[%s] %s", $m{level}, $m{message};
}
sub dfmt {
	my %m = @_;
	sprintf "%s %s", strftime("%Y/%m/%d %H:%M:%S",localtime), $m{message};
}

sub usage {
	<<EOM;

Usage: $FindBin::RealScript [ options ] plugin [zone1:]wildcard1 .. [zoneN:]wildcardN

See list of supported plugins.

Options:
    -a, --agregate-zone=ZONE     agregating anonymous logs to zone
    -b, --database-file=FILE     persistent database file
        --basename               create anonymous zones from base name of log files
    -c, --change-dir=DIR         change directory before wildards expanding
    -d, --debug                  implies: --foreground --log-level=debug
    -f, --foreground             no detach, logging to stderr
        --log-facility=NAME      set facility for syslog logging
        --log-level=LEVEL        minimum logging level
        --log-file=FILE          logging to file instead syslog
    -e, --expand-period=SECONDS  zones wildcard expand period
    -h, --help                   show this help message
    -i, --identity=STRING        add string to process title, default pid-file,
                                 default database-file and syslog ident
    -l, --listen=[ADDR:]PORT     TCP statistic server listen socket
        --multiple               log includes in all expanded wildcard
    -n, --windows-num=NUM        number of sliding windows (default 60)
    -o, --options=STRING         comma-separated plugin supported options
                                 (like a mount (8) options)
        --override-from=FILE     load overriding methods from file
    -p, --pid-file=FILE          pid file path
        --parse-error=LEVEL      logging level for unparsed lines
    -r, --regex=PATTERN          override plugin regular expression
        --regex-from=FILE        read regular expression from file
    -s, --store-period=SECONDS   data store period (default 60)
        --timer=NAME:PERIOD      add named timer with fixed period
    -u, --user=LOGIN             change effective process uid to
    -v, --version                print version and exit
    -w, --window-size=SECONDS    size of one sliding window (default 10)

EOM
}

sub version {
	<<EOM;

$FindBin::RealScript version $Tail::Stat::VERSION

Copyright (C) 2010 Oleg A. Mamontov

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

EOM
}

