3 use constant NONE => 0;
4 use constant INFO => 1;
5 use constant DEBUG1 => 2;
6 use constant DEBUG2 => 3;
8 use constant FILE_TARGET => 0;
9 use constant STDERR_TARGET => 1;
11 use POSIX qw(strftime);
13 my $data_dumper_available;
16 eval("use Data::Dumper");
17 $data_dumper_available = $@ ? 0 : 1;
20 $global_trace_subs = 0;
27 $self->{"calldepth"} = 0;
28 $self->{"file"} = "/tmp/lx-office-debug.log";
29 $self->{"target"} = FILE_TARGET;
31 $self->{"trace_subs"} = 0;
34 $self->{ $_[0] } = $_[1];
43 my ($self, $target, $file) = @_;
45 if ((FILE_TARGET == $target) && $file) {
46 $self->{"file"} = $file;
47 $self->{"target"} = FILE_TARGET;
49 } elsif (STDERR_TARGET == $target) {
50 $self->{"target"} = STDERR_TARGET;
55 my ($self, $level) = @_;
57 return 1 if $global_trace_subs < $level;
59 if (!$self->{"trace_subs"} && !$global_trace_subs) {
63 my ($package, $filename, $line, $subroutine) = caller(1);
64 my ($dummy1, $self_filename, $self_line) = caller(0);
66 my $indent = " " x $self->{"calldepth"};
67 $self->{"calldepth"} += 1;
69 if (!defined($package)) {
70 $self->_write('sub', $indent . "\\ top-level?\n");
72 $self->_write('sub', $indent
73 . "\\ ${subroutine} in "
74 . "${self_filename}:${self_line} called from "
75 . "${filename}:${line}\n");
81 my ($self, $level) = @_;
83 return 1 if $global_trace_subs < $level;
85 if (!$self->{"trace_subs"} && !$global_trace_subs) {
89 my ($package, $filename, $line, $subroutine) = caller(1);
90 my ($dummy1, $self_filename, $self_line) = caller(0);
92 $self->{"calldepth"} -= 1;
93 my $indent = " " x $self->{"calldepth"};
95 if (!defined($package)) {
96 $self->_write('sub', $indent . "/ top-level?\n");
98 $self->_write('sub', $indent . "/ ${subroutine} in " . "${self_filename}:${self_line}\n");
104 my ($self, $level, $message) = @_;
105 my ($log_level) = $self->{"level"};
107 if ($global_level && ($global_level > $log_level)) {
108 $log_level = $global_level;
111 if ($log_level >= $level) {
112 $self->_write(INFO == $level
114 : DEBUG1 == $level ? "debug1" : "debug2",
120 my ($self, $level, $name, $variable) = @_;
122 if ($data_dumper_available) {
123 $self->message($level, "dumping ${name}:\n" . Dumper($variable));
125 $self->message($level,
126 "dumping ${name}: Data::Dumper not available; "
127 . "variable cannot be dumped");
131 sub enable_sub_tracing {
133 $self->{"trace_subs"} = 1;
136 sub disable_sub_tracing {
138 $self->{"trace_subs"} = 1;
142 my ($self, $prefix, $message) = @_;
143 my $date = strftime("%Y-%m-%d %H:%M:%S $$ ${prefix}: ", localtime(time()));
148 if ((FILE_TARGET == $self->{"target"})
149 && open(FILE, ">>" . $self->{"file"})) {
150 print(FILE "${date}${message}\n");
153 } elsif (STDERR_TARGET == $self->{"target"}) {
154 print(STDERR "${date}${message}\n");