home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / Exceptions.pm < prev    next >
Encoding:
Perl POD Document  |  2003-12-12  |  15.4 KB  |  625 lines
  1. package HTML::Mason::Exceptions;
  2.  
  3. use strict;
  4.  
  5. use vars qw($VERSION);
  6.  
  7. $VERSION = 1.43;
  8.  
  9. my %e;
  10.  
  11. BEGIN
  12. {
  13.     %e = ( 'HTML::Mason::Exception' =>
  14.        { description => 'generic base class for all Mason exceptions',
  15.          alias => 'error'},
  16.  
  17.        'HTML::Mason::Exception::Abort' =>
  18.        { isa => 'HTML::Mason::Exception',
  19.          fields => [qw(aborted_value)],
  20.          description => 'a component called $m->abort' },
  21.  
  22.        'HTML::Mason::Exception::Decline' =>
  23.        { isa => 'HTML::Mason::Exception',
  24.          fields => [qw(declined_value)],
  25.          description => 'a component called $m->decline' },
  26.  
  27.        'HTML::Mason::Exception::Compiler' =>
  28.        { isa => 'HTML::Mason::Exception',
  29.          alias => 'compiler_error',
  30.          description => 'error thrown from the compiler' },
  31.  
  32.        'HTML::Mason::Exception::Compilation' =>
  33.        { isa => 'HTML::Mason::Exception',
  34.          alias => 'compilation_error',
  35.          fields => [qw(filename)],
  36.          description => "error thrown in eval of the code for a component" },
  37.  
  38.        'HTML::Mason::Exception::Compilation::IncompatibleCompiler' =>
  39.        { isa => 'HTML::Mason::Exception',
  40.          alias => 'wrong_compiler_error',
  41.          description => "a component was compiled by a compiler/lexer with incompatible options.  recompilation is needed" },
  42.  
  43.        'HTML::Mason::Exception::Params' =>
  44.        { isa => 'HTML::Mason::Exception',
  45.          alias => 'param_error',
  46.          description => 'invalid parameters were given to a method/function' },
  47.  
  48.        'HTML::Mason::Exception::Syntax' =>
  49.        { isa => 'HTML::Mason::Exception',
  50.          alias => 'syntax_error',
  51.          fields => [qw(source_line comp_name line_number)],
  52.          description => 'invalid syntax was found in a component' },
  53.  
  54.        'HTML::Mason::Exception::System' =>
  55.        { isa => 'HTML::Mason::Exception',
  56.          alias => 'system_error',
  57.          description => 'a system call of some sort failed' },
  58.  
  59.        'HTML::Mason::Exception::TopLevelNotFound' =>
  60.        { isa => 'HTML::Mason::Exception',
  61.          alias => 'top_level_not_found_error',
  62.          description => 'the top level component could not be found' },
  63.  
  64.        'HTML::Mason::Exception::VirtualMethod' =>
  65.        { isa => 'HTML::Mason::Exception',
  66.          alias => 'virtual_error',
  67.          description => 'a virtual method was not overridden' },
  68.  
  69.      );
  70. }
  71.  
  72. use Exception::Class (%e);
  73.  
  74. HTML::Mason::Exception->Trace(1);
  75.  
  76. # To avoid circular reference between exception and request.
  77. HTML::Mason::Exception->NoRefs(1);
  78.  
  79. # The import() method allows this:
  80. #  use HTML::Mason::Exceptions(abbr => ['error1', 'error2', ...]);
  81. # ...
  82. #  error1 "something went wrong";
  83.  
  84. sub import
  85. {
  86.     my ($class, %args) = @_;
  87.  
  88.     my $caller = caller;
  89.     if ($args{abbr})
  90.     {
  91.     foreach my $name (@{$args{abbr}})
  92.     {
  93.         no strict 'refs';
  94.         die "Unknown exception abbreviation '$name'" unless defined &{$name};
  95.         *{"${caller}::$name"} = \&{$name};
  96.     }
  97.     }
  98.     {
  99.     no strict 'refs';
  100.     *{"${caller}::isa_mason_exception"} = \&isa_mason_exception;
  101.     *{"${caller}::rethrow_exception"} = \&rethrow_exception;
  102.     }
  103. }
  104.  
  105. sub isa_mason_exception
  106. {
  107.     my ($err, $name) = @_;
  108.     return unless defined $err;
  109.  
  110.     if ($name) {
  111.     my $class = "HTML::Mason::Exception::$name";
  112.     no strict 'refs';
  113.     die "no such exception class $class" unless defined(${"${class}::VERSION"});
  114.     return UNIVERSAL::isa($err, "HTML::Mason::Exception::$name");
  115.     } else {
  116.     return UNIVERSAL::isa($err, "HTML::Mason::Exception");
  117.     }
  118. }
  119.  
  120. sub rethrow_exception
  121. {
  122.     my ($err) = @_;
  123.     return unless $err;
  124.  
  125.     if ( UNIVERSAL::can($err, 'rethrow') ) {
  126.     $err->rethrow;
  127.     }
  128.     elsif ( ref $err ) {
  129.         die $err;
  130.     }
  131.     HTML::Mason::Exception->throw(error => $err);
  132. }
  133.  
  134. package HTML::Mason::Exception;
  135.  
  136. use HTML::Mason::MethodMaker
  137.     ( read_write => [ qw ( format ) ] );
  138.  
  139. sub new
  140. {
  141.     my ($class, %params) = @_;
  142.  
  143.     my $self = $class->SUPER::new(%params);
  144.     $self->format('text');
  145.     return $self;
  146. }
  147.  
  148. # If we create a new exception from a Mason exception, just use the
  149. # short error message, not the stringified exception. Otherwise
  150. # exceptions can get stringified more than once.
  151. sub throw
  152. {
  153.     my $class = shift;
  154.     my %params = @_ == 1 ? ( error => $_[0] ) : @_;
  155.  
  156.     if (HTML::Mason::Exceptions::isa_mason_exception($params{error})) {
  157.     $params{error} = $params{error}->error;
  158.     }
  159.     if (HTML::Mason::Exceptions::isa_mason_exception($params{message})) {
  160.     $params{message} = $params{message}->error;
  161.     }
  162.     $class->SUPER::throw(%params);
  163. }
  164.  
  165. sub filtered_frames
  166. {
  167.     my ($self) = @_;
  168.  
  169.     my (@frames);
  170.     my $trace = $self->trace;
  171.     my %ignore_subs = map { $_ => 1 }
  172.     qw[
  173.        (eval)
  174.        Exception::Class::Base::throw
  175.        Exception::Class::__ANON__
  176.        HTML::Mason::Commands::__ANON__
  177.        HTML::Mason::Component::run
  178.        HTML::Mason::Exception::throw
  179.        HTML::Mason::Exceptions::__ANON__
  180.        HTML::Mason::Request::_run_comp
  181.        ];
  182.     while (my $frame = $trace->next_frame)
  183.     {
  184.     last if ($frame->subroutine eq 'HTML::Mason::Request::exec');
  185.     unless ($frame->filename =~ /Mason\/Exceptions\.pm/ or
  186.         $ignore_subs{ $frame->subroutine } or
  187.         ($frame->subroutine eq 'HTML::Mason::Request::comp' and $frame->filename =~ /Request\.pm/)) {
  188.         push(@frames, $frame);
  189.     }
  190.     }
  191.     @frames = grep { $_->filename !~ /Mason\/Exceptions\.pm/ } $trace->frames if !@frames;
  192.     return @frames;
  193. }
  194.  
  195. sub analyze_error
  196. {
  197.     my ($self) = @_;
  198.     my ($file, @lines, @frames);
  199.  
  200.     return $self->{_info} if $self->{_info};
  201.  
  202.     @frames = $self->filtered_frames;
  203.     if ($self->isa('HTML::Mason::Exception::Syntax')) {
  204.     $file = $self->comp_name;
  205.     push(@lines, $self->line_number);
  206.     } elsif ($self->isa('HTML::Mason::Exception::Compilation')) {
  207.     $file = $self->filename;
  208.     my $msg = $self->full_message;
  209.     while ($msg =~ /at .* line (\d+)./g) {
  210.         push(@lines, $1);
  211.     }
  212.     } elsif (@frames) {
  213.     $file = $frames[0]->filename;
  214.     @lines = $frames[0]->line;
  215.     }
  216.     my @context;
  217.     @context = $self->get_file_context($file, \@lines) if @lines;
  218.  
  219.     $self->{_info} = {
  220.     file    => $file,
  221.     frames  => \@frames,
  222.     lines   => \@lines,
  223.     context => \@context,
  224.     };
  225.     return $self->{_info};
  226. }
  227.  
  228. sub get_file_context
  229. {
  230.     my ($self, $file, $line_nums) = @_;
  231.  
  232.     my @context;
  233.     my $fh = do { local *FH; *FH; };
  234.     unless (defined($file) and open($fh, $file)) {
  235.     @context = (['unable to open file', '']);
  236.     } else {
  237.     # Put the file into a list, indexed at 1.
  238.     my @file = <$fh>;
  239.     chomp(@file);
  240.     unshift(@file, undef);
  241.  
  242.     # Mark the important context lines.
  243.     # We do this by going through the error lines and incrementing hash keys to
  244.     # keep track of which lines we eventually need to print, and we color the
  245.     # line which the error actually occured on in red.
  246.     my (%marks, %red);
  247.     my $delta = 4;
  248.     foreach my $line_num (@$line_nums) {
  249.         foreach my $l (($line_num - $delta) .. ($line_num + $delta)) {
  250.         next if ($l <= 0 or $l > @file);
  251.         $marks{$l}++;
  252.         }
  253.         $red{$line_num} = 1;
  254.     }
  255.  
  256.     # Create the context list.
  257.     # By going through the keys of the %marks hash, we can tell which lines need
  258.     # to be printed. We add a '...' line if we skip numbers in the context.
  259.     my $last_num = 0;
  260.     foreach my $line_num (sort { $a <=> $b } keys %marks) {
  261.         push(@context, ["...", "", 0]) unless $last_num == ($line_num - 1);
  262.         push(@context, ["$line_num:", $file[$line_num], $red{$line_num}]);;
  263.         $last_num = $line_num;
  264.     }
  265.     push(@context, ["...", "", 0]) unless $last_num == @file;
  266.     close $fh;
  267.     }
  268.     return @context;
  269. }
  270.  
  271. # basically the same as as_string in Exception::Class::Base
  272. sub raw_text
  273. {
  274.     my ($self) = @_;
  275.  
  276.     return $self->full_message . "\n\n" . $self->trace->as_string;
  277. }
  278.  
  279. sub as_string
  280. {
  281.     my ($self) = @_;
  282.  
  283.     my $stringify_function = "as_" . $self->{format};
  284.     return $self->$stringify_function();
  285. }
  286.  
  287. sub as_brief
  288. {
  289.     my ($self) = @_;
  290.     return $self->full_message;
  291. }
  292.  
  293. sub as_line
  294. {
  295.     my ($self) = @_;
  296.     my $info = $self->analyze_error;
  297.  
  298.     (my $msg = $self->full_message) =~ s/\n/\t/g;
  299.     my $stack = join(", ", map { sprintf("[%s:%d]", $_->filename, $_->line) } @{$info->{frames}});
  300.     return sprintf("%s\tStack: %s\n", $msg, $stack);
  301. }
  302.  
  303. sub as_text
  304. {
  305.     my ($self) = @_;
  306.     my $info = $self->analyze_error;
  307.  
  308.     my $msg = $self->full_message;
  309.     my $stack = join("\n", map { sprintf("  [%s:%d]", $_->filename, $_->line) } @{$info->{frames}});
  310.     return sprintf("%s\nStack:\n%s\n", $msg, $stack);
  311. }
  312.  
  313. sub as_html
  314. {
  315.     my ($self) = @_;
  316.  
  317.     my $out;
  318.     my $interp = HTML::Mason::Interp->new(out_method => \$out);
  319.  
  320.     # Can't use |h escape in here because if we fail to load
  321.     # HTML::Entities we end up in an endless loop.
  322.     my $comp = $interp->make_component(comp_source => <<'EOF');
  323.  
  324. <%args>
  325.  $msg
  326.  $info
  327.  $error
  328. </%args>
  329. <%filter>
  330.  s/(<td [^\>]+>)/$1<font face="Verdana, Arial, Helvetica, sans-serif" size="-2">/g;
  331.  s/<\/td>/<\/font><\/td>/g;
  332. </%filter>
  333.  
  334. % HTML::Mason::Escapes::basic_html_escape(\$msg);
  335. % $msg =~ s/\n/<br>/g;
  336.  
  337. <html><body>
  338.  
  339. <p align="center"><font face="Verdana, Arial, Helvetica, sans-serif"><b>System error</b></font></p>
  340. <table border="0" cellspacing="0" cellpadding="1">
  341.  <tr>
  342.   <td nowrap="nowrap" align="left" valign="top"><b>error:</b> </td>
  343.   <td align="left" valign="top"><% $msg %></td>
  344.  </tr>
  345.  <tr>
  346.   <td nowrap="nowrap" align="left" valign="top"><b>context:</b> </td>
  347.   <td align="left" valign="top" nowrap="nowrap">
  348.    <table border="0" cellpadding="0" cellspacing="0">
  349.  
  350. %   foreach my $entry (@{$info->{context}}) {
  351. %    my ($line_num, $line, $highlight) = @$entry;
  352. %    $line = '' unless defined $line;
  353. %       HTML::Mason::Escapes::basic_html_escape(\$line);
  354.     <tr>
  355.      <td nowrap="nowrap" align="left" valign="top"><b><% $line_num %></b> </td>
  356.      <td align="left" valign="top" nowrap="nowrap"><% $highlight ? "<font color=red>" : "" %><% $line %><% $highlight ? "</font>" : "" %></td>
  357.     </tr>
  358.  
  359. %    }
  360.  
  361.    </table>
  362.   </td>
  363.  </tr>
  364.  <tr>
  365.   <td align="left" valign="top" nowrap="nowrap"><b>code stack:</b> </td>
  366.   <td align="left" valign="top" nowrap="nowrap">
  367. %    foreach my $frame (@{$info->{frames}}) {
  368. %        my $f = $frame->filename; HTML::Mason::Escapes::basic_html_escape(\$f);
  369. %        my $l = $frame->line; HTML::Mason::Escapes::basic_html_escape(\$l);
  370.     <% $f %>:<% $l %><br>
  371. %    }
  372.   </td>
  373.  </tr>
  374. </table>
  375.  
  376. <a href="#raw">raw error</a><br>
  377.  
  378. <br>
  379. <br>
  380. <br>
  381. <br>
  382. <br>
  383. <br>
  384. <br>
  385. <br>
  386. <br>
  387. <br>
  388. <br>
  389. <br>
  390. <br>
  391. <br>
  392. <br>
  393. <br>
  394. <br>
  395. <br>
  396. <br>
  397. <br>
  398. <br>
  399. <br>
  400. <br>
  401. <br>
  402. <br>
  403. <br>
  404. <br>
  405. <br>
  406. <br>
  407. <br>
  408.  
  409. % my $raw = $error->raw_text;
  410. % HTML::Mason::Escapes::basic_html_escape(\$raw);
  411. % $raw =~ s/\t//g;
  412.  
  413. <a name="raw"></a>
  414.  
  415. <pre><% $raw %></pre>
  416.  
  417. </body></html>
  418. EOF
  419.  
  420.     $interp->exec($comp,
  421.                   msg => $self->full_message,
  422.                   info => $self->analyze_error,
  423.                   error => $self);
  424.  
  425.     return $out;
  426. }
  427.  
  428. package HTML::Mason::Exception::Compilation;
  429.  
  430. sub full_message
  431. {
  432.     my $self = shift;
  433.  
  434.     return sprintf("Error during compilation of %s:\n%s\n", $self->filename || '', $self->message || '');
  435. }
  436.  
  437. package HTML::Mason::Exception::Syntax;
  438.  
  439. sub full_message
  440. {
  441.     my $self = shift;
  442.  
  443.     return sprintf("%s at %s line %d", $self->message || '', $self->comp_name || '', $self->line_number);
  444. }
  445.  
  446. 1;
  447.  
  448. __END__
  449.  
  450. =head1 NAME
  451.  
  452. HTML::Mason::Exceptions - Exception objects thrown by Mason
  453.  
  454. =head1 SYNOPSIS
  455.  
  456.   use HTML::Mason::Exceptions ( abbr => [ qw(system_error) ] );
  457.  
  458.   open FH, 'foo' or system_error "cannot open foo: $!";
  459.  
  460. =head1 DESCRIPTION
  461.  
  462. This module creates the hierarchy of exception objects used by Mason,
  463. and provides some extra methods for them beyond those provided by
  464. C<Exception::Class>
  465.  
  466. =head1 IMPORT
  467.  
  468. When this module is imported, it is possible to specify a list of
  469. abbreviated function names that you want to use to throw exceptions.
  470. In the L<SYNOPSIS|/SYNOPSIS> example, we use the C<system_error>
  471. function to throw a C<HTML::Mason::Exception::System> exception.
  472.  
  473. These abbreviated functions do not allow you to set additional fields
  474. in the exception, only the message.
  475.  
  476. =head1 EXCEPTIONS
  477.  
  478. =over
  479.  
  480. =item HTML::Mason::Exception
  481.  
  482. This is the parent class for all exceptions thrown by Mason.  Mason
  483. sometimes throws exceptions in this class when we could not find a
  484. better category for the message.
  485.  
  486. Abbreviated as C<error>
  487.  
  488. =item HTML::Mason::Exception::Abort
  489.  
  490. The C<< $m->abort >> method was called.
  491.  
  492. Exceptions in this class contain the field C<aborted_value>.
  493.  
  494. =item HTML::Mason::Exception::Decline
  495.  
  496. The C<< $m->decline >> method was called.
  497.  
  498. Exceptions in this class contain the field C<declined_value>.
  499.  
  500. =item HTML::Mason::Exception::Compilation
  501.  
  502. An exception occurred when attempting to C<eval> an existing object
  503. file.
  504.  
  505. Exceptions in this class have the field C<filename>, which indicates
  506. what file contained the code that caused the error.
  507.  
  508. Abbreviated as C<compilation_error>.
  509.  
  510. =item HTML::Mason::Exception::Compiler
  511.  
  512. The compiler threw an exception because it received incorrect input.
  513. For example, this would be thrown if the lexer told the compiler to
  514. initialize compilation while it was in the middle of compiling another
  515. component.
  516.  
  517. Abbreviated as C<compiler_error>.
  518.  
  519. =item HTML::Mason::Exception::Compilation::IncompatibleCompiler
  520.  
  521. A component was compiled by a compiler or lexer with incompatible
  522. options.  This is used to tell Mason to recompile a component.
  523.  
  524. Abbreviated as C<wrong_compiler_error>.
  525.  
  526. =item HTML::Mason::Exception::Params
  527.  
  528. Invalid parameters were passed to a method or function.
  529.  
  530. Abbreviated as C<param_error>.
  531.  
  532. =item HTML::Mason::Exception::Syntax
  533.  
  534. This exception indicates that a component contained invalid syntax.
  535.  
  536. Exceptions in this class have the fields C<source_line>, which is the
  537. actual source where the error was found, C<comp_name>, and
  538. C<line_number>.
  539.  
  540. Abbreviated as C<syntax_error>.
  541.  
  542. =item HTML::Mason::Exception::System
  543.  
  544. A system call of some sort, such as a file open, failed.
  545.  
  546. Abbreviated as C<system_error>.
  547.  
  548. =item HTML::Mason::Exception::TopLevelNotFound
  549.  
  550. The requested top level component could not be found.
  551.  
  552. Abbreviated as C<top_level_not_found_error>.
  553.  
  554. =item HTML::Mason::VirtualMethod
  555.  
  556. Some piece of code attempted to call a virtual method which was not
  557. overridden.
  558.  
  559. Abbreviated as C<virtual_error>
  560.  
  561. =back
  562.  
  563. =head1 FIELDS
  564.  
  565. Some of the exceptions mentioned above have additional fields, which
  566. are available via accessors.  For example, to get the line number of
  567. an C<HTML::Mason::Exception::Syntax> exception, you call the
  568. C<line_number> method on the exception object.
  569.  
  570. =head1 EXCEPTION METHODS
  571.  
  572. All of the Mason exceptions implement the following methods:
  573.  
  574. =over
  575.  
  576. =item as_brief
  577.  
  578. This simply returns the exception message, without any trace information.
  579.  
  580. =item as_line
  581.  
  582. This returns the exception message and its trace information, all on a
  583. single line with tabs between the message and each frame of the stack
  584. trace.
  585.  
  586. =item as_text
  587.  
  588. This returns the exception message and stack information, with each
  589. frame on a separate line.
  590.  
  591. =item as_html
  592.  
  593. This returns the exception message and stack as an HTML page.
  594.  
  595. =back
  596.  
  597. Each of these methods corresponds to a valid error_format parameter
  598. for the L<Request object|HTML::Mason::Request> such as C<text> or
  599. C<html>.
  600.  
  601. You can create your own method in the C<HTML::Mason::Exception>
  602. namespace, such as C<as_you_wish>, in which case you could set this
  603. parameter to "you_wish".  This method will receive a single argument,
  604. the exception object, and is expected to return some sort of string
  605. containing the formatted error message.
  606.  
  607. =head1 EXCEPTION CLASS CHECKING
  608.  
  609. This module also exports the C<isa_mason_exception> function.  This
  610. function takes the exception object and an optional string parameter
  611. indicating what subclass to check for.
  612.  
  613. So it can be called either as:
  614.  
  615.   if ( isa_mason_exception($@) ) { ... }
  616.  
  617. or
  618.  
  619.   if ( isa_mason_exception($@, 'Syntax') ) { ... }
  620.  
  621. Note that when specifying a subclass you should not include the
  622. leading "HTML::Mason::Exception::" portion of the class name.
  623.  
  624. =cut
  625.