source: perl/lib/Net/XMPP/Debug.pm @ a75309a

barnowl_perlaimdebianrelease-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since a75309a was 0ff8d110, checked in by Alejandro R. Sedeño <asedeno@mit.edu>, 15 years ago
Adding XML::Stream, Net::XMPP, and Net::Jabber to perl/lib/
  • 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 = new Net::XMPP::Debug();
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 = new Net::XMPP:Debug(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                            $Net::XMPP::Debug::HANDLES{$args{file}} = $self->{HANDLE};
192                        }
193                        else
194                        {
195                            print STDERR "ERROR: Debug filehandle could not be opened.\n";
196                            print STDERR"        Debugging disabled.\n";
197                            print STDERR "       ($!)\n";
198                            $self->{LEVEL} = -1;
199                        }
200                    }
201                    else
202                    {
203                        print STDERR "ERROR: You do not have permission to write to $args{file}.\n";
204                        print STDERR"        Debugging disabled.\n";
205                        $self->{LEVEL} = -1;
206                    }
207                }
208                else
209                {
210                    $self->{HANDLE} = new FileHandle(">$args{file}");
211                    if (defined($self->{HANDLE}))
212                    {
213                        $self->{HANDLE}->autoflush(1);
214                        $Net::XMPP::Debug::HANDLES{$args{file}} = $self->{HANDLE};
215                    }
216                    else
217                    {
218                        print STDERR "ERROR: Debug filehandle could not be opened.\n";
219                        print STDERR"        Debugging disabled.\n";
220                        print STDERR "       ($!)\n";
221                        $self->{LEVEL} = -1;
222                    }
223                }
224            }
225        }
226    }
227    if ($args{setdefault} == 1)
228    {
229        $Net::XMPP::Debug::DEFAULT = $self->{HANDLE};
230        $Net::XMPP::Debug::DEFAULTLEVEL = $self->{LEVEL};
231        $Net::XMPP::Debug::DEFAULTTIME = $self->{TIME};
232    }
233
234    $self->{HEADER} = "Debug";
235    $self->{HEADER} = $args{header} if exists($args{header});
236}
237
238
239##############################################################################
240#
241# Log - takes the limit and the array to log and logs them
242#
243##############################################################################
244sub Log
245{
246    my $self = shift;
247    my (@args) = @_;
248
249    my $fh = $self->{HANDLE};
250    $fh = $Net::XMPP::Debug::DEFAULT if exists($self->{USEDEFAULT});
251
252    my $string = "";
253
254    my $testTime = $self->{TIME};
255    $testTime = $Net::XMPP::Debug::DEFAULTTIME if exists($self->{USEDEFAULT});
256
257    $string .= "[".&Net::XMPP::GetTimeStamp("local",time,"short")."] "
258        if ($testTime == 1);
259    $string .= $self->{HEADER}.": ";
260
261    my $arg;
262
263    foreach $arg (@args)
264    {
265        if (ref($arg) eq "HASH")
266        {
267            $string .= " {";
268            my $key;
269            foreach $key (sort {$a cmp $b} keys(%{$arg}))
270            {
271                $string .= " ".$key."=>'".$arg->{$key}."'";
272            }
273            $string .= " }";
274        }
275        else
276        {
277            if (ref($arg) eq "ARRAY")
278            {
279                $string .= " [ ".join(" ",@{$arg})." ]";
280            }  else {
281                $string .= $arg;
282            }
283        }
284    }
285    print $fh "$string\n";
286    return 1;
287}
288
289
290##############################################################################
291#
292# AUTOLOAD - if a function is called that is not defined then this function
293#            will examine the function name and either give an error or call
294#            the appropriate function.
295#
296##############################################################################
297sub AUTOLOAD
298{
299    my $self = shift;
300    return if ($AUTOLOAD =~ /::DESTROY$/);
301    my ($function) = ($AUTOLOAD =~ /\:\:(.*)$/);
302    croak("$function not defined") if !($function =~ /Log\d+/);
303    my ($level) = ($function =~ /Log(\d+)/);
304    return 0 if ($level > (exists($self->{USEDEFAULT}) ? $Net::XMPP::Debug::DEFAULTLEVEL : $self->{LEVEL}));
305    $self->Log(@_);
306}
307
308
309##############################################################################
310#
311# GetHandle - returns the filehandle being used by this object.
312#
313##############################################################################
314sub GetHandle
315{
316    my $self = shift;
317    return $self->{HANDLE};
318}
319
320
321##############################################################################
322#
323# GetLevel - returns the debug level used by this object.
324#
325##############################################################################
326sub GetLevel
327{
328    my $self = shift;
329    return $self->{LEVEL};
330}
331
332
333##############################################################################
334#
335# GetTime - returns the debug time used by this object.
336#
337##############################################################################
338sub GetTime
339{
340    my $self = shift;
341    return $self->{TIME};
342}
343
344
3451;
Note: See TracBrowser for help on using the repository browser.