home *** CD-ROM | disk | FTP | other *** search
/ Nebula 2 / Nebula Two.iso / SourceCode / MiscKit1.7.1 / MiscKit / Examples / AutoDoc / lib / perl5 / Autodoc / LogDebug.pm < prev    next >
Encoding:
Perl POD Document  |  1995-11-02  |  4.4 KB  |  157 lines
  1. package Autodoc::LogDebug;
  2.  
  3. ###############################################################################
  4. ###############################################################################
  5. ##
  6. ##    Written by Adam Swift (c) 1995 by Friday Software and Consulting
  7. ##                           All rights reserved.
  8. ##
  9. ##      This notice may not be removed from this source code.
  10. ##
  11. ##    This program is included in the MiscKit by permission from the author
  12. ##    and its use is governed by the MiscKit license, found in the file
  13. ##    "LICENSE.rtf" in the MiscKit distribution.  Please refer to that file
  14. ##    for a list of all applicable permissions and restrictions.
  15. ##
  16. ##    Because AutoDoc is licensed free of charge, there is no warranty 
  17. ##    for the program.  Copyright holder, Friday Software and Consulting, 
  18. ##    is providing this program "as is" and this program is distributed in 
  19. ##    the hope that it will be useful, but WITHOUT ANY WARRANTY; without 
  20. ##    even the implied warranty of MERCHANTABILITY or FITNESS FOR A 
  21. ##    PARTICULAR PURPOSE.
  22. ##
  23. ###############################################################################
  24. ###############################################################################
  25.  
  26. require 5.000;
  27.  
  28. ##########################
  29. # load required packages #
  30. ##########################
  31. use Exporter;
  32.  
  33. @ISA      = qw(Exporter);
  34. @EXPORT   = qw(dblog 
  35.            dblog_debuglevel
  36.            set_dblog_debuglevel);
  37.  
  38. $module_version = '$Revision: 1.2 $';
  39. $module_version =~ s!(\$\w+: | \$)!!g;
  40. $module_id    = '$Id: LogDebug.pm,v 1.2 1995/10/20 22:16:27 aswift Exp $';
  41. $module_id      =~ s!(\$\w+: | \$)!!g;
  42. $module_name    = $module_id;
  43. $module_name    =~ s!^([^\,]+).*$!$1!;
  44.  
  45. ############################################################################
  46. # 
  47. # Purpose: Module that encapsulates logging formatted debugging messages
  48. #
  49. # HISTORY: START
  50. # $Log: LogDebug.pm,v $
  51. # Revision 1.2  1995/10/20  22:16:27  aswift
  52. # Added DevMan style changes Log support
  53. #
  54. #
  55. # HISTORY: END
  56. ############################################################################
  57.  
  58. #############################################################################
  59. #
  60. # NAME:       module_version
  61. #
  62. # ACTION:     returns the version number of this module
  63. #
  64. # RETURN:     the module version
  65. #
  66. #############################################################################
  67. sub module_version
  68. {
  69.     return $module_version;
  70. }
  71.  
  72. sub module_versionstamp
  73. {
  74.     return "$module_name (rev-$module_version)";
  75. }
  76.  
  77. #############################################################################
  78. #
  79. # NAME:       set_dblog_debuglevel
  80. #
  81. # ACTION:     Sets a global variable which determines the threshold debugging
  82. #             level to produce output to stderr in dblog()
  83. #
  84. # GLOBALS:    The debugging level $LogDebug_debuglevel
  85. #
  86. # ARGUMENTS:  A log debugging level 
  87. #
  88. #############################################################################
  89. sub set_dblog_debuglevel
  90. {
  91.     $DebugLog_debuglevel = $_[0];
  92. }
  93.  
  94.  
  95.  
  96. #############################################################################
  97. #
  98. # NAME:       dblog_debuglevel
  99. #
  100. # ACTION:     Returns the value of the global variable which determines the 
  101. #             threshold debugging level to produce output to stderr in dblog()
  102. #
  103. # GLOBALS:    The debugging level $LogDebug_debuglevel
  104. #
  105. # RETURN:     The log debugging level
  106. #
  107. #############################################################################
  108. sub dblog_debuglevel
  109. {
  110.     return 0 if (!defined($DebugLog_debuglevel));
  111.     return $DebugLog_debuglevel;
  112. }
  113.  
  114.  
  115.  
  116. #############################################################################
  117. #
  118. # NAME:       dblog
  119. #
  120. # ACTION:     If the debugging level is set higher than the number in the 
  121. #             first argument then the remaining arguments are printed 
  122. #             to stderr
  123. #
  124. # GLOBALS:    The debugging level $LogDebug_debuglevel
  125. #
  126. # ARGUMENTS:  A log debugging level 
  127. #             A list of debugging messages
  128. #
  129. #############################################################################
  130. sub dblog
  131. {
  132.     local ($loglevel, $counter, $logstars);
  133.     
  134.     $loglevel = shift @_;
  135.  
  136.     $logstars = "";
  137.     if (&dblog_debuglevel() > $loglevel) {
  138.     if ($loglevel > 0) {
  139.         for ($counter = 6; $counter > $loglevel; $counter --) {
  140.         $logstars .= "*";
  141.         }
  142.     } else {
  143.         for ($counter = 0; $counter > $loglevel; $counter --) {
  144.         $logstars .= "=";
  145.         }
  146.         $logstars .= ">";
  147.     }
  148.     
  149.     print STDERR ("$logstars ", @_, "\n");
  150.     }
  151. }
  152.  
  153.  
  154.  
  155. 1;
  156.     
  157.