line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Error::Pure::Output::Tags::HTMLCustomPage; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# Pragmas. |
4
|
2
|
|
|
2
|
|
27394
|
use base qw(Exporter); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
207
|
|
5
|
2
|
|
|
2
|
|
10
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
42
|
|
6
|
2
|
|
|
2
|
|
13
|
use warnings; |
|
2
|
|
|
|
|
8
|
|
|
2
|
|
|
|
|
51
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
# Modules. |
9
|
2
|
|
|
2
|
|
1527
|
use HTTP::Headers::Fast; |
|
2
|
|
|
|
|
8839
|
|
|
2
|
|
|
|
|
57
|
|
10
|
2
|
|
|
2
|
|
1628
|
use Readonly; |
|
2
|
|
|
|
|
5537
|
|
|
2
|
|
|
|
|
665
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
# Constants. |
13
|
|
|
|
|
|
|
Readonly::Array our @EXPORT_OK => qw(err_pretty); |
14
|
|
|
|
|
|
|
Readonly::Scalar my $EMPTY_STR => q{}; |
15
|
|
|
|
|
|
|
Readonly::Scalar my $SPACE => q{ }; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
# Version. |
18
|
|
|
|
|
|
|
our $VERSION = 0.03; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# Pretty print. |
21
|
|
|
|
|
|
|
sub err_pretty { |
22
|
0
|
|
|
0
|
1
|
|
my ($tags_obj, $encoding, $content_type, $xml_version, |
23
|
|
|
|
|
|
|
$tags_structure_ar) = @_; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# Reset. |
26
|
0
|
|
|
|
|
|
$tags_obj->reset; |
27
|
|
|
|
|
|
|
|
28
|
0
|
|
|
|
|
|
my $header = HTTP::Headers::Fast->new; |
29
|
0
|
|
|
|
|
|
$header->header( |
30
|
|
|
|
|
|
|
'Cache-Control' => 'no-cache', |
31
|
|
|
|
|
|
|
'Content-Type' => $content_type, |
32
|
|
|
|
|
|
|
); |
33
|
0
|
|
|
|
|
|
$header->date(time); |
34
|
0
|
|
|
|
|
|
$tags_obj->put(['r', $header->as_string."\n"]); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# Debug from Tags object. |
37
|
0
|
|
|
|
|
|
my $debug = $tags_obj->{'set_indent'}; |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# XML tag. |
40
|
0
|
|
|
|
|
|
$tags_obj->put( |
41
|
|
|
|
|
|
|
['i', 'xml', 'version="'.$xml_version.'" encoding="'.$encoding. |
42
|
|
|
|
|
|
|
'" standalone="no"'], |
43
|
|
|
|
|
|
|
); |
44
|
0
|
0
|
|
|
|
|
if ($debug) { |
45
|
0
|
|
|
|
|
|
$tags_obj->put(['r', "\n"]); |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# DTD. |
49
|
0
|
|
|
|
|
|
my @dtd = ( |
50
|
|
|
|
|
|
|
'
|
51
|
|
|
|
|
|
|
'PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"', |
52
|
|
|
|
|
|
|
'"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">', |
53
|
|
|
|
|
|
|
); |
54
|
0
|
|
|
|
|
|
my ($separator, $linebreak) = ($SPACE, $EMPTY_STR); |
55
|
0
|
0
|
|
|
|
|
if ($debug) { |
56
|
0
|
|
|
|
|
|
$separator = "\n".$tags_obj->{'next_indent'}; |
57
|
0
|
|
|
|
|
|
$linebreak = "\n"; |
58
|
|
|
|
|
|
|
} |
59
|
0
|
|
|
|
|
|
$tags_obj->put(['r', (join $separator, @dtd).$linebreak]); |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
# Main page. |
62
|
0
|
|
|
|
|
|
my @tmp = @{$tags_structure_ar}; |
|
0
|
|
|
|
|
|
|
63
|
0
|
|
|
|
|
|
$tags_obj->put(@tmp); |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
# Ok. |
66
|
0
|
|
|
|
|
|
return 1; |
67
|
|
|
|
|
|
|
} |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
1; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
__END__ |