PageRenderTime 814ms CodeModel.GetById 75ms RepoModel.GetById 19ms app.codeStats 0ms

/IronPython_Main/Runtime/Tests/LinqDlrTests/testenv/perl/site/lib/LWP/Debug.pm

#
Perl | 129 lines | 92 code | 31 blank | 6 comment | 13 complexity | 98be3905c8708dd404a5ed1a476e238a MD5 | raw file
Possible License(s): GPL-2.0, MPL-2.0-no-copyleft-exception, CPL-1.0, CC-BY-SA-3.0, BSD-3-Clause, ISC, AGPL-3.0, LGPL-2.1, Apache-2.0
  1. #!/usr/local/bin/perl -w
  2. #
  3. # $Id: Debug.pm,v 1.12 1997/12/02 13:22:52 aas Exp $
  4. #
  5. package LWP::Debug;
  6. =head1 NAME
  7. LWP::Debug - debug routines for the libwww-perl library
  8. =head1 SYNOPSIS
  9. use LWP::Debug qw(+ -conns);
  10. # Used internally in the library
  11. LWP::Debug::trace('send()');
  12. LWP::Debug::debug('url ok');
  13. LWP::Debug::conns("read $n bytes: $data");
  14. =head1 DESCRIPTION
  15. LWP::Debug provides tracing facilities. The trace(), debug() and
  16. conns() function are called within the library and they log
  17. information at increasing levels of detail. Which level of detail is
  18. actually printed is controlled with the C<level()> function.
  19. The following functions are available:
  20. =over 4
  21. =item level(...)
  22. The C<level()> function controls the level of detail being
  23. logged. Passing '+' or '-' indicates full and no logging
  24. respectively. Inidividual levels can switched on and of by passing the
  25. name of the level with a '+' or '-' prepended. The levels are:
  26. trace : trace function calls
  27. debug : print debug messages
  28. conns : show all data transfered over the connections
  29. The LWP::Debug module provide a special import() method that allows
  30. you to pass the level() arguments with initial use statement. If a
  31. use argument start with '+' or '-' then it is passed to the level
  32. function, else the name is exported as usual. The following two
  33. statements are thus equivalent (if you ignore that the second pollutes
  34. your namespace):
  35. use LWP::Debug qw(+);
  36. use LWP::Debug qw(level); level('+');
  37. =item trace($msg)
  38. The C<trace()> function is used for tracing function
  39. calls. The package and calling subroutine name is
  40. printed along with the passed argument. This should
  41. be called at the start of every major function.
  42. =item debug($msg)
  43. The C<debug()> function is used for high-granularity
  44. reporting of state in functions.
  45. =item conns($msg)
  46. The C<conns()> function is used to show data being
  47. transferred over the connections. This may generate
  48. considerable output.
  49. =back
  50. =cut
  51. require Exporter;
  52. @ISA = qw(Exporter);
  53. @EXPORT_OK = qw(level trace debug conns);
  54. use Carp ();
  55. my @levels = qw(trace debug conns);
  56. %current_level = ();
  57. sub import
  58. {
  59. my $pack = shift;
  60. my $callpkg = caller(0);
  61. my @symbols = ();
  62. my @levels = ();
  63. for (@_) {
  64. if (/^[-+]/) {
  65. push(@levels, $_);
  66. } else {
  67. push(@symbols, $_);
  68. }
  69. }
  70. Exporter::export($pack, $callpkg, @symbols);
  71. level(@levels);
  72. }
  73. sub level
  74. {
  75. for (@_) {
  76. if ($_ eq '+') { # all on
  77. # switch on all levels
  78. %current_level = map { $_ => 1 } @levels;
  79. } elsif ($_ eq '-') { # all off
  80. %current_level = ();
  81. } elsif (/^([-+])(\w+)$/) {
  82. $current_level{$2} = $1 eq '+';
  83. } else {
  84. Carp::croak("Illegal level format $_");
  85. }
  86. }
  87. }
  88. sub trace { _log(@_) if $current_level{'trace'}; }
  89. sub debug { _log(@_) if $current_level{'debug'}; }
  90. sub conns { _log(@_) if $current_level{'conns'}; }
  91. sub _log
  92. {
  93. my $msg = shift;
  94. $msg .= "\n" unless $msg =~ /\n$/; # ensure trailing "\n"
  95. my($package,$filename,$line,$sub) = caller(2);
  96. print STDERR "$sub: $msg";
  97. }
  98. 1;