line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Code in the PDF::API2::Basic::PDF namespace was originally copied from the |
2
|
|
|
|
|
|
|
# Text::PDF distribution. |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# Copyright Martin Hosken |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# Martin Hosken's code may be used under the terms of the MIT license. |
7
|
|
|
|
|
|
|
# Subsequent versions of the code have the same license as PDF::API2. |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
package PDF::API2::Basic::PDF::String; |
10
|
|
|
|
|
|
|
|
11
|
40
|
|
|
40
|
|
70948
|
use base 'PDF::API2::Basic::PDF::Objind'; |
|
40
|
|
|
|
|
96
|
|
|
40
|
|
|
|
|
6535
|
|
12
|
|
|
|
|
|
|
|
13
|
40
|
|
|
40
|
|
292
|
use strict; |
|
40
|
|
|
|
|
92
|
|
|
40
|
|
|
|
|
47374
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
our $VERSION = '2.044'; # VERSION |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 NAME |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
PDF::API2::Basic::PDF::String - Low-level PDF string object |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head1 METHODS |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=cut |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
our %trans = ( |
26
|
|
|
|
|
|
|
'n' => "\n", |
27
|
|
|
|
|
|
|
'r' => "\r", |
28
|
|
|
|
|
|
|
't' => "\t", |
29
|
|
|
|
|
|
|
'b' => "\b", |
30
|
|
|
|
|
|
|
'f' => "\f", |
31
|
|
|
|
|
|
|
"\\" => "\\", |
32
|
|
|
|
|
|
|
'(' => '(', |
33
|
|
|
|
|
|
|
')' => ')', |
34
|
|
|
|
|
|
|
); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
our %out_trans = ( |
37
|
|
|
|
|
|
|
"\n" => 'n', |
38
|
|
|
|
|
|
|
"\r" => 'r', |
39
|
|
|
|
|
|
|
"\t" => 't', |
40
|
|
|
|
|
|
|
"\b" => 'b', |
41
|
|
|
|
|
|
|
"\f" => 'f', |
42
|
|
|
|
|
|
|
"\\" => "\\", |
43
|
|
|
|
|
|
|
'(' => '(', |
44
|
|
|
|
|
|
|
')' => ')', |
45
|
|
|
|
|
|
|
); |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=head2 PDF::API2::Basic::PDF::String->from_pdf($string) |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
Creates a new string object (not a full object yet) from a given |
50
|
|
|
|
|
|
|
string. The string is parsed according to input criteria with |
51
|
|
|
|
|
|
|
escaping working. |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=cut |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub from_pdf { |
56
|
399
|
|
|
399
|
1
|
914
|
my ($class, $str) = @_; |
57
|
399
|
|
|
|
|
685
|
my $self = {}; |
58
|
|
|
|
|
|
|
|
59
|
399
|
|
|
|
|
737
|
bless $self, $class; |
60
|
399
|
|
|
|
|
1052
|
$self->{'val'} = $self->convert($str); |
61
|
399
|
|
|
|
|
729
|
$self->{' realised'} = 1; |
62
|
399
|
|
|
|
|
942
|
return $self; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=head2 PDF::API2::Basic::PDF::String->new($string) |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
Creates a new string object (not a full object yet) from a given |
68
|
|
|
|
|
|
|
string. The string is parsed according to input criteria with |
69
|
|
|
|
|
|
|
escaping working. |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=cut |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
sub new { |
74
|
30503
|
|
|
30503
|
1
|
48291
|
my ($class, $str) = @_; |
75
|
30503
|
|
|
|
|
45835
|
my $self = {}; |
76
|
|
|
|
|
|
|
|
77
|
30503
|
|
|
|
|
45954
|
bless $self, $class; |
78
|
30503
|
|
|
|
|
59123
|
$self->{'val'} = $str; |
79
|
30503
|
|
|
|
|
43956
|
$self->{' realised'} = 1; |
80
|
30503
|
|
|
|
|
73044
|
return $self; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=head2 $s->convert($str) |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
Returns $str converted as per criteria for input from PDF file |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=cut |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub convert { |
90
|
30
|
|
|
30
|
1
|
81
|
my ($self, $input) = @_; |
91
|
30
|
|
|
|
|
50
|
my $output = ''; |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# Hexadecimal Strings (PDF 1.7 section 7.3.4.3) |
94
|
30
|
100
|
|
|
|
110
|
if ($input =~ m|^\s*\<|o) { |
95
|
3
|
|
|
|
|
10
|
$self->{' ishex'} = 1; |
96
|
3
|
|
|
|
|
5
|
$output = $input; |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
# Remove any extraneous characters to simplify processing |
99
|
3
|
|
|
|
|
16
|
$output =~ s/[^0-9a-f]+//gio; |
100
|
3
|
|
|
|
|
11
|
$output = "<$output>"; |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
# Convert each sequence of two hexadecimal characters into a byte |
103
|
3
|
|
|
|
|
16
|
1 while $output =~ s/\<([0-9a-f]{2})/chr(hex($1)) . '<'/oige; |
|
7
|
|
|
|
|
46
|
|
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
# If a single hexadecimal character remains, append 0 and |
106
|
|
|
|
|
|
|
# convert it into a byte. |
107
|
3
|
|
|
|
|
11
|
$output =~ s/\<([0-9a-f])\>/chr(hex($1 . '0'))/oige; |
|
1
|
|
|
|
|
5
|
|
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
# Remove surrounding angle brackets |
110
|
3
|
|
|
|
|
8
|
$output =~ s/\<\>//og; |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
# Literal Strings (PDF 1.7 section 7.3.4.2) |
114
|
|
|
|
|
|
|
else { |
115
|
|
|
|
|
|
|
# Remove surrounding parentheses |
116
|
27
|
|
|
|
|
212
|
$input =~ s/^\s*\((.*)\)\s*$/$1/os; |
117
|
|
|
|
|
|
|
|
118
|
27
|
|
|
|
|
60
|
my $cr = '(?:\015\012|\015|\012)'; |
119
|
27
|
|
|
|
|
38
|
my $prev_input; |
120
|
27
|
|
|
|
|
72
|
while ($input) { |
121
|
52
|
50
|
66
|
|
|
148
|
if (defined $prev_input and $input eq $prev_input) { |
122
|
0
|
|
|
|
|
0
|
die "Infinite loop while parsing literal string"; |
123
|
|
|
|
|
|
|
} |
124
|
52
|
|
|
|
|
84
|
$prev_input = $input; |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
# Convert bachslash followed by up to three octal digits |
127
|
|
|
|
|
|
|
# into that binary byte |
128
|
52
|
100
|
|
|
|
492
|
if ($input =~ /^\\([0-7]{1,3})(.*)/os) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
129
|
13
|
|
|
|
|
45
|
$output .= chr(oct($1)); |
130
|
13
|
|
|
|
|
33
|
$input = $2; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
# Convert backslash followed by an escaped character into that |
133
|
|
|
|
|
|
|
# character |
134
|
|
|
|
|
|
|
elsif ($input =~ /^\\([nrtbf\\\(\)])(.*)/osi) { |
135
|
9
|
|
|
|
|
35
|
$output .= $trans{$1}; |
136
|
9
|
|
|
|
|
38
|
$input = $2; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
# Ignore backslash followed by an end-of-line marker |
139
|
|
|
|
|
|
|
elsif ($input =~ /^\\$cr(.*)/os) { |
140
|
5
|
|
|
|
|
17
|
$input = $1; |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
# Convert an unescaped end-of-line marker to a line-feed |
143
|
|
|
|
|
|
|
elsif ($input =~ /^\015\012?(.*)/os) { |
144
|
2
|
|
|
|
|
5
|
$output .= "\012"; |
145
|
2
|
|
|
|
|
5
|
$input = $1; |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
# Check to see if there are any other special sequences |
148
|
|
|
|
|
|
|
elsif ($input =~ /^(.*?)((?:\\(?:[nrtbf\\\(\)0-7]|$cr)|\015\012?).*)/os) { |
149
|
10
|
|
|
|
|
23
|
$output .= $1; |
150
|
10
|
|
|
|
|
27
|
$input = $2; |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
else { |
153
|
13
|
|
|
|
|
34
|
$output .= $input; |
154
|
13
|
|
|
|
|
41
|
$input = undef; |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
30
|
|
|
|
|
106
|
return $output; |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=head2 $s->val |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
Returns the value of this string (the string itself). |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
=cut |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
sub val { |
170
|
1050
|
|
|
1050
|
1
|
4213
|
return $_[0]->{'val'}; |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=head2 $->as_pdf |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
Returns the string formatted for output as PDF for PDF File object $pdf. |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=cut |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
sub as_pdf { |
181
|
164
|
|
|
164
|
1
|
372
|
my ($self) = @_; |
182
|
164
|
|
|
|
|
381
|
my $str = $self->{'val'}; |
183
|
|
|
|
|
|
|
|
184
|
164
|
100
|
66
|
|
|
1167
|
if ($self->{' ishex'}) { # imported as hex ? |
|
|
100
|
33
|
|
|
|
|
185
|
1
|
|
|
|
|
8
|
$str = unpack('H*', $str); |
186
|
1
|
|
|
|
|
7
|
return "<$str>"; |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
elsif ($self->{' isutf'} or (utf8::is_utf8($str) and $str =~ /[^[:ascii:]]/)) { |
189
|
1
|
|
|
|
|
11
|
$str = join('', map { sprintf('%04X' , $_) } unpack('U*', $str) ); |
|
3
|
|
|
|
|
14
|
|
190
|
1
|
|
|
|
|
7
|
return ""; |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
else { |
193
|
162
|
100
|
|
|
|
574
|
if ($str =~ m/[^\n\r\t\b\f\040-\176\200-\377]/) { |
194
|
3
|
|
|
|
|
13
|
$str =~ s/(.)/sprintf('%02X', ord($1))/sge; |
|
18
|
|
|
|
|
54
|
|
195
|
3
|
|
|
|
|
17
|
return "<$str>"; |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
else { |
198
|
159
|
|
|
|
|
1525
|
$str =~ s/([\n\r\t\b\f\\()])/\\$out_trans{$1}/g; |
199
|
159
|
|
|
|
|
836
|
return "($str)"; |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=head2 $s->outobjdeep |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
Outputs the string in PDF format, complete with necessary conversions |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
=cut |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
sub outobjdeep { |
211
|
3218
|
|
|
3218
|
1
|
5342
|
my ($self, $fh, $pdf) = @_; |
212
|
|
|
|
|
|
|
|
213
|
3218
|
|
|
|
|
6816
|
$fh->print($self->as_pdf($pdf)); |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
1; |