view release on metacpan or  search on metacpan

ErrorControl.pm  view on Meta::CPAN

    my $body = 'Time: '. $formatted_date. "\n".
                'Requested URL: '. $request_url. "\n".
                'Requested By: '. $requestor. "\n\n".
                "--------------------\n".
                "Apache::ErrorControl\n\n";

    $mobj->attach(
      Data     => $body,
      Type     => 'text/plain'
    );

    # Construct Included Debug
    my %content;
    my ($headers_in, $headers_out, $err_headers_out, $subprocess_env);
    if ($r->prev()) {
      %content         =  $r->prev()->content();
      $headers_in      =  $r->prev()->headers_in();
      $headers_out     =  $r->prev()->headers_out();
      $err_headers_out =  $r->prev()->err_headers_out();
      $subprocess_env  =  $r->prev()->subprocess_env();
    }
    # NB: retrieval of POST data will only work on status 204, 304, 400, 408,
    # 411, 413, 414, 500, 501, 503 - hey one of them is 500 so im happy :D :D

    my %files = (
      headers_in      =>  $headers_in,
      headers_out     =>  $headers_out,
      err_headers_out =>  $err_headers_out,
      notes           =>  $notes,
      subprocess_env  =>  $subprocess_env,
      post_data       =>  \%content,
      env             =>  \%ENV
    );

    foreach my $file (keys %files) {
      my $string = $self->apache_table_to_string($files{$file});
      if ($string) {
        $mobj->attach(
          Data     =>  $string,
          Filename =>  $file. '.txt',
          Type     =>  'text/plain',
          Encoding =>  'base64'
        );
      }
    }

    foreach my $email_address (@email) {
      $mobj->head()->replace('To', $email_address);

      open(MTAHANDLE,"|$MTA_Prog")
        or die "Failed to open MTA: ". $MTA_Prog. ": $!\n";
      $mobj->print(\*MTAHANDLE);
      close(MTAHANDLE);
    }
  }
  # }}}


  # Send Headers {{{
  $r->content_type('text/html; charset=ISO-8859-1');
  $r->send_http_header;
  # }}}


  # Send Template {{{
  $r->print($tmpl->output());
  # }}}

  return;
}
# }}}


# Apache Table To String Function {{{
sub apache_table_to_string {
  my ($self, $table) = @_;

  return unless ($table);

  my @string = ();

  while(my($key,$val) = each %$table) {
    next unless ($key);
    my $string = sprintf("%-15s", $key);
    $string .= $val if ($val);
    push(@string, $string);
  }

  return join("\n", @string);
}
# }}}


# Find Error Template Function {{{
#  im not sure why I chose to allow so many paths/filenames but I think its
#  better to be flexiable.
sub find_error_template {
  my ($self) = @_;

  my $error_code = $self->{error_code} || undef;

  my @paths;
  if ($self->{document_root}) {
    push(@paths, $self->{document_root});
  }
  if ($self->{template_dir}) {
    push(@paths, $self->{template_dir});
  }

  foreach my $path (@paths) {
    if (defined $error_code) {
      if (-f $path. '/'. $error_code) {
        return $path. '/'. $error_code;
      } elsif (-f $path. '/'. $error_code. '.html') {
        return $path. '/'. $error_code. '.html';
      } elsif (-f $path. '/'. $error_code. '.tmpl') {
        return $path. '/'. $error_code. '.tmpl';
      }
    }
    if (-f $path. '/allerrors') {