package Ddtc::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
	);


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("ddtc");

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 @_;
	my @text = split("\n", $text);
	@text = ("") unless @text;

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

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

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

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

	foreach (@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 @_;
	my @text = split("\n", $text);
	@text = ("") unless @text;

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

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

1;