package ACheck::Common;


use strict;
use Exporter;

use vars  qw(@ISA @EXPORT);

@ISA	= qw(Exporter);
@EXPORT	= qw(
	set_debug
	get_debug
	inc_debug
	dec_debug
	debug
	warning
	suicide
	min
	max
	max_length
	__
	);


my $debug;						# debug level

BEGIN {
	eval 'use Locale::gettext';
	if ($@) {
		*gettext = sub { shift };
		*textdomain = sub { "" };
		*LC_MESSAGES = sub { 5 };
	}
	eval {
		require POSIX;
		import POSIX qw(setlocale);
	};
	if ($@) {
		*setlocale = sub { 1 };
	}
}

no strict;
setlocale(LC_MESSAGES, "");
use strict;
textdomain("acheck");

sub __($) {
	gettext(shift);
}


# set debug level
sub inc_debug() { $debug++ if $debug < 9 };		# increase debug level
sub dec_debug() { $debug-- if $debug > 0 };		# decrease debug level

sub set_debug($) { 
	$debug = $_[0] > 9 ? 9    :
	         $_[0] < 0 ? 0    :
		 	     shift;			# set debug level
};

# get debug level
sub get_debug() { return $debug };			# get debug level

# write debug messages
sub debug ($;$@) {
	return unless $debug >= shift;			# debug level
	my $text = shift || "";
	$text = sprintf ($text, @_) if @_;
	chomp $text;

	my $line = (caller(0))[2];			# get calling line
	my $sub  = (caller(1))[3] || '';		# get calling sub name

	foreach (split("\n", $text)) {
		print "debug   ($sub\:$line) " unless $debug < 3;
		print "$_\n";
	}
}

# write error message and die
sub suicide (@) {
	my $text = shift || "";
	$text = sprintf ($text, @_) if @_;
	chomp $text;

	my $line = (caller(0))[2];			# get calling line
	my $sub  = (caller(1))[3] || '';		# get calling sub name

	foreach (split("\n", $text)) {
		$debug < 3 ? print __("ERROR    ")	   :
			     print "suicide ($sub\:$line) ";
		print "$_\n";
	}

	exit -1;
}

# write warning message
sub warning (@) {
	my $text = shift || "";
	$text = sprintf ($text, @_) if @_;
	chomp $text;

	my $line = (caller(0))[2];			# get calling line
	my $sub  = (caller(1))[3] || '';		# get calling sub name

	foreach (split("\n", $text)) {
		$debug < 3 ? print __("WARNING  ")	   :
			     print "warning ($sub\:$line) ";
		print "$_\n";
	}
}

# return min value
sub min(@) {
	my $min = shift;

	$min = ($min < $_) ? $min : $_ foreach (@_);

	return $min;
}

# return max value
sub max(@) {
	my $max = shift;

	$max = ($max > $_) ? $max : $_ foreach (@_);

	return $max;
}

# return longest value
sub max_length(@) {
	my $max = length shift;

	$max = ($max > length($_)) ? $max : length($_) foreach (@_);

	return $max;
}

1;