File: Common.pm

package info (click to toggle)
ddtc 0.17.2
  • links: PTS
  • area: main
  • in suites: bullseye, buster, sid, stretch
  • size: 252 kB
  • sloc: perl: 2,260; makefile: 90
file content (116 lines) | stat: -rw-r--r-- 2,141 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
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;