File Coverage

blib/lib/PDF/Builder/Basic/PDF/String.pm
Criterion Covered Total %
statement 70 71 98.5
branch 19 20 95.0
condition 5 9 55.5
subroutine 9 9 100.0
pod 6 6 100.0
total 109 115 94.7


line stmt bran cond sub pod time code
1             #=======================================================================
2             #
3             # THIS IS A REUSED PERL MODULE, FOR PROPER LICENCING TERMS SEE BELOW:
4             #
5             # Copyright Martin Hosken
6             #
7             # No warranty or expression of effectiveness, least of all regarding
8             # anyone's safety, is implied in this software or documentation.
9             #
10             # This specific module is licensed under the Perl Artistic License.
11             # Effective 28 January 2021, the original author and copyright holder,
12             # Martin Hosken, has given permission to use and redistribute this module
13             # under the MIT license.
14             #
15             #=======================================================================
16             package PDF::Builder::Basic::PDF::String;
17              
18 37     37   71656 use base 'PDF::Builder::Basic::PDF::Objind';
  37         91  
  37         5820  
19              
20 37     37   808 use strict;
  37         104  
  37         992  
21 37     37   205 use warnings;
  37         83  
  37         45358  
22              
23             our $VERSION = '3.023'; # VERSION
24             our $LAST_UPDATE = '3.023'; # manually update whenever code is changed
25              
26             =head1 NAME
27              
28             PDF::Builder::Basic::PDF::String - PDF String type objects and superclass
29             for simple objects that are basically stringlike (Number, Name, etc.)
30              
31             =head1 METHODS
32              
33             =cut
34              
35             our %trans = (
36             'n' => "\n",
37             'r' => "\r",
38             't' => "\t",
39             'b' => "\b",
40             'f' => "\f",
41             "\\" => "\\",
42             '(' => '(',
43             ')' => ')',
44             );
45              
46             our %out_trans = (
47             "\n" => 'n',
48             "\r" => 'r',
49             "\t" => 't',
50             "\b" => 'b',
51             "\f" => 'f',
52             "\\" => "\\",
53             '(' => '(',
54             ')' => ')',
55             );
56              
57             =head2 PDF::Builder::Basic::PDF::String->from_pdf($string)
58              
59             Creates a new string object (not a full object yet) from a given
60             string. The string is parsed according to input criteria with
61             escaping working.
62              
63             =cut
64              
65             sub from_pdf {
66 896     896 1 1555 my ($class, $str) = @_;
67 896         1360 my $self = {};
68              
69 896         1345 bless $self, $class;
70 896         1641 $self->{'val'} = $self->convert($str);
71 896         1374 $self->{' realised'} = 1;
72 896         1722 return $self;
73             }
74              
75             =head2 PDF::Builder::Basic::PDF::String->new($string)
76              
77             Creates a new string object (not a full object yet) from a given
78             string. The string is parsed according to input criteria with
79             escaping working.
80              
81             =cut
82              
83             sub new {
84 30512     30512 1 50666 my ($class, $str) = @_;
85 30512         48242 my $self = {};
86              
87 30512         46701 bless $self, $class;
88 30512         59633 $self->{'val'} = $str;
89 30512         45389 $self->{' realised'} = 1;
90 30512         72277 return $self;
91             }
92              
93             =head2 $s->convert($str)
94              
95             Returns $str converted as per criteria for input from PDF file
96              
97             =cut
98              
99             sub convert {
100 29     29 1 58 my ($self, $input) = @_;
101 29         50 my $output = '';
102              
103             # Hexadecimal Strings (PDF 1.7 section 7.3.4.3)
104 29 100       103 if ($input =~ m|^\s*\<|o) {
105 3         8 $self->{' ishex'} = 1;
106 3         6 $output = $input;
107              
108             # Remove any extraneous characters to simplify processing
109 3         17 $output =~ s/[^0-9a-f]+//gio;
110 3         7 $output = "<$output>";
111              
112             # Convert each sequence of two hexadecimal characters into a byte
113 3         17 1 while $output =~ s/\<([0-9a-f]{2})/chr(hex($1)) . '<'/oige;
  7         49  
114              
115             # If a single hexadecimal character remains, append 0 and
116             # convert it into a byte.
117 3         7 $output =~ s/\<([0-9a-f])\>/chr(hex($1 . '0'))/oige;
  1         4  
118              
119             # Remove surrounding angle brackets
120 3         10 $output =~ s/\<\>//og;
121             }
122              
123             # Literal Strings (PDF 1.7 section 7.3.4.2)
124             else {
125             # Remove surrounding parentheses
126 26         181 $input =~ s/^\s*\((.*)\)\s*$/$1/os;
127              
128 26         56 my $cr = '(?:\015\012|\015|\012)';
129 26         44 my $prev_input;
130 26         68 while ($input) {
131 51 50 66     150 if (defined $prev_input and $input eq $prev_input) {
132 0         0 die "Infinite loop while parsing literal string";
133             }
134 51         80 $prev_input = $input;
135              
136             # Convert bachslash followed by up to three octal digits
137             # into that binary byte
138 51 100       392 if ($input =~ /^\\([0-7]{1,3})(.*)/os) {
    100          
    100          
    100          
    100          
139 13         34 $output .= chr(oct($1));
140 13         33 $input = $2;
141             }
142             # Convert backslash followed by an escaped character into that
143             # character
144             elsif ($input =~ /^\\([nrtbf\\\(\)])(.*)/osi) {
145 9         25 $output .= $trans{$1};
146 9         29 $input = $2;
147             }
148             # Ignore backslash followed by an end-of-line marker
149             elsif ($input =~ /^\\$cr(.*)/os) {
150 5         15 $input = $1;
151             }
152             # Convert an unescaped end-of-line marker to a line-feed
153             elsif ($input =~ /^\015\012?(.*)/os) {
154 2         4 $output .= "\012";
155 2         7 $input = $1;
156             }
157             # Check to see if there are any other special sequences
158             elsif ($input =~ /^(.*?)((?:\\(?:[nrtbf\\\(\)0-7]|$cr)|\015\012?).*)/os) {
159 10         22 $output .= $1;
160 10         28 $input = $2;
161             }
162             else {
163 12         33 $output .= $input;
164 12         35 $input = undef;
165             }
166             }
167             }
168              
169 29         89 return $output;
170             }
171              
172             =head2 $s->val()
173              
174             Returns the value of this string (the string itself).
175              
176             =cut
177              
178             sub val {
179 2090     2090 1 6766 return $_[0]->{'val'};
180             }
181              
182             =head2 $s->as_pdf()
183              
184             Returns the string formatted for output as PDF for PDF File object $pdf.
185              
186             =cut
187              
188             sub as_pdf {
189 138     138 1 313 my ($self) = @_;
190 138         314 my $str = $self->{'val'};
191              
192 138 100 66     1134 if ($self->{' ishex'}) { # imported as hex ?
    100 33        
193 1         7 $str = unpack('H*', $str);
194 1         8 return "<$str>";
195             } elsif ($self->{' isutf'} or
196             (utf8::is_utf8($str) and
197             $str =~ /[^[:ascii:]]/)) {
198 1         9 $str = join('', map { sprintf('%04X' , $_) } unpack('U*', $str) );
  3         13  
199 1         7 return "";
200             } else {
201 136 100       653 if ($str =~ m/[^\n\r\t\b\f\040-\176\200-\377]/) {
202 3         13 $str =~ s/(.)/sprintf('%02X', ord($1))/sge;
  18         60  
203 3         18 return "<$str>";
204             } else {
205 133         379 $str =~ s/([\n\r\t\b\f\\()])/\\$out_trans{$1}/g;
206 133         650 return "($str)";
207             }
208             }
209             }
210              
211             =head2 $s->outobjdeep($fh, $pdf)
212              
213             Outputs the string in PDF format, complete with necessary conversions.
214              
215             =cut
216              
217             sub outobjdeep {
218 11468     11468 1 17935 my ($self, $fh, $pdf) = @_;
219              
220 11468         23066 $fh->print($self->as_pdf($pdf));
221 11468         67257 return;
222             }
223              
224             1;