Einige Übersetzungen, einheitliche Bezeichnung
[kivitendo-erp.git] / SL / LXDebug.pm
1 package LXDebug;
2
3 use constant NONE   => 0;
4 use constant INFO   => 1;
5 use constant DEBUG1 => 2;
6 use constant DEBUG2 => 3;
7 use constant QUERY  => 4;
8
9 use constant FILE_TARGET   => 0;
10 use constant STDERR_TARGET => 1;
11
12 use POSIX qw(strftime);
13
14 my $data_dumper_available;
15
16 BEGIN {
17   eval("use Data::Dumper");
18   $data_dumper_available = $@ ? 0 : 1;
19
20   $global_level      = NONE;
21   $global_trace_subs = 0;
22 }
23
24 sub new {
25   my $type = shift;
26   my $self = {};
27
28   $self->{"calldepth"}  = 0;
29   $self->{"file"}       = "/tmp/lx-office-debug.log";
30   $self->{"target"}     = FILE_TARGET;
31   $self->{"level"}      = 0;
32   $self->{"trace_subs"} = 0;
33
34   while ($_[0]) {
35     $self->{ $_[0] } = $_[1];
36     shift;
37     shift;
38   }
39
40   bless($self, $type);
41 }
42
43 sub set_target {
44   my ($self, $target, $file) = @_;
45
46   if ((FILE_TARGET == $target) && $file) {
47     $self->{"file"}   = $file;
48     $self->{"target"} = FILE_TARGET;
49
50   } elsif (STDERR_TARGET == $target) {
51     $self->{"target"} = STDERR_TARGET;
52   }
53 }
54
55 sub enter_sub {
56   my ($self, $level) = @_;
57
58   return 1 if $global_trace_subs < $level;
59
60   if (!$self->{"trace_subs"} && !$global_trace_subs) {
61     return 1;
62   }
63
64   my ($package, $filename, $line, $subroutine) = caller(1);
65   my ($dummy1, $self_filename, $self_line) = caller(0);
66
67   my $indent = " " x $self->{"calldepth"};
68   $self->{"calldepth"} += 1;
69
70   if (!defined($package)) {
71     $self->_write('sub', $indent . "\\ top-level?\n");
72   } else {
73     $self->_write('sub', $indent
74                     . "\\ ${subroutine} in "
75                     . "${self_filename}:${self_line} called from "
76                     . "${filename}:${line}\n");
77   }
78   return 1;
79 }
80
81 sub leave_sub {
82   my ($self, $level) = @_;
83
84   return 1 if $global_trace_subs < $level;
85
86   if (!$self->{"trace_subs"} && !$global_trace_subs) {
87     return 1;
88   }
89
90   my ($package, $filename, $line, $subroutine) = caller(1);
91   my ($dummy1, $self_filename, $self_line) = caller(0);
92
93   $self->{"calldepth"} -= 1;
94   my $indent = " " x $self->{"calldepth"};
95
96   if (!defined($package)) {
97     $self->_write('sub', $indent . "/ top-level?\n");
98   } else {
99     $self->_write('sub', $indent . "/ ${subroutine} in " . "${self_filename}:${self_line}\n");
100   }
101   return 1;
102 }
103
104 sub message {
105   my ($self, $level, $message) = @_;
106   my ($log_level) = $self->{"level"};
107
108   if ($global_level && ($global_level > $log_level)) {
109     $log_level = $global_level;
110   }
111
112   if ($log_level >= $level) {
113     $self->_write(INFO   == $level ? "info"
114                 : DEBUG1 == $level ? "debug1" 
115                 : DEBUG2 == $level ? "debug2"
116                 : QUERY  == $level ? "query":"",
117                 $message );
118   }
119 }
120
121 sub dump {
122   my ($self, $level, $name, $variable) = @_;
123
124   if ($data_dumper_available) {
125     $self->message($level, "dumping ${name}:\n" . Dumper($variable));
126   } else {
127     $self->message($level,
128                    "dumping ${name}: Data::Dumper not available; "
129                      . "variable cannot be dumped");
130   }
131 }
132
133 sub enable_sub_tracing {
134   my ($self) = @_;
135   $self->{"trace_subs"} = 1;
136 }
137
138 sub disable_sub_tracing {
139   my ($self) = @_;
140   $self->{"trace_subs"} = 0;
141 }
142
143 sub _write {
144   my ($self, $prefix, $message) = @_;
145   my $date = strftime("%Y-%m-%d %H:%M:%S $$ ${prefix}: ", localtime(time()));
146   local *FILE;
147
148   chomp($message);
149
150   if ((FILE_TARGET == $self->{"target"})
151       && open(FILE, ">>" . $self->{"file"})) {
152     print(FILE "${date}${message}\n");
153     close(FILE);
154
155       } elsif (STDERR_TARGET == $self->{"target"}) {
156     print(STDERR "${date}${message}\n");
157   }
158 }
159
160 1;