view release on metacpan or  search on metacpan

lib/Tripletail/Error.pm  view on Meta::CPAN

# -----------------------------------------------------------------------------
# Tripletail::Error - 内部クラス
# -----------------------------------------------------------------------------
package Tripletail::Error;
use strict;
use warnings;
use Data::Dumper;
#use Smart::Comments;
use Tripletail;
use overload
  '""'     => \&_stringify,
  fallback => 1;

sub _POST_REQUEST_HOOK_PRIORITY() { 2_000_000_000 } # Debug よりも後

my $PADWALKER_AVAILABLE; # PadWalker が利用可能であるかどうか。undef / 1 / 0

my $VARIABLE_LENGTH_LIMIT = 32 * 1024; # 1変数あたりの表示する最大長 (バイト)

my $DEFAULT_ERROR_TEMPLATE = &__load_default_error_template();

my $TRACE_ALLOWANCE_OF_CURRENT_REQUEST;

# 最後に発生した DB のエラー。内容は任意のハッシュ。
our $LAST_DB_ERROR;

1;

# -----------------------------------------------------------------------------
# $TL->newError($type, $msg);
# $TL->newError($type, $msg, $title);
#
sub _new {
	# スタックトレースを持った例外オブジェクトを生成する。
	# 返されたインスタンスは "" 演算子によって文字列化が可能である。
	my $class = shift;
	my $type = shift; # 'error' / 'warn' / 'file-update' / 'memory-leak'
	my $msg = shift; # $@
	my $title = shift; # 任意の文字列
	my $this = bless {} => $class;

	$this->{message} = $msg;
	$this->{type} = $type;
	$this->{title} = $title || "Error: $msg";
	$this->{frames} = []; # Tripletail::Error::Frame
	$this->{source} = {}; # ファイルパス => 中身
	$this->{show_trace} = undef;
	$this->{show_vars}  = undef;
	$this->{show_src}   = undef;
	$this->{suppress_internal} = 1;
	$this->{appear} = 'sudden'; # sudden/usertrap
	$this->{on_require} = undef; # undef/1.
	$this->{http_status_code} = undef;
	$this->{http_status_line} = undef;
	$this->{db_error} = undef;

	if( $msg =~ /: we are getting too large (file|request) which exceeds the limit. |: Post Error: request size was too big to accept. / )
	{
		$this->{http_status_code} = 413;
		$this->{http_status_line} = "413 Request Entity Too Large";
	}else
	{
		$this->{http_status_code} = 500;
		$this->{http_status_line} = "500 Internal Server Error";
	}

	my $switch = $TL->INI->get(TL => 'stacktrace', 'onlystack');
	if ($switch eq 'none') {
		# skip
	}
	elsif ($switch eq 'onlystack') {
		$this->{show_trace} = 1;
	}
	elsif ($switch eq 'full') {
		$this->{show_trace} = 1;
		$this->{show_vars}  = 1;
		$this->{show_src}   = 1;
	}
	else {
		die "Unknown stacktrace type: $switch (stacktraceの指定が不正です)";
	}

	if ($this->{show_trace} and not $this->is_trace_allowed) {
		$this->{show_trace} = undef;
	}

	if ($this->{show_trace}) {
		# TLのdieハンドラから呼ばれるかも知れないので、無限再帰を防ぐ。
		local $SIG{__DIE__} = 'DEFAULT';
		local($@);
		eval {
			$this->_fetch_frames;
		};
		if ($@) {
			print STDERR $@;
			exit 1;
		}
	}

    if (our $LAST_DB_ERROR) {
        $this->{db_error} = $LAST_DB_ERROR->force;
    }

    $TL->setHook(
        'postRequest',
        _POST_REQUEST_HOOK_PRIORITY,
        sub {
            $TRACE_ALLOWANCE_OF_CURRENT_REQUEST = undef;
        });

	$this;
}

sub type {
	shift->{type};
}

sub title {
	shift->{title};
}

sub message {
	my $this = shift;
	my $new  = shift;

	if ($new) {
		$this->{message} = $new;
	}
	$this->{message};
}

sub _fetch_frames {
	my $this = shift;

	if (not defined $PADWALKER_AVAILABLE) {
		eval {
			require PadWalker;
		};
		$PADWALKER_AVAILABLE = ($@ ? 0 : 1);
	}

	my $found_die_handler;
	my $level = 0;
	my $pad_level = 0;
	
	$this->{appear} = 'sudden'; # sudden/usertrap
	for (my $i = 0; my @c = caller $i; $i++) {
		my ($package, $filename, $line, $sub, $hasargs,
			$wantarray, $evaltext, $is_require, $hints, $bitmask) = @c;

		if ($sub =~ /^Tripletail::__die_handler_for_(localeval|startup)$/) {
			$sub = 'Tripletail::((die handler))';
			
			$found_die_handler = 1;
		}
		elsif ($sub eq '(eval)') {
			if ($is_require) {
				$sub = "((require/use $package))";
				if( $this->{appear} eq 'sudden' )
				{
					$this->{on_require} = 1;
				}
			}
			else {
				if( $this->{appear} eq 'sudden' && $package!~/^Tripletail\b/ )
				{
					$this->{appear} = 'usertrap';
				}
				if (defined $evaltext) {
					$evaltext =~ s!\s*|\s*!!g;
					if (length($evaltext) > 30) {
						substr($evaltext, 27) = '...';
					}
					$sub = sprintf '((eval "%s"))', $evaltext;
				}
				else {
					$sub = '((eval))';
				}
			}
			$sub = $package . '::' . $sub;
		}

		if ($hasargs) {
			$pad_level++;
		}
		else {
			next; # 関数呼出しのみ考慮。evalで作られたフレームは飛ばす。
			# peek_my/peek_our でも eval のフレームは飛ばされる。
			# (pod には取る引数が caller と同じだと書いてあるけど嘘…)
		}

		$this->{suppress_internal} and not $found_die_handler
		  and next; # まだ die ハンドラが見えていない

		my $frame = Tripletail::Error::Frame->new(
			$level++, $filename, $line, $sub);

		if ($this->{show_vars} and $PADWALKER_AVAILABLE) {
			# ローカル変数を取得
			my $mines = PadWalker::peek_my($pad_level);
			my $ours  = PadWalker::peek_our($pad_level);

			while (my ($name, $ref) = each %$mines) {
				$frame->set_variable("my $name", $ref);
			}

			while (my ($name, $ref) = each %$ours) {
				$frame->set_variable("our $name", $ref);
			}

			#my @args;
			#do {
			#	package DB;
			#	@c = caller $i + 1;
			#	@args = @DB::args;
			#};
			#$frame->set_variable('@_', \@args);
		}

		if ($this->{show_src}) {
			# ソースコードを取得
			if (not exists $this->{source}{$filename}) {
				my $src;
				if (-r $filename) {
					$src = $TL->readTextFile($filename);
				}
				$this->{source}{$filename} = $src;
			}
		}

		push @{$this->{frames}}, $frame;
	}
}

sub is_trace_allowed {
	my $this = shift;

    if (defined(my $ret = $TRACE_ALLOWANCE_OF_CURRENT_REQUEST)) {
        $ret;
    }
    else {
        my $ret;

        my $masks = $TL->INI->get(TL => stackallow => '');

        if (my $remote = $ENV{REMOTE_ADDR}) {
            if($TL->newValue->set($remote)->isIpAddress($masks)) {
                # マッチした
                $TL->log(__PACKAGE__,
                         "[$remote] matched to [$masks]. stack trace is allowed");
                
                $ret = 1;
            }
            else {
                # どれにもマッチしなかった。
                $TL->log(
                    __PACKAGE__, sprintf(
                        "[%s] didn't match to any of [%s]. stack trace is not allowed",
                        $remote, $masks));
                
                $ret = 0;

lib/Tripletail/Error.pm  view on Meta::CPAN

		   );
	}
	# ソース
	foreach my $fpath (keys %{$this->{source}}) {
		$this->_foreach_source_line(
			$fpath, sub {
				my ($linenum, $src) = @_;

				$src = $TL->escapeJs($src);
				$src =~ s!</script>!</sc"+"ript>!i;
		
				$t->node('scripts')->node('js-src')->node('line')->setAttr(
					LINE => 'raw',
				   );
				$t->node('scripts')->node('js-src')->node('line')->add(
					LINE => $src,
				   );
			});
		$t->node('scripts')->node('js-src')->setAttr(
			FILE   => 'js',
		   );
		$t->node('scripts')->node('js-src')->add(
			FILE   => $fpath,
		   );
	}

	my $frame = $this->{frames}[$default_level];

	# デフォルトで表示される変数は Lv. 0 の変数であり、表示されるソース
	# は Lv. 0 のソースである。これは後で JavaScript によって書き換えら
	# れる可能性がある。
	if (not $this->{show_vars}) {
		$t->node('detail')->node('vars-unavail')->add(
			REASON => 'iniファイル、[TL]グループの "stacktrace" の設定値が'.
			  ' "full" になっていません。');
	}
    elsif (not $frame) {
        $t->node('detail')->node('vars-unavail')->setAttr(
            REASON => 'raw',
           );
        $t->node('detail')->node('vars-unavail')->add(
            REASON =>
              q{スタックトレースを取得できませんでした。} .
              q{$SIG{__DIE__} ハンドラが置き換えられた状態でエラーが発生した可能性があります。<br />} .
              q{エラー内容が勝手に書き換えられるのを防ぐなどの理由で一時的に $SIG{__DIE__} } .
              q{ハンドラを置き換える際には、次のようにして、発生したエラーを再度 die して下さい。<br /><br />} .
              q[<pre>eval {] . "\n" .
              q[  $SIG{__DIE__} = 'DEFAULT';] . "\n" .
              q[  # エラーが発生する処理] . "\n" .
              q[};] . "\n" .
              q[if ($@) {] . "\n" .
              q[  die $@;  # 再度エラーを発生させる] . "\n" .
              q[}</pre>],
           );
    }
	elsif (not $PADWALKER_AVAILABLE) {
		$t->node('detail')->node('vars-unavail')->setAttr(
			REASON => 'raw',
		   );
		$t->node('detail')->node('vars-unavail')->add(
			REASON => '<a href="http://search.cpan.org/~robin/PadWalker/">PadWalker</a> が利用不可能です。');
	}
	else {
		foreach my $name (sort {$a cmp $b} keys %{$frame->vars_shallow}) {
			$t->node('detail')->node('vars-avail')->node('var')->add(
				NAME  => $name,
				VALUE => $frame->vars_shallow->{$name},
			   );
		}
		$t->node('detail')->node('vars-avail')->add;
	}

	if (not $this->{show_src}) {
		$t->node('detail')->node('src-unavail')->add(
			REASON => 'iniファイル、[TL]グループの "stacktrace" の設定値が'.
			  ' "full" になっていません。');
	}
    elsif (not $frame) {
        $t->node('detail')->node('src-unavail')->add(
            REASON =>
              q{スタックトレースを取得できませんでした。}
             );
    }
	elsif (not defined $this->{source}{$frame->fpath}) {
		$t->node('detail')->node('src-unavail')->add(
			REASON => 'ソースファイル "%s" を読み込む事が出来ません。');
	}
	else {
		$this->_foreach_source_line(
			$frame, sub {
				my ($linenum, $src) = @_;

				$t->node('detail')->node('src-avail')->node('line')->node(
					$frame->line == $linenum ? 'caller-line' : 'other-line')->add(
						SOURCE   => $src,
						LINE_NUM => $linenum,
					   );
				$t->node('detail')->node('src-avail')->node('line')->add;
			});
		$t->node('detail')->node('src-avail')->add;
	}

    if ($frame) {
        $t->node('scripts')->add({
            SELECTED_LV  => $frame->level,
            LAST_HILITED => $frame->line,
           });
        $t->expand(
            SELECTED_LV  => $frame->level,
            LAST_HILITED => $frame->line,
           );
    }
    else {
        $t->node('scripts')->add({
            SELECTED_LV  => 0,
            LAST_HILITED => 0,
           });
        $t->expand(
            SELECTED_LV  => 0,
            LAST_HILITED => 0,
           );