1# classes for PDF objects
2# 2001-2002 Sey <nakajima@netstock.co.jp>
3package PDFJ::Object;
4use strict;
5use Exporter;
6use vars qw($VERSION @ISA @EXPORT);
7@ISA = qw(Exporter);
8
9$VERSION = 0.4;
10
11@EXPORT = qw(
12	null bool number numbers string textstring datestring name array
13	dictionary stream contents_stream
14);
15
16# functions to generate an object
17sub null   {PDFJ::Obj::null->new(@_)}
18sub bool   {PDFJ::Obj::bool->new(@_)}
19sub number {PDFJ::Obj::number->new(@_)}
20sub numbers {map {PDFJ::Obj::number->new($_)} @_}
21sub string {PDFJ::Obj::string->new(@_)}
22sub textstring {PDFJ::Obj::textstring->new(@_)}
23sub datestring {PDFJ::Obj::datestring->new(@_)}
24sub name   {PDFJ::Obj::name->new(@_)}
25sub array  {PDFJ::Obj::array->new(@_)}
26sub dictionary {PDFJ::Obj::dictionary->new(@_)}
27sub stream {PDFJ::Obj::stream->new(@_)}
28sub contents_stream {PDFJ::Obj::contents_stream->new(@_)}
29
30#---------------------------------------
31package PDFJ::ObjTable;
32use strict;
33
34sub new {
35	my($class) = @_;
36	bless {objlist => [undef]}, $class;
37}
38
39sub lastobjnum {
40	my $self = shift;
41	$#{$self->{objlist}};
42}
43
44sub get {
45	my($self, $idx) = @_;
46	$self->{objlist}->[$idx];
47}
48
49sub set {
50	my($self, $idx, $obj) = @_;
51	$self->{objlist}->[$idx] = $obj;
52}
53
54#---------------------------------------
55# virtual base class
56package PDFJ::Obj;
57
58sub new {
59	my $class = shift;
60	my %args = @_ == 1 ? ('value' => $_[0]) : @_;
61	my $self = bless \%args, $class;
62	$self->value2obj if $self->can('value2obj');
63	$self;
64}
65
66sub unused {
67	my($self, $unused) = @_;
68	if( defined $unused ) {
69		$self->{unused} = $unused;
70	}
71	$self->{unused};
72}
73
74sub indirect {
75	my($self, $objtable) = @_;
76	unless( $self->{objnum} ) {
77		$self->{objnum} = $objtable->lastobjnum + 1;
78		$self->{gennum} = 0;
79		$objtable->set($self->{objnum}, $self);
80	}
81	$self;
82}
83
84sub indirectnum {
85	my $self = shift;
86	if( $self->{objnum} ) {
87		"$self->{objnum} $self->{gennum}";
88	}
89}
90
91sub output {
92	my($self, $rc4key, $filter) = @_;
93	my $inum = $self->indirectnum;
94	if( $inum ) {
95		"$inum R";
96	} else {
97		$self->{output} || $self->makeoutput($rc4key, $filter);
98	}
99}
100
101sub print {
102	my($self, $handle, $encryptkey, $filter) = @_;
103	my $inum = $self->indirectnum;
104	return 0 unless $inum;
105	my $rc4key;
106	if( $encryptkey ) {
107		require Digest::MD5;
108		my $md5obj = Digest::MD5->new;
109		$md5obj->add($encryptkey . substr(pack("V", $inum + 0), 0, 3) .
110			"\x00\x00");
111		$rc4key = substr($md5obj->digest, 0, 10);
112	}
113	my $output = $self->{output} || $self->makeoutput($rc4key, $filter);
114#	print $handle "$inum obj\n$output\nendobj\n\n";
115	my $str = "$inum obj\n$output\nendobj\n\n";
116	print $handle $str;
117	return length($str);
118}
119
120sub _toobj {
121	my($self, $value) = @_;
122	return $value if PDFJ::Util::objisa($value, 'PDFJ::Obj');
123	if( ref($value) eq 'ARRAY' ) {
124		$value = PDFJ::Obj::array->new($value);
125	} elsif( ref($value) eq 'HASH' ) {
126		$value = PDFJ::Obj::dictionary->new($value);
127	} elsif( $value =~ /^[+-]?\d*(\.\d*)?$/ ) {
128		$value = PDFJ::Obj::number->new($value);
129	} else {
130		$value = PDFJ::Obj::string->new($value);
131	}
132	$value;
133}
134
135#---------------------------------------
136package PDFJ::Obj::null;
137use strict;
138use vars qw(@ISA);
139@ISA = qw(PDFJ::Obj);
140
141sub makeoutput {
142	my $self = shift;
143	$self->{output} = 'null';
144}
145
146#---------------------------------------
147package PDFJ::Obj::bool;
148use strict;
149use vars qw(@ISA);
150@ISA = qw(PDFJ::Obj);
151
152sub makeoutput {
153	my $self = shift;
154	$self->{output} = $self->{value} ? 'true' : 'false';
155}
156
157#---------------------------------------
158package PDFJ::Obj::number;
159use strict;
160use vars qw(@ISA);
161@ISA = qw(PDFJ::Obj);
162
163sub makeoutput {
164	my $self = shift;
165	my $num = $self->{value} + 0;
166	$num = sprintf("%.14f", $num) if int($num) != $num;
167	$self->{output} = $num;
168}
169
170sub add {
171	my($self, $value) = @_;
172	$self->{value} += $value;
173}
174
175#---------------------------------------
176package PDFJ::Obj::string;
177use strict;
178use vars qw(@ISA);
179@ISA = qw(PDFJ::Obj);
180
181sub makeoutput {
182	my($self, $rc4key, $filter) = @_;
183	my $value = $self->{value};
184	if( $rc4key ) {
185		if( $self->{outputtype} eq 'hexliteral' ) {
186			$value = pack('H*', $value);
187		}
188		$value = PDFJ::Util::RC4($value, $rc4key);
189		$self->{outputtype} = 'hex';
190	} elsif( !defined $self->{outputtype} ||
191		$self->{outputtype} !~ /^(literal|hex|hexliteral)$/ ) {
192		$self->{outputtype} =
193			$value =~ /[^\x00-\x7f]/ ? 'hex' : 'literal';
194	}
195	if( $self->{outputtype} eq 'literal' ) {
196		$self->{output} = '(' . escape($value) . ')';
197	} elsif( $self->{outputtype} eq 'hexliteral' ) {
198		$self->{output} = '<' . $value . '>';
199	} else {
200		$self->{output} = '<' . tohex($value) . '>';
201	}
202}
203
204sub escape {
205	local($_) = @_;
206	s/[()\\]/\\$&/g;
207	s/\n/\\n/g;
208	s/\r/\\r/g;
209	s/\t/\\t/g;
210	#s/\b/\\b/g;
211	s/\f/\\f/g;
212	s/[^\x20-\x7e]/sprintf("\\%03o",ord($&))/ge;
213	$_;
214}
215
216sub tohex {
217	my $str = shift;
218	unpack("H*", $str);
219}
220
221#---------------------------------------
222package PDFJ::Obj::textstring;
223use strict;
224use vars qw(@ISA);
225@ISA = qw(PDFJ::Obj::string);
226
227sub value2obj {
228	my $self = shift;
229	if( $self->{value} =~ /[^\x00-\x7f]/ ) {
230		$self->{value} = PDFJ::Util::tounicode($self->{value}, 1);
231	}
232}
233
234#---------------------------------------
235package PDFJ::Obj::datestring;
236use strict;
237use vars qw(@ISA);
238@ISA = qw(PDFJ::Obj::string);
239
240sub value2obj {
241	my $self = shift;
242	my @time = gmtime($self->{value} || time);
243	$time[4]++;
244	$time[5] += 1900;
245	$self->{value} = sprintf("D:%04d%02d%02d%02d%02d%02dZ", @time[5,4,3,2,1,0]);
246}
247
248#---------------------------------------
249package PDFJ::Obj::name;
250use strict;
251use vars qw(@ISA);
252@ISA = qw(PDFJ::Obj);
253
254sub makeoutput {
255	my $self = shift;
256	$self->{output} = '/' . escape($self->{value});
257}
258
259sub escape {
260	local($_) = @_;
261	s/[()<>\[\]{}\/%#\s]/sprintf("#%02x",ord($&))/ge;
262	$_;
263}
264
265#---------------------------------------
266package PDFJ::Obj::array;
267use strict;
268use vars qw(@ISA);
269@ISA = qw(PDFJ::Obj);
270
271sub value2obj {
272	my $self = shift;
273	grep {$_ = $self->_toobj($_)} @{$self->{value}};
274}
275
276sub makeoutput {
277	my($self, $rc4key, $filter) = @_;
278	$self->{output} = '[' . join(' ', map {$_->output($rc4key, $filter)}
279		@{$self->{value}}) . ']';
280}
281
282sub get {
283	my($self, $idx) = @_;
284	$self->{value}->[$idx];
285}
286
287sub set {
288	my($self, $idx, $obj) = @_;
289	$self->{value}->[$idx] = $self->_toobj($obj);
290}
291
292sub insert {
293	my($self, $idx, $obj) = @_;
294	splice @{$self->{value}}, $idx, 0, $self->_toobj($obj);
295}
296
297sub push {
298	my($self, $obj) = @_;
299	push @{$self->{value}}, $self->_toobj($obj);
300}
301
302sub pop {
303	my($self) = @_;
304	pop @{$self->{value}};
305}
306
307sub unshift {
308	my($self, $obj) = @_;
309	unshift @{$self->{value}}, $self->_toobj($obj);
310}
311
312sub shift {
313	my($self) = @_;
314	shift @{$self->{value}};
315}
316
317sub add {
318	my($self, $obj) = @_;
319	my $objoutput = $self->_toobj($obj)->output;
320	$self->push($obj)
321		unless grep {$objoutput eq $_->output} @{$self->{value}}
322}
323
324#---------------------------------------
325package PDFJ::Obj::dictionary;
326use strict;
327use vars qw(@ISA);
328@ISA = qw(PDFJ::Obj);
329
330sub value2obj {
331	my $self = shift;
332	my $href = $self->{value};
333	for my $key(keys %$href) {
334		$href->{$key} = $self->_toobj($href->{$key});
335	}
336}
337
338sub nocrypt {
339	my $self = shift;
340	$self->{nocrypt} = 1;
341}
342
343sub makeoutput {
344	my($self, $rc4key, $filter) = @_;
345	$rc4key = '' if $self->{nocrypt};
346	my $href = $self->{value};
347	$self->{output} = '<<' .
348		join(' ', map {(PDFJ::Obj::name->new($_)->output($rc4key, $filter),
349			$href->{$_}->output($rc4key, $filter))} keys %$href) . '>>';
350}
351
352sub exists {
353	my($self, $key) = @_;
354	exists $self->{value}->{$key};
355}
356
357sub get {
358	my($self, $key) = @_;
359	$self->{value}->{$key};
360}
361
362sub set {
363	my($self, $key, $obj) = @_;
364	$self->{value}->{$key} = $self->_toobj($obj);
365}
366
367sub keys {
368	my($self) = @_;
369	keys %{$self->{value}};
370}
371
372#---------------------------------------
373package PDFJ::Obj::stream;
374use strict;
375use vars qw(@ISA);
376@ISA = qw(PDFJ::Obj);
377
378sub value2obj {
379	my $self = shift;
380	$self->{dictionary} = PDFJ::Obj::dictionary->new($self->{dictionary})
381		if exists $self->{dictionary};
382}
383
384sub makeoutput {
385	my($self, $rc4key, $filter) = @_;
386	my $stream = ref($self->{stream}) eq 'ARRAY' ?
387		join('', @{$self->{stream}}) : $self->{stream};
388	$self->{dictionary} = PDFJ::Obj::dictionary->new()
389		unless $self->{dictionary};
390	$self->{dictionary}->set(
391		Length => PDFJ::Obj::number->new(length($stream)) );
392	$stream = PDFJ::Util::RC4($stream, $rc4key) if $rc4key;
393	$self->{output} = $self->{dictionary}->output($rc4key, $filter) .
394		" stream\n" . $stream . "\nendstream";
395}
396
397sub dictionary {
398	my $self = shift;
399	$self->{dictionary};
400}
401
402sub append {
403	my($self, $data, $index) = @_;
404	if( ref($data) eq 'ARRAY' ) {
405		for my $d(@$data) {
406			append($self, $d, $index);
407		}
408	} else {
409		$index += 0;
410		$data = $data->output if PDFJ::Util::objisa($data, 'PDFJ::Obj');
411		if( ref($self->{stream}) eq 'ARRAY' ) {
412			$self->{stream}->[$index] .= $data;
413		} else {
414			$self->{stream} .= $data;
415		}
416	}
417}
418
419sub insert {
420	my($self, $data, $index) = @_;
421	if( ref($data) eq 'ARRAY' ) {
422		for my $d(@$data) {
423			insert($self, $d, $index);
424		}
425	} else {
426		$index += 0;
427		$data = $data->output if PDFJ::Util::objisa($data, 'PDFJ::Obj');
428		if( ref($self->{stream}) eq 'ARRAY' ) {
429			$self->{stream}->[$index] = $data . $self->{stream}->[$index];
430		} else {
431			$self->{stream} = $data . $self->{stream};
432		}
433	}
434}
435
436sub data {
437	my($self, $data, $index) = @_;
438	$index += 0;
439	if( ref($self->{stream}) eq 'ARRAY' ) {
440		$self->{stream}->[$index];
441	} else {
442		$self->{stream};
443	}
444}
445
446#---------------------------------------
447package PDFJ::Obj::contents_stream;
448use strict;
449use vars qw(@ISA);
450@ISA = qw(PDFJ::Obj::stream);
451
452sub makeoutput {
453	my($self, $rc4key, $filter) = @_;
454	my $stream = ref($self->{stream}) eq 'ARRAY' ?
455		join('', map { $_ ne '' ? " q $_ Q " : '' } @{$self->{stream}}) :
456		$self->{stream};
457	if( $filter =~ /f/ ) { # 'a' filter makes no effect
458		($stream, $filter) = PDFJ::Util::makestream($filter, \$stream);
459	}
460	$self->{dictionary} = PDFJ::Obj::dictionary->new()
461		unless $self->{dictionary};
462	$self->{dictionary}->set(
463		Length => PDFJ::Obj::number->new(length($stream)) );
464	$self->{dictionary}->set(Filter => $filter) if $filter;
465	$stream = PDFJ::Util::RC4($stream, $rc4key) if $rc4key;
466	$self->{output} = $self->{dictionary}->output($rc4key, $filter) .
467		" stream\n" . $stream . "\nendstream";
468}
469
4701;
471