# -----------------------------------------------------------------------------
# Tripletail::Debug - TL デバッグ用クラス
# -----------------------------------------------------------------------------
package Tripletail::Debug;
use strict;
use warnings;
use UNIVERSAL qw(isa);
use Tripletail;
sub _INIT_HOOK_PRIORITY() { 1_000_000_000 }; # 順序は問わない。
sub _PRE_REQUEST_HOOK_PRIORITY() { 1_000_000_000 } # 最後でなければならない。
sub _OUTPUT_FILTER_PRIORITY() { 1_000_000_000 } # 最後でなければならない。
our $_INSTANCE;
1;
sub _getInstance {
my $class = shift;
if(!$_INSTANCE) {
$_INSTANCE = $class->__new(@_);
}
$_INSTANCE;
}
sub __new {
my $class = shift;
my $group = shift;
my $this = bless {} => $class;
$this->{group} = defined $group ? $group : 'Debug';
$this->{enabled} = $TL->INI->get($this->{group} => 'enable_debug');
$this->{popup_type} = $TL->INI->get($this->{group} => 'popup_type', 'none');
$this->{warn_logging} = $TL->INI->get($this->{group} => 'warn_logging', 1);
$this->{warn_popup} = $TL->INI->get($this->{group} => 'warn_popup', 1);
$this->{log_popup} = $TL->INI->get($this->{group} => 'log_popup', 1);
$this->{request_logging} = $TL->INI->get($this->{group} => 'request_logging', 1);
$this->{request_popup} = $TL->INI->get($this->{group} => 'request_popup', 1);
$this->{request_logging_max} = $TL->parseQuantity($TL->INI->get($this->{group} => 'request_logging_max', 0));
$this->{content_logging} = $TL->INI->get($this->{group} => 'content_logging', 1);
$this->{content_popup} = $TL->INI->get($this->{group} => 'content_popup', 1);
$this->{content_logging_max} = $TL->parseQuantity($TL->INI->get($this->{group} => 'content_logging_max', 0));
$this->{content_popup_max} = $TL->parseQuantity($TL->INI->get($this->{group} => 'content_popup_max', 0));
$this->{template_logging} = $TL->INI->get($this->{group} => 'template_logging', 1);
$this->{template_popup} = $TL->INI->get($this->{group} => 'template_popup', 1);
$this->{db_logging} = $TL->INI->get($this->{group} => 'db_logging', 1);
$this->{db_popup} = $TL->INI->get($this->{group} => 'db_popup', 1);
$this->{db_logging_level} = $TL->INI->get($this->{group} => 'db_logging_level', 1);
$this->{db_profile} = $TL->INI->get($this->{group} => 'db_profile', 1);
$this->{location_debug} = $TL->INI->get($this->{group} => 'location_debug', 0);
$this->reset;
if($this->{enabled}) {
# 最後に呼ばれるpreRequestハンドラを登録。
$TL->setHook(
'preRequest',
_PRE_REQUEST_HOOK_PRIORITY,
sub {
if($this->{request_logging}) {
$this->__log_request;
}
},
);
# 最初に呼ばれるinitハンドラを登録。
$TL->setHook(
'init',
_INIT_HOOK_PRIORITY,
sub {
# 自分自身をContentFilterとして登録。
$TL->setContentFilter(
[__PACKAGE__, _OUTPUT_FILTER_PRIORITY], this => $this
);
},
);
if($this->{warn_logging} or $this->{warn_popup}) {
$SIG{__WARN__} = sub {
my $msg = shift;
isa($msg, 'Tripletail::Error') or $msg = $TL->newError(warn => $msg);
if($this->{warn_logging}) {
$TL->_log(__PACKAGE__, "Warn: $msg");
}
if($this->{warn_popup}) {
push @{$this->{warn_log}}, $msg;
}
};
}
}
$this;
}
sub reset {
my $this = shift;
$this->{header} = undef;
$this->{header_buf} = '';
$this->{filter_buf} = '';
$this->{db_log} = [];
$this->{db_log_data} = {};
$this->{dl_log} = [];
$this->{form_log} = [];
$this->{tl_log} = [];
$this->{warn_log} = [];
$this->{template_log} = [];
$this->{explain_cache} = {};
$this->{popup} = [];
}
sub __log_request {
my $this = shift;
# $TL->CGIの内容と%ENVの内容をログに吐く。
my $log = '';
if($TL->{CGIORIG}) {
foreach my $key (sort $TL->{CGIORIG}->getKeys) {
foreach my $value ($TL->{CGIORIG}->getValues($key)) {
$log .= "[CGI:$key] $value\n";
}
}
}
foreach my $key (sort keys %ENV) {
$log .= "[ENV:$key] $ENV{$key}\n";
}
my $lim = $this->{request_logging_max};
if($lim and length($log) > $lim) {
substr($log, $lim) = '...';
}
$TL->_log(__PACKAGE__, "Request Log:\n$log");
}
#--------- Tripletail::Template専用
sub _templateLog {
my $this = shift;
# node => Tripletail::Template::Node
# type => new / expand / add / setForm / extForm/ addHiddenForm / addSessionCheck / toStr / flush
#
# ---[new]
# 追加引数無し
#
# ---[expand]
# args => HASH Ref
# any => 真偽値
#
# ---[setattr]
# args => HASH Ref
#
# ---[add]
# 追加引数無し
#
# ---[setForm]
# form => Tripletail::Form
# name => フォーム名
#
# ---[extForm]
# name => フォーム名
#
# ---[addHiddenForm]
# form => Tripletail::Form
# name => フォーム名
#
# ---[addSessionCheck]
# name => フォーム名
#
# ---[toStr]
# 追加引数無し
#
# ---[flush]
# 追加引数無し
if(!$this->{enabled}
|| (!$this->{template_popup} && !$this->{tamplate_logging})
|| !$this->{template_log}) {
return $this;
}
my $opts = { @_ };
my $node = $opts->{node};
# nodeはTripletail::Templateオブジェクトでなくノードパスとする。(/foo/bar形式)
$opts->{node} = $node->_nodePath;
# "fpath"を追加。このテンプレートがファイルから生成されたなら、そのファイル名。
my $root;
for($root = $node; $root->{parent}; $root = $root->{parent}) {}
$opts->{fpath} = defined $root->{fpath} ? $root->{fpath} : '(file path unknown)';
# formがあれば、それのcloneを保持。
my $form = $opts->{form};
if($form) {
$opts->{form} = $form->clone;
if(!length($opts->{name})) {
$opts->{name} = '(anonymous form)';
}
}
if($this->{template_popup}) {
push @{$this->{template_log}}, $opts;
}
if($this->{template_logging}) {
my $params_dump = '';
if($opts->{type} eq 'expand') {
$params_dump .= sprintf("Any: %d\n", $opts->{any});
}
if($opts->{type} eq 'setForm' || $opts->{type} eq 'addHiddenForm') {
$params_dump .= sprintf("Form Name: %s\n", $opts->{name});
foreach my $key ($opts->{form}->getKeys) {
$params_dump .= sprintf(" %s = %s\n", $key, $opts->{form}->get($key));
}
}
if($opts->{type} eq 'extForm') {
$params_dump .= sprintf("Form Name: %s\n", $opts->{name});
}
if($opts->{type} eq 'addSessionCheck') {
$params_dump .= sprintf("Form Name: %s\n", $opts->{name});
}
if($opts->{type} eq 'expand' || $opts->{type} eq 'setAttr') {
foreach my $key (sort keys %{$opts->{args}}) {
my $val = $opts->{args}{$key};
defined($val) or $val = '(null)';
$params_dump .= sprintf(" %s = %s\n", $key, $val);
}
}
$TL->_log(
__PACKAGE__,
sprintf(
"Template Trace [TYPE:$opts->{type}][FPATH:$opts->{fpath}][NODE:$opts->{node}]\n".
"%s",
$params_dump,
)
);
}
$this;
}
#--------- Tripletail::DB専用
sub _dbLog {
my $this = shift;
if (!$this->{enabled}
|| (!$this->{db_popup} && !$this->{db_logging})
|| !$this->{db_log}) {
return $this;
}
my $opts;
if( @_ && UNIVERSAL::isa($_[0], 'CODE') )
{
my $coderef = shift;
$opts = { $coderef->(@_) };
}else
{
$opts = { @_ };
}
local($@);
eval 'require Data::Dumper';
$@ and die $@;
# パラメータはData::Dumperでのダンプを保存しておく。
my $params_dump = Data::Dumper->new([$opts->{params}])
->Indent(0)->Terse(1)->Deepcopy(1)->Dump;
if($this->{db_logging}
&& ($this->{db_profile} >= 1
|| $this->{db_logging_level} >= 1)) {
$TL->_log(
__PACKAGE__,
sprintf(
"DB Trace [Map: %s][Set: %s][DB: %s][ID: %d]\n".
"Elapsed: %s seconds\n".
"Query:\n".
"%s\n".
"Parameters:\n".
"%s",
$opts->{group},
$opts->{set},
$opts->{db},
$opts->{id},
$opts->{elapsed},
$opts->{query},
$params_dump,
)
);
}
if ($Tripletail::IN_EXTENT_OF_STARTCGI) {
push @{$this->{db_log}}, {
group => $opts->{group},
set => $opts->{set},
db => $opts->{db},
id => $opts->{id},
query => $opts->{query},
params => $params_dump,
elapsed => $opts->{elapsed},
error => $opts->{error},
};
push(@{$this->{db_log_data}{$opts->{id}}}, $opts->{names});
}
$this;
}
sub _dbLogData {
my $this = shift;
if (!$this->{enabled}
|| (!$this->{db_popup} && !$this->{db_logging})
|| !$this->{db_log}
|| ($this->{db_logging_level} <= 1)) {
return $this;
}
my $opts;
if( @_ && UNIVERSAL::isa($_[0], 'CODE') )
{
my $coderef = shift;
$opts = { $coderef->(@_) };
}else
{
$opts = { @_ };
}
my $dump;
my $data;
if(ref($opts->{data}) eq 'ARRAY') {
foreach my $data (@{$opts->{data}}) {
$dump = (defined($data) ? $data : '(undef)') . "\n";
}
$data = [ @{$opts->{data}} ];
} elsif(ref($opts->{data}) eq 'HASH') {
$this->{db_log_data}{$opts->{id}}[0] = [ sort keys %{$opts->{data}} ];
$data = [];
foreach my $key (sort keys %{$opts->{data}}) {
push(@$data, $opts->{data}{$key});
$dump .= $key . ': ' . (defined($opts->{data}{$key}) ? $opts->{data}{$key} : '(undef)' ) . "\n";
}
}
if($this->{db_logging} && $this->{db_logging_level} >= 2) {
$TL->_log(
__PACKAGE__,
sprintf("DB Trace [ID: %d]\n%s", $opts->{id}, $dump)
);
}
push(@{$this->{db_log_data}{$opts->{id}}}, $data);
$this;
}
#--------- Tripletail::Form専用
sub _formLog {
my $this = shift;
my $opts = { @_ };
if (!$this->{enabled}
|| !$this->{request_logging}
|| !$this->{request_popup}) {
return $this;
}
# スタックを辿り、最初に現れたTripletail::以外のパッケージが作ったフレームを見て、
# ファイル名と行番号を得る。
my $loc = '';
for(my $i = 0;; $i++) {
my ($pkg, $fname, $lineno) = caller $i;
if($pkg !~ m/^Tripletail::/) {
$fname =~ m!([^/]+)$!;
$fname = $1;
$loc = sprintf '%s:%d', $fname, $lineno;
last;
}
}
my $log = '';
my $data = '';
$log .= "Type: $opts->{type}\n";
$log .= "Loc: $loc\n";
if(exists($opts->{key})) {
$data .= "Key: $opts->{key}\n";
}
if(exists($opts->{value})) {
$data .= "Value: $opts->{value}\n";
}
if(exists($opts->{data})) {
my $data_dump = Data::Dumper->new([$opts->{data}])
->Indent(0)->Terse(1)->Deepcopy(1)->Dump;
$data .= "Data: $data_dump\n";
}
if(exists($opts->{form})) {
my $form_dump = Data::Dumper->new([$opts->{form}])
->Indent(0)->Terse(1)->Deepcopy(1)->Dump;
$data .= "Form: $form_dump\n";
}
if($this->{request_logging}) {
$TL->_log(__PACKAGE__, "Form Log:\n$log$data");
}
if($this->{request_popup}) {
push @{$this->{form_log}}, {
type => $opts->{type},
loc => $loc,
data => $data,
};
}
$this;
}
#--------- $TL->log
sub _tlLog {
my $this = shift;
my $opts = { @_ };
if (!$this->{enabled}
|| !$this->{log_popup}
|| !$this->{tl_log}) {
return $this;
}
my @time = localtime;
$time[5] += 1900;
$time[4]++;
push @{$this->{tl_log}}, {
group => $opts->{group},
log => $opts->{log},
time => sprintf(
'%04d-%02d-%02d %02d:%02d:%02d',
@time[5, 4, 3, 2, 1, 0],
),
};
$this;
}
#--------- Tripletail::startCgi
sub _implant_disperror_popup {
my $this = shift;
$this->__db_explain;
if($this->{enabled}
&& $this->{popup}
&& $this->{popup_type} ne 'none') {
$this->__implant_template_popup;
$this->__implant_warn_popup;
$this->__implant_db_popup;
$this->__implant_log_popup;
$this->__implant_request_popup;
$this->__implant_content_popup;
$TL->dump(POPUP => $this->{popup});
$TL->dump(POPUPOBJ => $this);
my $output = $this->__flush_popup;
$this->reset;
return $output;
}
$this->reset;
'';
}
#--------- Tripletail::Filter
sub _new {
my $class = shift;
my $opts = { @_ };
$opts->{this};
}
sub print {
my $this = shift;
my $data = shift;
if(!$this->{enabled}) {
return $data;
}
$this->{filter_buf} .= $data;
if( $this->{popup_type} eq 'none' )
{
return $data;
}else
{
# buffering to rewrite after data gathered.
return '';
}
}
sub flush {
my $this = shift;
$this->__db_explain;
if($this->{content_logging}) {
my $content = $this->{filter_buf};
my $lim = $this->{content_logging_max};
if($lim && length($content) > $lim) {
substr($content, $lim) = '...';
}
$TL->_log(__PACKAGE__, "Content Log:\n$content");
}
my $data = $this->{filter_buf}; # ローカルなコピー
while($data =~ s/^(.*?(?:\r?\n|\r))//) {
$this->{header_buf} .= $1;
if($this->{header_buf} =~ m/(?:\r?\n|\r){2}$/) {
# 二つ連続した改行コードで終わっている => ヘッダの終わり
$this->{header} = {};
foreach(split /\r?\n|\r/, $this->{header_buf}) {
if(m/^(.+?):\s*(.+)$/) {
my $array = $this->{header}{lc $1};
if(!$array) {
$array = $this->{header}{lc $1} = [];
}
push @$array, $2;
}
}
my $ct = $this->{header}{'content-type'}[0];
if(!$ct || $ct !~ m/html/i) {
# htmlを出力しているのでなければポップアップは無効に。
$this->{popup} = undef;
}
# charset判定
my $charset = 'Shift_JIS';
if($ct && $ct =~ m/charset=([^;]+)/i) {
$charset = $1;
}
$this->{header}{_CHARSET_} = $charset;
last;
}
}
if($this->{filter_buf} =~ m||i
&& $this->{popup}
&& $this->{popup_type} ne 'none') {
$this->__implant_template_popup;
$this->__implant_warn_popup;
$this->__implant_db_popup;
$this->__implant_log_popup;
$this->__implant_request_popup;
$this->__implant_content_popup;
my $html = $this->__flush_popup;
$this->{filter_buf}=~ s||$html|;
}
my $result;
if( $this->{popup_type} eq 'none' )
{
$result = '';
}else
{
# return buffered and rewritten html.
$result = $this->{filter_buf};
}
$this->reset;
$result;
}
sub __flush_popup {
my $this = shift;
if(!@{$this->{popup}}
|| $this->{popup_type} eq 'none') {
return '';
}
if($this->{popup_type} eq 'multiple') {
my $script = qq~
~;
} elsif($this->{popup_type} eq 'single') {
# ヘッダとフッタを付ける
my ($header, $footer) = $this->__tmpl_master_popup;
foreach my $popup (@{$this->{popup}}) {
$header->node('anchor')->add(
ID => $popup->[1],
TITLE => $popup->[0],
);
}
unshift @{$this->{popup}},
$this->__implant_popup(
funcname => '_tl_debug_HEADER_',
html => $header->toStr,
no_push => 1,
);
push @{$this->{popup}},
$this->__implant_popup(
funcname => '_tl_debug_FOOTER_',
html => $footer->toStr,
no_push => 1,
);
my $script = qq~
~;
$script;
} else {
die "invalid popup_type: [$this->{popup_tipe}]\n";
}
}
sub __db_explain {
my $this = shift;
if($this->{db_log} && @{$this->{db_log}}) {
my $explain_id = 0;
foreach my $entry (@{$this->{db_log}}) {
next if($entry->{error});
if($this->__checkIfExplainable($entry->{query})) {
my $explain = $this->__explain(
$entry->{group}, $entry->{set}, $entry->{db},
$entry->{query}, $entry->{params}
);
$this->{explain_log}[$explain_id] = $explain;
$explain_id++;
my $query = $TL->escapeTag($entry->{query});
$query =~ s~^\s*|\s*$~~g;
my $explain_dump = '';
my @maxcolumn;
foreach my $row (@$explain) {
for(my $i = 0; $i < @$row; $i++) {
$maxcolumn[$i] = length($row->[$i])
if(!$maxcolumn[$i] || $maxcolumn[$i] < length($row->[$i]));
}
}
foreach my $row (@$explain) {
$explain_dump .= ' | ';
for(my $i = 0; $i < @$row; $i++) {
$explain_dump .= ' ' x ($maxcolumn[$i] - length($row->[$i])) . $row->[$i] . ' | ';
}
$explain_dump .= "\n";
}
if($this->{db_logging}) {
$TL->_log(
__PACKAGE__,
sprintf(
"DB Trace [Map: %s][Set: %s][DB: %s][ID: %d]\n".
"Elapsed: %s seconds\n".
"Query:\n".
"%s\n".
"Parameters:\n".
"%s\n".
"Explain:\n".
"%s",
$entry->{group},
$entry->{set},
$entry->{db},
$entry->{id},
$entry->{elapsed},
$query,
$entry->{params},
$explain_dump
)
);
}
}
}
}
}
sub __implant_db_popup {
my $this = shift;
if($this->{db_log} and @{$this->{db_log}}
&& $this->{db_popup}) {
my $t = $this->__tmpl_db_popup;
local *expand_table = sub {
my $node = shift;
my $fetched = shift;
foreach my $label (@{$fetched->[0]}) {
$node->node('label')->add(
LABEL => $label,
);
}
foreach my $row (@$fetched[1 .. @$fetched-1]) {
foreach my $column (@$row) {
$node->node('rows')->node('column')->add(
COLUMN => (defined $column ? $column : '(NULL)'),
);
}
$node->node('rows')->add;
}
};
my $explain_id = 0;
my $fetch_id = 0;
foreach my $entry (@{$this->{db_log}}) {
if($this->{db_profile} >= 2 && $this->__checkIfExplainable($entry->{query})) {
next if($entry->{error});
$t->node('entry')->node('explain-link')->add(
EXPLAIN_ID => $explain_id,
);
my $explain = $this->{explain_log}[$explain_id];
expand_table(
$t->node('entry')->node('explain-frame'),
$explain
);
$t->node('entry')->node('explain-frame')->add(
EXPLAIN_ID => $explain_id,
);
$explain_id++;
}
if($this->{db_logging_level} >= 2 && $this->__checkIfFetchable($entry->{query})) {
$t->node('entry')->node('fetch-link')->add(
FETCH_ID => $fetch_id,
);
my $fetched = $this->{db_log_data}{$entry->{id}};
expand_table(
$t->node('entry')->node('fetch-frame'),
$fetched
);
$t->node('entry')->node('fetch-frame')->add(
FETCH_ID => $fetch_id,
);
$fetch_id++;
}
my $query = $TL->escapeTag($entry->{query});
$query =~ s~^\s*|\s*$~~g;
$query =~ s~\n~
~g;
$query =~ s~(--[^\n]+)~~g;
$query =~ s~(/\*.+?\*/)~~sg;
my $params = $TL->escapeTag($entry->{params});
$params =~ s~\s~ ~g;
$params =~ s~\n~
~g;
$t->node('entry')->setAttr(
QUERY => 'raw',
PARAMS => 'raw',
);
$t->node('entry')->add(
GROUP => $entry->{group},
SET => $entry->{set},
DB => $entry->{db},
QUERY => $query,
PARAMS => $params,
ELAPSED => "$entry->{elapsed} sec",
);
}
$this->__implant_popup(
html => $t->toStr,
title => 'DB使用ログ',
funcname => '_tl_debug_db_popup_',
);
}
}
sub __implant_template_popup {
my $this = shift;
if($this->{template_log} && @{$this->{template_log}}) {
my $log = $this->{template_log};
$this->{template_log} = undef; # これ以降はTempateログを取らない。
my $t = $this->__tmpl_template_popup;
foreach my $entry (@$log) {
my %params = %$entry;
my $force_defined = sub {
my $value = shift;
defined $value ? $value : '(null)';
};
if($entry->{type} eq 'expand' || $entry->{type} eq 'setattr') {
# イテレータをリセットする代わりにコピーを取る。
my %copy = %{$entry->{args}};
while (my ($key, $value) = each %copy) {
defined($value) or $value = '(null)';
$t->node('entry')->node($entry->{type})->node('arg')->add(
KEY => $key, VALUE => $force_defined->($value),
);
}
delete $params{args};
} elsif($entry->{type} eq 'setForm' || $entry->{type} eq 'addHiddenForm') {
foreach my $key ($entry->{form}->getKeys) {
foreach my $value ($entry->{form}->getValues($key)) {
$t->node('entry')->node($entry->{type})->node('pair')->add(
KEY => $key, VALUE => $force_defined->($value),
);
}
}
delete $params{form};
}
my $type = delete $params{type};
my $fpath = delete $params{fpath};
my $node = delete $params{node};
$t->node('entry')->node($entry->{type})->add(%params);
$t->node('entry')->add(
TYPE => $type,
FPATH => $fpath,
NODE => $node,
);
}
$this->__implant_popup(
html => $t->toStr,
title => 'テンプレート使用ログ',
funcname => '_tl_debug_template_popup_',
);
}
$this;
}
sub __implant_warn_popup {
my $this = shift;
if($this->{warn_log} && @{$this->{warn_log}}) {
my $t = $this->__tmpl_warn_popup;
foreach my $entry (@{$this->{warn_log}}) {
my $content = $TL->escapeTag($entry);
$content =~ s~\n~
~g;
$content =~ s~\s~ ~g;
$t->node('entry')->setAttr(
CONTENT => 'raw',
);
$t->node('entry')->add(
CONTENT => $content,
);
}
$this->__implant_popup(
html => $t->toStr,
title => 'warn',
funcname => '_tl_debug_warn_popup_',
);
}
$this;
}
sub __implant_log_popup {
my $this = shift;
if($this->{tl_log} && @{$this->{tl_log}}) {
# $TL->logのログ
my $log = $this->{tl_log};
$this->{tl_log} = undef; # これ以降は$TL->logログを取らない
my $t = $this->__tmpl_log_popup;
foreach my $entry (@$log) {
my $content = $TL->escapeTag($entry->{log});
$content =~ s~[ \t]~ ~g;
$content =~ s~\n~
~g;
$t->node('entry')->setAttr(
CONTENT => 'raw',
);
$t->node('entry')->add(
GROUP => $entry->{group},
TIME => $entry->{time},
CONTENT => $content,
);
}
$this->__implant_popup(
html => $t->toStr,
title => '$TL->logログ',
funcname => '_tl_debug_log_popup_',
);
}
$this;
}
sub __implant_request_popup {
my $this = shift;
if($this->{request_popup} && $TL->{CGIORIG}) {
# $TL->CGIの内容と%ENVの内容
my $t = $this->__tmpl_request_popup;
foreach my $key (sort $TL->{CGIORIG}->getKeys) {
foreach my $value (sort $TL->{CGIORIG}->getValues($key)) {
$t->node('cgi')->add(
KEY => $key,
VALUE => $value,
);
}
}
$t->node('form')->setAttr(DATA => 'br');
foreach my $data (@{$this->{form_log}}) {
$t->node('form')->add($data);
}
foreach my $key (sort keys %ENV) {
foreach my $value ($ENV{$key}) {
$t->node('env')->add(
KEY => $key,
VALUE => $value,
);
}
}
$this->__implant_popup(
html => $t->toStr,
title => 'リクエスト情報',
funcname => '_tl_debug_request_popup_',
);
}
$this;
}
sub __implant_content_popup {
my $this = shift;
if($this->{content_popup} && length($this->{filter_buf})) {
my $t = $this->__tmpl_content_popup;
my $content = $this->{filter_buf};
my $lim = $this->{content_popup_max};
if($lim && length($content) > $lim) {
substr($content, $lim) = '...';
}
$content = $TL->charconv($content, 'auto' => 'UTF-8');
$t->setAttr(VALUE => 'br');
$t->expand(VALUE => $content);
$this->__implant_popup(
html => $t->toStr,
title => 'コンテンツ情報',
funcname => '_tl_debug_content_popup_',
);
}
$this;
}
sub __implant_popup {
my $this = shift;
my $opts = do {
my %args = @_;
\%args;
};
my $funcname = $opts->{funcname};
my $html = $opts->{html};
my $title = $opts->{title};
my $no_push = $opts->{no_push};
my $script = " function $funcname(doc) {\n";
if(defined($title)) {
$script .= qq{ doc.writeln("
$title
");\n};
}
my $functions;
my $line = 0;
foreach(split /\r?\n|\r/, $html) {
if( (++$line%1000)==0 )
{
if( !$functions )
{
$script =~ s/^ function (\w+)/ function $1_001/;
$functions = 1;
}
++$functions;
$script .= " }\n";
my $fname = sprintf('%s_%03d',$funcname,$functions);
$script .= " function $fname(doc) {\n";
}
# ポップアップウインドウのHTMLの全ての行を、
# doc.writeln("..."); という形にする。
s/\\/\\\\/g;
s/"/\\"/g;
s/--/"+"-"+"-"+"/g;
s!//!"+"/"+"/"+"!g;
s!!"+"<"+"/sc"+"ript>"+"!g;
$script .= qq{ doc.writeln("$_");\n};
}
$script .= " }\n";
if( $functions )
{
$script .= " function $funcname(doc) {\n";
foreach my $i (1..$functions)
{
my $fname = sprintf('%s_%03d', $funcname, $i);
$script .= " $fname(doc);\n";
}
$script .= " }\n";
}
$script =~ s/\n/\r\n/g;
$script = $TL->charconv($script, 'utf8' => $this->{header}{_CHARSET_});
my $popup = [$title, $funcname, $script];
if(!$no_push) {
push @{$this->{popup}}, $popup;
}
$popup;
}
#--------------- DB関連
sub __checkIfExplainable {
my $this = shift;
my $sql = shift;
$this->__findCommand($sql) eq 'SELECT';
}
sub __checkIfFetchable {
my $this = shift;
my $sql = shift;
my $allowed = {
SHOW => 1,
EXPLAIN => 1,
DESC => 1,
SELECT => 1,
};
$allowed->{$this->__findCommand($sql)};
}
sub __findCommand {
my $this = shift;
my $sql = shift;
while(1) {
$sql =~ s/^\s*//;
if($sql =~ s|^/\*.+?\*/||) {
next;
} elsif($sql =~ s,--.+?(?:\r?\n|\r),,) {
next;
} elsif($sql =~ m|^(\w+)|) {
return uc $1;
} else {
die __PACKAGE__."#__findCommand: found no commands in sql [$sql] (SQLからコマンドを見つけることができませんでした)\n";
}
}
}
sub __explain {
my $this = shift;
my $group = shift;
my $dbset = shift;
my $dbname = shift; # undef可
my $query = shift;
my $params = shift;
if(!$this->{explain_cache}{$group}) {
$this->{explain_cache}{$group} = {};
}
if(my $cached = $this->{explain_cache}{$group}{$query}) {
return $cached;
}
$this->{explain_cache}{$group}{$query} =
$this->__executeSql($group, $dbset, $dbname, "EXPLAIN $query", $params);
}
sub __executeSql {
my $this = shift;
my $group = shift;
my $dbset = shift;
my $dbname = shift; # undef可
my $query = shift;
my $params = shift;
# 内部用のクエリはデバッグログに残さない
local($this->{db_log});
$this->{db_log} = undef;
$params = do {
local($@);
eval $params; # Dumpしてあったものを戻す
};
my $DB = $TL->getDB($group);
my $sth = $DB->execute(\$dbset => $query, @$params);
my $result = [];
$result->[0] = [ @{$sth->nameArray} ]; # 0番目がフィールド名
while(my $row = $sth->fetchArray) {
foreach my $col (@$row) {
$col = '(null)' if(!defined($col));
}
push @$result, [ @$row ];
}
$result;
}
#------------- CSS 及びテンプレート
sub __popup_css {
my $this = shift;
my $is_opera = ($ENV{HTTP_USER_AGENT}||'')=~/Opera/i;
qq{
};
}
sub __iframe_css {
my $this = shift;
qq{
};
}
sub __tmpl_master_popup {
my $this = shift;
my $charset = $this->{header}{_CHARSET_} || 'UTF-8';
my $css = $this->__popup_css;
my $group = $this->{group};
my @result;
push @result, $TL->newTemplate->setTemplate( # ヘッダ
qq{
[Tripletail::Debug] デバッグ情報
$css
});
push @result, $TL->newTemplate->setTemplate( # フッタ
qq{
});
@result;
}
sub __tmpl_template_popup {
my $this = shift;
$TL->newTemplate->setTemplate(qq{
| 操作 | ファイル | ノード | パラメータ |
| <&TYPE> | <&FPATH> | <&NODE> |
- args
- <&KEY>
- <&VALUE>
- any
- <&ANY>
- args
- <&KEY>
- <&VALUE>
- name of form
- <&NAME>
- content
- <&KEY>
- <&VALUE>
- name of form
- <&NAME>
- name of form
- <&NAME>
- content
- <&KEY>
- <&VALUE>
- name of form
- <&NAME>
|
});
}
sub __tmpl_request_popup {
my $this = shift;
$TL->newTemplate->setTemplate(qq{
CGI
ENV
});
}
sub __tmpl_content_popup {
my $this = shift;
$TL->newTemplate->setTemplate(qq{
Content
});
}
sub __tmpl_log_popup {
my $this = shift;
$TL->newTemplate->setTemplate(qq{
| グループ | 内容 |
| 時刻 |
| <&GROUP> | <&CONTENT> |
| <&TIME> |
});
}
sub __tmpl_warn_popup {
my $this = shift;
$TL->newTemplate->setTemplate(qq{
});
}
sub __tmpl_db_popup {
my $this = shift;
$TL->newTemplate->setTemplate(qq{
| グループ |
セット |
コネクション |
クエリ |
パラメータ |
execute実行時間 |
詳細 |
| <&GROUP> |
<&SET> |
<&DB> |
<&QUERY> |
<&PARAMS> |
<&ELAPSED> |
|
|
|
|
|
});
}
__END__
=encoding utf-8
=head1 NAME
Tripletail::Debug - TL デバッグ用クラス
=head1 DESCRIPTION
このクラスは C