source: perl/modules/Jabber/lib/Net/XMPP/Debug.pm

barnowl_perlaimdebianrelease-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file was b7b2a76, checked in by Alejandro R. Sedeño <asedeno@mit.edu>, 17 years ago
Pet peeve - tabs. That should be the end of it for now.
  • Property mode set to 100644
File size: 10.4 KB
Line 
1##############################################################################
2#
3#  This library is free software; you can redistribute it and/or
4#  modify it under the terms of the GNU Library General Public
5#  License as published by the Free Software Foundation; either
6#  version 2 of the License, or (at your option) any later version.
7#
8#  This library is distributed in the hope that it will be useful,
9#  but WITHOUT ANY WARRANTY; without even the implied warranty of
10#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
11#  Library General Public License for more details.
12#
13#  You should have received a copy of the GNU Library General Public
14#  License along with this library; if not, write to the
15#  Free Software Foundation, Inc., 59 Temple Place - Suite 330,
16#  Boston, MA  02111-1307, USA.
17#
18#  Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/
19#
20##############################################################################
21
22package Net::XMPP::Debug;
23
24=head1 NAME
25
26Net::XMPP::Debug - XMPP Debug Module
27
28=head1 SYNOPSIS
29
30  Net::XMPP::Debug is a module that provides a developer easy access
31  to logging debug information.
32
33=head1 DESCRIPTION
34
35  Debug is a helper module for the Net::XMPP modules.  It provides
36  the Net::XMPP modules with an object to control where, how, and
37  what is logged.
38
39=head2 Basic Functions
40
41    $Debug = Net::XMPP::Debug->new();
42
43    $Debug->Init(level=>2,
44                     file=>"stdout",
45                     header=>"MyScript");
46
47    $Debug->Log0("Connection established");
48
49=head1 METHODS
50
51=head2 Basic Functions
52
53    new(hash) - creates the Debug object.  The hash argument is passed
54                to the Init function.  See that function description
55                below for the valid settings.
56
57    Init(level=>integer,  - initializes the debug object.  The level
58         file=>string,      determines the maximum level of debug
59         header=>string,    messages to log:
60         setdefault=>0|1,     0 - Base level Output (default)
61         usedefault=>0|1,     1 - High level API calls
62         time=>0|1)           2 - Low level API calls
63                              ...
64                              N - Whatever you want....
65                            The file determines where the debug log
66                            goes.  You can either specify a path to
67                            a file, or "stdout" (the default).  "stdout"
68                            tells Debug to send all of the debug info
69                            sent to this object to go to stdout.
70                            header is a string that will preappended
71                            to the beginning of all log entries.  This
72                            makes it easier to see what generated the
73                            log entry (default is "Debug").
74                            setdefault saves the current filehandle
75                            and makes it available for other Debug
76                            objects to use.  To use the default set
77                            usedefault to 1.  The time parameter
78                            specifies whether or not to add a timestamp
79                            to the beginning of each logged line.
80
81    LogN(array) - Logs the elements of the array at the corresponding
82                  debug level N.  If you pass in a reference to an
83                  array or hash then they are printed in a readable
84                  way.  (ie... Log0, Log2, Log100, etc...)
85
86=head1 EXAMPLE
87
88  $Debug = Net::XMPP:Debug->new(level=>2,
89                               header=>"Example");
90
91    $Debug->Log0("test");
92
93    $Debug->Log2("level 2 test");
94
95    $hash{a} = "atest";
96    $hash{b} = "btest";
97
98    $Debug->Log1("hashtest",\%hash);
99
100  You would get the following log:
101
102    Example: test
103    Example: level 2 test
104    Example: hashtest { a=>"atest" b=>"btest" }
105
106  If you had set the level to 1 instead of 2 you would get:
107
108    Example: test
109    Example: hashtest { a=>"atest" b=>"btest" }
110
111=head1 AUTHOR
112
113Ryan Eatmon
114
115=head1 COPYRIGHT
116
117This module is free software; you can redistribute it and/or modify
118it under the same terms as Perl itself.
119
120=cut
121
122require 5.003;
123use strict;
124use FileHandle;
125use Carp;
126use vars qw( %HANDLES $DEFAULT $DEFAULTLEVEL $DEFAULTTIME $AUTOLOAD );
127
128$DEFAULTLEVEL = -1;
129
130sub new
131{
132    my $proto = shift;
133    my $self = { };
134    bless($self, $proto);
135
136    $self->Init(@_);
137
138    return $self;
139}
140
141
142##############################################################################
143#
144# Init - opens the fielhandle and initializes the Debug object.
145#
146##############################################################################
147sub Init
148{
149    my $self = shift;
150
151    my %args;
152    while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); }
153   
154    delete($args{file}) if (lc($args{file}) eq "stdout");
155
156    $args{time} = 0 if !exists($args{time});
157    $args{setdefault} = 0 if !exists($args{setdefault});
158    $args{usedefault} = 0 if !exists($args{usedefault});
159
160    $self->{TIME} = $args{time};
161
162    if ($args{usedefault} == 1)
163    {
164        $args{setdefault} = 0;
165        $self->{USEDEFAULT} = 1;
166    }
167    else
168    {
169        $self->{LEVEL} = 0;
170        $self->{LEVEL} = $args{level} if exists($args{level});
171
172        $self->{HANDLE} = new FileHandle(">&STDERR");
173        $self->{HANDLE}->autoflush(1);
174        if (exists($args{file}))
175        {
176            if (exists($Net::XMPP::Debug::HANDLES{$args{file}}))
177            {
178                $self->{HANDLE} = $Net::XMPP::Debug::HANDLES{$args{file}};
179                $self->{HANDLE}->autoflush(1);
180            }
181            else
182            {
183                if (-e $args{file})
184                {
185                    if (-w $args{file})
186                    {
187                        $self->{HANDLE} = new FileHandle(">$args{file}");
188                        if (defined($self->{HANDLE}))
189                        {
190                            $self->{HANDLE}->autoflush(1);
191                            binmode $self->{HANDLE}, ":utf8";
192                            $Net::XMPP::Debug::HANDLES{$args{file}} = $self->{HANDLE};
193                        }
194                        else
195                        {
196                            print STDERR "ERROR: Debug filehandle could not be opened.\n";
197                            print STDERR"        Debugging disabled.\n";
198                            print STDERR "       ($!)\n";
199                            $self->{LEVEL} = -1;
200                        }
201                    }
202                    else
203                    {
204                        print STDERR "ERROR: You do not have permission to write to $args{file}.\n";
205                        print STDERR"        Debugging disabled.\n";
206                        $self->{LEVEL} = -1;
207                    }
208                }
209                else
210                {
211                    $self->{HANDLE} = new FileHandle(">$args{file}");
212                    if (defined($self->{HANDLE}))
213                    {
214                        $self->{HANDLE}->autoflush(1);
215                        $Net::XMPP::Debug::HANDLES{$args{file}} = $self->{HANDLE};
216                    }
217                    else
218                    {
219                        print STDERR "ERROR: Debug filehandle could not be opened.\n";
220                        print STDERR"        Debugging disabled.\n";
221                        print STDERR "       ($!)\n";
222                        $self->{LEVEL} = -1;
223                    }
224                }
225            }
226        }
227    }
228    if ($args{setdefault} == 1)
229    {
230        $Net::XMPP::Debug::DEFAULT = $self->{HANDLE};
231        $Net::XMPP::Debug::DEFAULTLEVEL = $self->{LEVEL};
232        $Net::XMPP::Debug::DEFAULTTIME = $self->{TIME};
233    }
234
235    $self->{HEADER} = "Debug";
236    $self->{HEADER} = $args{header} if exists($args{header});
237}
238
239
240##############################################################################
241#
242# Log - takes the limit and the array to log and logs them
243#
244##############################################################################
245sub Log
246{
247    my $self = shift;
248    my (@args) = @_;
249
250    my $fh = $self->{HANDLE};
251    $fh = $Net::XMPP::Debug::DEFAULT if exists($self->{USEDEFAULT});
252
253    my $string = "";
254
255    my $testTime = $self->{TIME};
256    $testTime = $Net::XMPP::Debug::DEFAULTTIME if exists($self->{USEDEFAULT});
257
258    $string .= "[".&Net::XMPP::GetTimeStamp("local",time,"short")."] "
259        if ($testTime == 1);
260    $string .= $self->{HEADER}.": ";
261
262    my $arg;
263
264    foreach $arg (@args)
265    {
266        if (ref($arg) eq "HASH")
267        {
268            $string .= " {";
269            my $key;
270            foreach $key (sort {$a cmp $b} keys(%{$arg}))
271            {
272                $string .= " ".$key."=>'".$arg->{$key}."'";
273            }
274            $string .= " }";
275        }
276        else
277        {
278            if (ref($arg) eq "ARRAY")
279            {
280                $string .= " [ ".join(" ",@{$arg})." ]";
281            }  else {
282                $string .= $arg;
283            }
284        }
285    }
286    print $fh "$string\n";
287    return 1;
288}
289
290
291##############################################################################
292#
293# AUTOLOAD - if a function is called that is not defined then this function
294#            will examine the function name and either give an error or call
295#            the appropriate function.
296#
297##############################################################################
298sub AUTOLOAD
299{
300    my $self = shift;
301    return if ($AUTOLOAD =~ /::DESTROY$/);
302    my ($function) = ($AUTOLOAD =~ /\:\:(.*)$/);
303    croak("$function not defined") if !($function =~ /Log\d+/);
304    my ($level) = ($function =~ /Log(\d+)/);
305    return 0 if ($level > (exists($self->{USEDEFAULT}) ? $Net::XMPP::Debug::DEFAULTLEVEL : $self->{LEVEL}));
306    $self->Log(@_);
307}
308
309
310##############################################################################
311#
312# GetHandle - returns the filehandle being used by this object.
313#
314##############################################################################
315sub GetHandle
316{
317    my $self = shift;
318    return $self->{HANDLE};
319}
320
321
322##############################################################################
323#
324# GetLevel - returns the debug level used by this object.
325#
326##############################################################################
327sub GetLevel
328{
329    my $self = shift;
330    return $self->{LEVEL};
331}
332
333
334##############################################################################
335#
336# GetTime - returns the debug time used by this object.
337#
338##############################################################################
339sub GetTime
340{
341    my $self = shift;
342    return $self->{TIME};
343}
344
345
3461;
Note: See TracBrowser for help on using the repository browser.