home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / TestReport.pm < prev    next >
Encoding:
Perl POD Document  |  2004-08-06  |  3.2 KB  |  150 lines
  1. # Copyright 2001-2004 The Apache Software Foundation
  2. #
  3. # Licensed under the Apache License, Version 2.0 (the "License");
  4. # you may not use this file except in compliance with the License.
  5. # You may obtain a copy of the License at
  6. #
  7. #     http://www.apache.org/licenses/LICENSE-2.0
  8. #
  9. # Unless required by applicable law or agreed to in writing, software
  10. # distributed under the License is distributed on an "AS IS" BASIS,
  11. # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  12. # See the License for the specific language governing permissions and
  13. # limitations under the License.
  14. #
  15. package Apache::TestReport;
  16.  
  17. use strict;
  18. use warnings FATAL => 'all';
  19.  
  20. use Apache::Test ();
  21. use Apache::TestConfig ();
  22.  
  23. use File::Spec::Functions qw(catfile);
  24.  
  25. sub new {
  26.     my $class = shift;
  27.     bless { @_ }, $class;
  28. }
  29.  
  30. # generate t/REPORT script (or a different filename) which will drive
  31. # Apache::TestReport
  32. sub generate_script {
  33.     my ($class, $file) = @_;
  34.  
  35.     $file ||= catfile 't', 'REPORT';
  36.  
  37.     my $content = join "\n",
  38.         "BEGIN { eval { require blib; } }",
  39.         Apache::TestConfig->modperl_2_inc_fixup,
  40.         Apache::TestConfig->perlscript_header,
  41.         "use $class;",
  42.         "$class->new(\@ARGV)->run;";
  43.  
  44.     Apache::Test::basic_config()->write_perlscript($file, $content);
  45. }
  46.  
  47. sub replace {
  48.     my($self, $template) = @_;
  49.  
  50.     $template =~ s{\@(\w+)\@} {
  51.         my $method = lc $1;
  52.         eval { $self->$method() } || $self->{$1} || '';
  53.     }eg;
  54.  
  55.     $template;
  56. }
  57.  
  58. sub run {
  59.     my $self = shift;
  60.  
  61.     print $self->replace($self->template);
  62. }
  63.  
  64. sub config { Apache::TestConfig::as_string() }
  65.  
  66. sub report_to { 'test-dev@httpd.apache.org' }
  67.  
  68. sub postit_note {
  69.     my $self = shift;
  70.  
  71.     my($to, $where) = split '@', $self->report_to;
  72.  
  73.     return <<EOF;
  74. Note: Complete the rest of the details and post this bug report to
  75. $to <at> $where. To subscribe to the list send an empty
  76. email to $to-subscribe\@$where.
  77. EOF
  78. }
  79.  
  80. sub executable { $0 }
  81.  
  82. sub date { scalar gmtime() . " GMT" }
  83.  
  84. sub template {
  85. <<'EOI'
  86. -------------8<---------- Start Bug Report ------------8<----------
  87. 1. Problem Description:
  88.  
  89.   [DESCRIBE THE PROBLEM HERE]
  90.  
  91. 2. Used Components and their Configuration:
  92.  
  93. @CONFIG@
  94.  
  95. 3. This is the core dump trace: (if you get a core dump):
  96.  
  97.   [CORE TRACE COMES HERE]
  98.  
  99. This report was generated by @EXECUTABLE@ on @DATE@.
  100.  
  101. -------------8<---------- End Bug Report --------------8<----------
  102.  
  103. @POSTIT_NOTE@
  104.  
  105. EOI
  106.  
  107. }
  108.  
  109. 1;
  110. __END__
  111.  
  112. =head1 NAME
  113.  
  114. Apache::TestReport - A parent class for generating bug/success reports
  115.  
  116. =head1 Synopsis
  117.  
  118.   use Apache::TestReport;
  119.   Apache::TestReport->new(@ARGV)->run;
  120.  
  121. =head1 Description
  122.  
  123. This class is used to generate a bug or a success report, providing
  124. information about the system the code was running on.
  125.  
  126. =head1 Overridable Methods
  127.  
  128. =head2 config
  129.  
  130. return the information about user's system
  131.  
  132. =head2 report_to
  133.  
  134. return a string containing the email address the report should be sent
  135. to
  136.  
  137. =head2 postit_note
  138.  
  139. return a string to close the report with, e.g.:
  140.  
  141.       my($to, $where) = split '@', $self->report_to;
  142.       return <<EOF;
  143.   Note: Complete the rest of the details and post this bug report to
  144.   $to <at> $where. To subscribe to the list send an empty
  145.   email to $to-subscribe\@$where.
  146.  
  147.  
  148. =cut
  149.  
  150.