X-Git-Url: https://git.gag.com/?a=blobdiff_plain;f=perl%2FAmanda%2FDebug.swg;h=f3402c0941c78144f2c0fd7ff89ae3f1cfc44633;hb=691567b16c13087b31ee4c2b6d038e57872fae82;hp=1610b7c4aaf4f6672e796f51be4cb0f930276c57;hpb=afaa71b3866b46b082b6c895772e15b36d8865fe;p=debian%2Famanda diff --git a/perl/Amanda/Debug.swg b/perl/Amanda/Debug.swg index 1610b7c..f3402c0 100644 --- a/perl/Amanda/Debug.swg +++ b/perl/Amanda/Debug.swg @@ -1,124 +1,42 @@ /* - * Copyright (c) Zmanda, Inc. All Rights Reserved. + * Copyright (c) 2007-2012 Zmanda, Inc. All Rights Reserved. * - * This library is free software; you can redistribute it and/or modify it - * under the terms of the GNU Lesser General Public License version 2.1 - * as published by the Free Software Foundation. + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU 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 + * This program 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 Lesser General Public - * License for more details. + * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + * for more details. * - * You should have received a copy of the GNU Lesser 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. + * You should have received a copy of the GNU General Public License along + * with this program; if not, write to the Free Software Foundation, Inc., + * 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA * - * Contact information: Zmanda Inc., 465 S Mathlida Ave, Suite 300 - * Sunnyvale, CA 94086, USA, or: http://www.zmanda.com + * Contact information: Zmanda Inc., 465 S. Mathilda Ave., Suite 300 + * Sunnyvale, CA 94085, USA, or: http://www.zmanda.com */ %module "Amanda::Debug" %include "amglue/amglue.swg" %include "exception.i" +%include "Amanda/Debug.pod" + %{ #include #include "debug.h" %} -%perlcode %{ -=head1 NAME - -Amanda::Debug - support for debugging Amanda applications - -=head1 SYNOPSIS - - use Amanda::Util qw( :constants ); - - Amanda::Util::setup_application("amcooltool", "server", $CONTEXT_CMDLINE); - - debug("this is a debug message"); - die("Unable to frobnicate the ergonator"); - -See C for a more in-depth description of the logging functionality of -this module. - -=head1 API STATUS - -Stable - -=head1 DEBUG LOGGING - -Several debug logging functions, each taking a single string, are -available: - -=over - -=item C - also aborts the program to produce a core dump - -=item C - exits the program with C<$error_exit_status> - -=item C - -=item C - -=item C - -=item C - -=back - -Perl's built-in C and C functions are patched to call C -and C, respectively. - -All of the debug logging functions are available via the export tag -C<:logging>. - -=head1 ADVANCED USAGE - -Most applications should use L's C -to initialize the debug libraries. The initialization functions -available from this module are thus considered "advanced", and the -reader is advised to consult the C header, C, for details. - -Briefly, the functions C and C are used to -open a debug file whose pathname includes all of the relevant -information. C and C are used to close that debug -file before transferring control to another process. - -The variable C<$erroutput_type> can take on any combination -of the flags C<$ERROUTPUT_INTERACTIVE>, C<$ERROUTPUT_SYSLOG> -and C<$ERROUTPUT_AMANDALOG>. C<$ERROUTPUT_INTERACTIVE> -causes messages from C and C to be sent -to stderr. C<$ERROUTPUT_SYSLOG> sends it to syslog, and -C<$ERROUTPUT_AMANDALOG> sends it to the current trace log (see -L). - -C<$error_exit_status> is the exit status with which C -will exit. - -All of the initialization functions and variables are available via -the export tag C<:init>. - -The current debug file's integer file descriptor (I a Perl -filehandle) is available from C. Likewise, C returns -the filename of the current debug file. - -C redirects, at the file-descriptor level, -C into the debug file. This is useful when running external -applications which may produce error output. - -=cut -%} - /* * Initialization */ amglue_export_tag(init, debug_init dbopen dbreopen dbrename dbclose - $erroutput_type $error_exit_status + $error_exit_status ); void debug_init(void); @@ -127,13 +45,6 @@ void dbreopen(char *file, char *notation); void dbrename(char *config, char *subdir); void dbclose(void); -amglue_add_flag_tag_fns(erroutput_type_t); -amglue_add_constant_short(ERR_INTERACTIVE, INTERACTIVE, erroutput_type_t); -amglue_add_constant_short(ERR_SYSLOG, SYSLOG, erroutput_type_t); -amglue_add_constant_short(ERR_AMANDALOG, AMANDALOG, erroutput_type_t); -amglue_copy_tag_to(erroutput_type_t, init); - -erroutput_type_t erroutput_type; int error_exit_status; /* @@ -141,24 +52,28 @@ int error_exit_status; */ %perlcode %{ sub _my_die { - # $^S is set if we're in an eval { .. }, in which case we want - # to use the default Perl semantics. - if ($^S) { + # $^S: (from perlvar) + # undef -> parsing module/eval + # 1 -> executing an eval + # 0 -> otherwise + # we *only* want to call critical() in the "otherwise" case + if (!defined($^S) or $^S == 1) { die(@_); } else { my ($msg) = @_; chomp $msg; + suppress_error_traceback(); critical(@_); } }; -$SIG{__DIE__} = \&my_die; +$SIG{__DIE__} = \&_my_die; sub _my_warn { my ($msg) = @_; chomp $msg; warning(@_); }; -$SIG{__WARN__} = \&my_warn; +$SIG{__WARN__} = \&_my_warn; # utility function for test scripts, which want to use the regular # perl mechanisms @@ -172,10 +87,6 @@ sub disable_die_override { * Logging */ -amglue_export_tag(logging, - error critical warning message info debug -); - %rename(error) error__; /* error() is a macro defined in debug.h .. just avoid that */ %inline %{ void error__(char *msg) { g_error("%s", msg); } @@ -186,6 +97,26 @@ void info(char *msg) { g_info("%s", msg); } void debug(char *msg) { g_debug("%s", msg); } %} +amglue_export_tag(logging, + error critical warning message info debug +); + +void add_amanda_log_handler(amanda_log_handler_t *handler); +/* these functions are written as simple global variables, since they are just + * function pointers used in add_amanda_log_handler. Note that the functions + * then appear as e.g., $amanda_log_null. */ +%immutable; +amanda_log_handler_t *amanda_log_stderr, *amanda_log_syslog, *amanda_log_null; +%mutable; + +amglue_export_tag(logging, + add_amanda_log_handler + $amanda_log_stderr $amanda_log_syslog $amanda_log_null +); + +/* used to suppress the traceback when calling from perl */ +void suppress_error_traceback(void); + /* * Advanced */