View file File name : Debug.pm Content :############################################################################## # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Library General Public License for more details. # # You should have received a copy of the GNU Library General Public # License along with this library; if not, write to the # Free Software Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. # # Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/ # ############################################################################## package Net::XMPP::Debug; =head1 NAME Net::XMPP::Debug - XMPP Debug Module =head1 SYNOPSIS Net::XMPP::Debug is a module that provides a developer easy access to logging debug information. =head1 DESCRIPTION Debug is a helper module for the Net::XMPP modules. It provides the Net::XMPP modules with an object to control where, how, and what is logged. =head2 Basic Functions $Debug = Net::XMPP::Debug->new(); $Debug->Init( level => 2, file => "stdout", header =>"MyScript"); $Debug->Log0("Connection established"); =head1 METHODS =head2 Basic Functions =over 4 =item new new(hash) creates the Debug object. The hash argument is passed to the Init function. See that function description below for the valid settings. =item Init Init( level => integer, file => string, header => string, setdefault => 0|1, usedefault => 0|1, time => 0|1) initializes the debug object. The B<level> determines the maximum level of debug messages to log: 0 - Base level Output (default) 1 - High level API calls 2 - Low level API calls ... N - Whatever you want.... The B<file> determines where the debug log goes. You can either specify a path to a file, or "stdout" (the default). "stdout" tells Debug to send all of the debug info sent to this object to go to stdout. B<header> is a string that will preappended to the beginning of all log entries. This makes it easier to see what generated the log entry (default is "Debug"). B<setdefault> saves the current filehandle and makes it available for other Debug objects to use. To use the default set B<usedefault> to 1. The B<time> parameter specifies whether or not to add a timestamp to the beginning of each logged line. =item LogN LogN(array) Logs the elements of the array at the corresponding debug level N. If you pass in a reference to an array or hash then they are printed in a readable way. (ie... Log0, Log2, Log100, etc...) =back =head1 EXAMPLE $Debug = Net::XMPP:Debug->new(level=>2, header=>"Example"); $Debug->Log0("test"); $Debug->Log2("level 2 test"); $hash{a} = "atest"; $hash{b} = "btest"; $Debug->Log1("hashtest", \%hash); You would get the following log: Example: test Example: level 2 test Example: hashtest { a=>"atest" b=>"btest" } If you had set the level to 1 instead of 2 you would get: Example: test Example: hashtest { a=>"atest" b=>"btest" } =head1 AUTHOR Originally authored by Ryan Eatmon. Previously maintained by Eric Hacker. Currently maintained by Darian Anthony Patrick. =head1 COPYRIGHT This module is free software, you can redistribute it and/or modify it under the LGPL 2.1. =cut require 5.008; use strict; use warnings; use FileHandle; use Carp; use vars qw( %HANDLES $DEFAULT $DEFAULTLEVEL $DEFAULTTIME $AUTOLOAD ); $DEFAULTLEVEL = -1; sub new { my $proto = shift; my $self = { }; bless($self, $proto); $self->Init(@_); return $self; } ############################################################################## # # Init - opens the fielhandle and initializes the Debug object. # ############################################################################## sub Init { my $self = shift; my %args; while($#_ >= 0) { $args{ lc pop(@_) } = pop(@_); } delete($args{file}) if (defined $args{file} && lc($args{file}) eq "stdout"); $args{time} = 0 if !exists($args{time}); $args{setdefault} = 0 if !exists($args{setdefault}); $args{usedefault} = 0 if !exists($args{usedefault}); $self->{TIME} = $args{time}; if ($args{usedefault} == 1) { $args{setdefault} = 0; $self->{USEDEFAULT} = 1; } else { $self->{LEVEL} = 0; $self->{LEVEL} = $args{level} if exists($args{level}); if ($self->{LEVEL} >= 0) { $self->{HANDLE} = FileHandle->new(">&STDERR"); $self->{HANDLE}->autoflush(1); if (exists($args{file})) { if (exists($Net::XMPP::Debug::HANDLES{$args{file}})) { $self->{HANDLE} = $Net::XMPP::Debug::HANDLES{$args{file}}; $self->{HANDLE}->autoflush(1); } else { if (-e $args{file}) { if (-w $args{file}) { $self->{HANDLE} = FileHandle->new(">$args{file}"); if (defined($self->{HANDLE})) { $self->{HANDLE}->autoflush(1); $Net::XMPP::Debug::HANDLES{$args{file}} = $self->{HANDLE}; } else { print STDERR "ERROR: Debug filehandle could not be opened.\n"; print STDERR" Debugging disabled.\n"; print STDERR " ($!)\n"; $self->{LEVEL} = -1; } } else { print STDERR "ERROR: You do not have permission to write to $args{file}.\n"; print STDERR" Debugging disabled.\n"; $self->{LEVEL} = -1; } } else { $self->{HANDLE} = FileHandle->new(">$args{file}"); if (defined($self->{HANDLE})) { $self->{HANDLE}->autoflush(1); $Net::XMPP::Debug::HANDLES{$args{file}} = $self->{HANDLE}; } else { print STDERR "ERROR: Debug filehandle could not be opened.\n"; print STDERR" Debugging disabled.\n"; print STDERR " ($!)\n"; $self->{LEVEL} = -1; } } } } } } if ($args{setdefault} == 1) { $Net::XMPP::Debug::DEFAULT = $self->{HANDLE}; $Net::XMPP::Debug::DEFAULTLEVEL = $self->{LEVEL}; $Net::XMPP::Debug::DEFAULTTIME = $self->{TIME}; } $self->{HEADER} = "Debug"; $self->{HEADER} = $args{header} if exists($args{header}); } ############################################################################## # # Log - takes the limit and the array to log and logs them # ############################################################################## sub Log { my $self = shift; my (@args) = @_; my $fh = $self->{HANDLE}; $fh = $Net::XMPP::Debug::DEFAULT if exists($self->{USEDEFAULT}); return if not $fh; my $string = ""; my $testTime = $self->{TIME}; $testTime = $Net::XMPP::Debug::DEFAULTTIME if exists($self->{USEDEFAULT}); $string .= "[".&Net::XMPP::GetTimeStamp("local",time,"short")."] " if ($testTime == 1); $string .= $self->{HEADER}.": "; my $arg; foreach $arg (@args) { if (ref($arg) eq "HASH") { $string .= " {"; my $key; foreach $key (sort {$a cmp $b} keys(%{$arg})) { $string .= " ".$key."=>'".$arg->{$key}."'"; } $string .= " }"; } else { if (ref($arg) eq "ARRAY") { $string .= " [ ".join(" ",@{$arg})." ]"; } else { $string .= $arg; } } } print $fh "$string\n"; return 1; } ############################################################################## # # AUTOLOAD - if a function is called that is not defined then this function # will examine the function name and either give an error or call # the appropriate function. # ############################################################################## sub AUTOLOAD { my $self = shift; return if ($AUTOLOAD =~ /::DESTROY$/); my ($function) = ($AUTOLOAD =~ /\:\:(.*)$/); croak("$function not defined") if !($function =~ /Log\d+/); my ($level) = ($function =~ /Log(\d+)/); return 0 if ($level > (exists($self->{USEDEFAULT}) ? $Net::XMPP::Debug::DEFAULTLEVEL : $self->{LEVEL})); $self->Log(@_); } ############################################################################## # # GetHandle - returns the filehandle being used by this object. # ############################################################################## sub GetHandle { my $self = shift; return $self->{HANDLE}; } ############################################################################## # # GetLevel - returns the debug level used by this object. # ############################################################################## sub GetLevel { my $self = shift; return $self->{LEVEL}; } ############################################################################## # # GetTime - returns the debug time used by this object. # ############################################################################## sub GetTime { my $self = shift; return $self->{TIME}; } 1;