View of /branches/rel-2-3-dev/webwork-modperl/lib/WeBWorK/Debug.pm

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader: webwork2/lib/WeBWorK/Debug.pm,v 1.8 2006/04/12 18:54:39 sh002i Exp $
    5 #
    6 # This program is free software; you can redistribute it and/or modify it under
    7 # the terms of either: (a) the GNU General Public License as published by the
    8 # Free Software Foundation; either version 2, or (at your option) any later
    9 # version, or (b) the "Artistic License" which comes with this package.
   10 #
   11 # This program is distributed in the hope that it will be useful, but WITHOUT
   12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
   13 # FOR A PARTICULAR PURPOSE.  See either the GNU General Public License or the
   14 # Artistic License for more details.
   15 ################################################################################
   16 
   17 package WeBWorK::Debug;
   18 use base qw(Exporter);
   19 use Date::Format;
   20 our @EXPORT = qw(debug);
   21 
   22 =head1 NAME
   23 
   24 WeBWorK::Debug - Print (or don't print) debugging output.
   25 
   26 head1 SYNOPSIS
   27 
   28  use WeBWorK::Debug;
   29 
   30  # Enable debugging
   31  $WeBWorK::Debug::Enabled = 1;
   32 
   33  # Log to a file instead of STDERR
   34  $WeBWorK::Debug::Logfile = "/path/to/debug.log";
   35 
   36  # log some debugging output
   37  debug("Generated 5 widgets.");
   38 
   39 =cut
   40 
   41 use strict;
   42 use warnings;
   43 use Time::HiRes qw/gettimeofday/;
   44 use WeBWorK::Constants;
   45 use WeBWorK::Utils qw/undefstr/;
   46 
   47 ################################################################################
   48 
   49 =head1 CONFIGURATION VARIABLES
   50 
   51 =over
   52 
   53 =item $Enabled
   54 
   55 If true, debugging messages will be output. If false, they will be ignored.
   56 
   57 =cut
   58 
   59 our $Enabled = 0 unless defined $Enabled;
   60 
   61 =item $Logfile
   62 
   63 If non-empty, debugging output will be sent to the file named rather than STDERR.
   64 
   65 =cut
   66 
   67 our $Logfile = "" unless defined $Logfile;
   68 
   69 =item $DenySubroutineOutput
   70 
   71 If defined, prevent subroutines matching the following regular expression from
   72 logging.
   73 
   74 =cut
   75 
   76 our $DenySubroutineOutput;
   77 
   78 =item $AllowSubroutineOutput
   79 
   80 If defined, allow only subroutines matching the following regular expression to
   81 log.
   82 
   83 =cut
   84 
   85 our $AllowSubroutineOutput;
   86 
   87 =back
   88 
   89 =cut
   90 
   91 ################################################################################
   92 
   93 =head1 FUNCTIONS
   94 
   95 =over
   96 
   97 =item debug(@messages)
   98 
   99 Write @messages to the debugging log.
  100 
  101 =cut
  102 
  103 sub debug {
  104   my (@message) = undefstr("###UNDEF###", @_);
  105 
  106   if ($Enabled) {
  107     my ($package, $filename, $line, $subroutine) = caller(1);
  108     return if defined $AllowSubroutineOutput and not $subroutine =~ m/$AllowSubroutineOutput/;
  109     return if defined $DenySubroutineOutput and $subroutine =~ m/$DenySubroutineOutput/;
  110 
  111     my ($sec, $msec) = gettimeofday;
  112     my $date = time2str("%a %b %d %H:%M:%S.$msec %Y", $sec);
  113     my $finalMessage = "[$date] $subroutine: " . join("", @message);
  114     $finalMessage .= "\n" unless $finalMessage =~ m/\n$/;
  115 
  116     if ($WeBWorK::Debug::Logfile ne "") {
  117       if (open my $fh, ">>", $Logfile) {
  118         print $fh $finalMessage;
  119         close $fh;
  120       } else {
  121         warn "Failed to open debug log '$Logfile' in append mode: $!";
  122         print STDERR $finalMessage;
  123       }
  124     } else {
  125       print STDERR $finalMessage;
  126     }
  127   }
  128 }
  129 
  130 =back
  131 
  132 =cut
  133 
  134 ################################################################################
  135 
  136 =head1 AUTHOR
  137 
  138 Written by Sam Hathaway, sh002i (at) math.rochester.edu.
  139 
  140 =cut
  141 
  142 1;