git.gag.com Git - debian/amanda/blob - perl/Amanda/Debug.pm

   1 # This file was automatically generated by SWIG (http://www.swig.org).
   2 # Version 1.3.39
   3 #
   4 # Do not make changes to this file unless you know what you are doing--modify
   5 # the SWIG interface file instead.
   6
   7 package Amanda::Debug;
   8 use base qw(Exporter);
   9 use base qw(DynaLoader);
  10 package Amanda::Debugc;
  11 bootstrap Amanda::Debug;
  12 package Amanda::Debug;
  13 @EXPORT = qw();
  14
  15 # ---------- BASE METHODS -------------
  16
  17 package Amanda::Debug;
  18
  19 sub TIEHASH {
  20     my ($classname,$obj) = @_;
  21     return bless $obj, $classname;
  22 }
  23
  24 sub CLEAR { }
  25
  26 sub FIRSTKEY { }
  27
  28 sub NEXTKEY { }
  29
  30 sub FETCH {
  31     my ($self,$field) = @_;
  32     my $member_func = "swig_${field}_get";
  33     $self->$member_func();
  34 }
  35
  36 sub STORE {
  37     my ($self,$field,$newval) = @_;
  38     my $member_func = "swig_${field}_set";
  39     $self->$member_func($newval);
  40 }
  41
  42 sub this {
  43     my $ptr = shift;
  44     return tied(%$ptr);
  45 }
  46
  47
  48 # ------- FUNCTION WRAPPERS --------
  49
  50 package Amanda::Debug;
  51
  52 *debug_init = *Amanda::Debugc::debug_init;
  53 *dbopen = *Amanda::Debugc::dbopen;
  54 *dbreopen = *Amanda::Debugc::dbreopen;
  55 *dbrename = *Amanda::Debugc::dbrename;
  56 *dbclose = *Amanda::Debugc::dbclose;
  57 *error = *Amanda::Debugc::error;
  58 *critical = *Amanda::Debugc::critical;
  59 *warning = *Amanda::Debugc::warning;
  60 *message = *Amanda::Debugc::message;
  61 *info = *Amanda::Debugc::info;
  62 *debug = *Amanda::Debugc::debug;
  63 *dbfd = *Amanda::Debugc::dbfd;
  64 *dbfn = *Amanda::Debugc::dbfn;
  65 *debug_dup_stderr_to_debug = *Amanda::Debugc::debug_dup_stderr_to_debug;
  66
  67 # ------- VARIABLE STUBS --------
  68
  69 package Amanda::Debug;
  70
  71 *ERR_INTERACTIVE = *Amanda::Debugc::ERR_INTERACTIVE;
  72 *ERR_SYSLOG = *Amanda::Debugc::ERR_SYSLOG;
  73 *ERR_AMANDALOG = *Amanda::Debugc::ERR_AMANDALOG;
  74 *erroutput_type = *Amanda::Debugc::erroutput_type;
  75 *error_exit_status = *Amanda::Debugc::error_exit_status;
  76
  77 @EXPORT_OK = ();
  78 %EXPORT_TAGS = ();
  79
  80 =head1 NAME
  81
  82 Amanda::Debug - support for debugging Amanda applications
  83
  84 =head1 SYNOPSIS
  85
  86   use Amanda::Util qw( :constants );
  87
  88   Amanda::Util::setup_application("amcooltool", "server", $CONTEXT_CMDLINE);
  89
  90   debug("this is a debug message");
  91   die("Unable to frobnicate the ergonator");
  92
  93 See C<debug.h> for a more in-depth description of the logging functionality of
  94 this module.
  95
  96 =head1 API STATUS
  97
  98 Stable
  99
 100 =head1 DEBUG LOGGING
 101
 102 Several debug logging functions, each taking a single string, are
 103 available:
 104
 105 =over
 106
 107 =item C<error> - also aborts the program to produce a core dump
 108
 109 =item C<critical> - exits the program with C<$error_exit_status>
 110
 111 =item C<warning>
 112
 113 =item C<message>
 114
 115 =item C<info>
 116
 117 =item C<debug>
 118
 119 =back
 120
 121 Perl's built-in C<die> and C<warn> functions are patched to call C<critical>
 122 and C<warning>, respectively.
 123
 124 All of the debug logging functions are available via the export tag
 125 C<:logging>.
 126
 127 =head1 ADVANCED USAGE
 128
 129 Most applications should use L<Amanda::Util>'s C<setup_application>
 130 to initialize the debug libraries.  The initialization functions
 131 available from this module are thus considered "advanced", and the
 132 reader is advised to consult the C header, C<debug.h>, for details.
 133
 134 Briefly, the functions C<dbopen> and C<dbrename> are used to
 135 open a debug file whose pathname includes all of the relevant
 136 information. C<dbclose> and C<dbreopen> are used to close that debug
 137 file before transferring control to another process.
 138
 139 The variable C<$erroutput_type> can take on any combination
 140 of the flags C<$ERROUTPUT_INTERACTIVE>, C<$ERROUTPUT_SYSLOG>
 141 and C<$ERROUTPUT_AMANDALOG>.  C<$ERROUTPUT_INTERACTIVE>
 142 causes messages from C<error> and C<critical> to be sent
 143 to stderr. C<$ERROUTPUT_SYSLOG> sends it to syslog, and
 144 C<$ERROUTPUT_AMANDALOG> sends it to the current trace log (see
 145 L<Amanda::Logfile>).
 146
 147 C<$error_exit_status> is the exit status with which C<critical>
 148 will exit.
 149
 150 All of the initialization functions and variables are available via
 151 the export tag C<:init>.
 152
 153 The current debug file's integer file descriptor (I<not> a Perl
 154 filehandle) is available from C<dbfd()>.  Likewise, C<dbfn()> returns
 155 the filename of the current debug file.
 156
 157 C<debug_dup_stderr_to_debug()> redirects, at the file-descriptor level,
 158 C<STDERR> into the debug file.  This is useful when running external
 159 applications which may produce error output.
 160
 161 =cut
 162
 163 push @EXPORT_OK, qw(debug_init dbopen dbreopen dbrename dbclose
 164     $erroutput_type $error_exit_status);
 165 push @{$EXPORT_TAGS{"init"}}, qw(debug_init dbopen dbreopen dbrename dbclose
 166     $erroutput_type $error_exit_status);
 167
 168 push @EXPORT_OK, qw(erroutput_type_t_to_strings);
 169 push @{$EXPORT_TAGS{"erroutput_type_t"}}, qw(erroutput_type_t_to_strings);
 170
 171 my %_erroutput_type_t_VALUES;
 172 #Convert a flag value to a list of names for flags that are set.
 173 sub erroutput_type_t_to_strings {
 174     my ($flags) = @_;
 175     my @result = ();
 176
 177     for my $k (keys %_erroutput_type_t_VALUES) {
 178         my $v = $_erroutput_type_t_VALUES{$k};
 179
 180         #is this a matching flag?
 181         if (($v == 0 && $flags == 0) || ($v != 0 && ($flags & $v) == $v)) {
 182             push @result, $k;
 183         }
 184     }
 185
 186 #by default, just return the number as a 1-element list
 187     if (!@result) {
 188         return ($flags);
 189     }
 190
 191     return @result;
 192 }
 193
 194 push @EXPORT_OK, qw($ERR_INTERACTIVE);
 195 push @{$EXPORT_TAGS{"erroutput_type_t"}}, qw($ERR_INTERACTIVE);
 196
 197 $_erroutput_type_t_VALUES{"INTERACTIVE"} = $ERR_INTERACTIVE;
 198
 199 push @EXPORT_OK, qw($ERR_SYSLOG);
 200 push @{$EXPORT_TAGS{"erroutput_type_t"}}, qw($ERR_SYSLOG);
 201
 202 $_erroutput_type_t_VALUES{"SYSLOG"} = $ERR_SYSLOG;
 203
 204 push @EXPORT_OK, qw($ERR_AMANDALOG);
 205 push @{$EXPORT_TAGS{"erroutput_type_t"}}, qw($ERR_AMANDALOG);
 206
 207 $_erroutput_type_t_VALUES{"AMANDALOG"} = $ERR_AMANDALOG;
 208
 209 sub _my_die {
 210     # $^S is set if we're in an eval { .. }, in which case we want
 211     # to use the default Perl semantics.
 212     if ($^S) {
 213         die(@_);
 214     } else {
 215         my ($msg) = @_;
 216         chomp $msg;
 217         critical(@_);
 218     }
 219 };
 220 $SIG{__DIE__} = \&my_die;
 221
 222 sub _my_warn {
 223     my ($msg) = @_;
 224     chomp $msg;
 225     warning(@_);
 226 };
 227 $SIG{__WARN__} = \&my_warn;
 228
 229 # utility function for test scripts, which want to use the regular
 230 # perl mechanisms
 231 sub disable_die_override {
 232     delete $SIG{__DIE__};
 233     delete $SIG{__WARN__};
 234 }
 235
 236 push @EXPORT_OK, qw(error critical warning message info debug);
 237 push @{$EXPORT_TAGS{"logging"}}, qw(error critical warning message info debug);
 238 1;