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