File Coverage

blib/lib/PDF/API2/Basic/PDF/String.pm
Criterion Covered Total %
statement 66 67 98.5
branch 19 20 95.0
condition 5 9 55.5
subroutine 8 8 100.0
pod 6 6 100.0
total 104 110 94.5


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;