Category: | Web Stuff |
Author/Contact Info | Billy Strader - straderb@mindspring.com |
Description: | Recently I have had the joy of dynamically generating a PDF on the fly. Alot of people suggested putting the data in a text file then put it into PDF format. However I needed the ability to add graphics and also to add color's. So I did some research and found a nice little module called PDF::Create. You can get the most recent version from http://sourceforge.net/projects/perl-pdf . The sad part is most of the developers who made this module have pretty much stoped working on it. What they do have works great... except for the adding of gif's. JPG's work great but not gif's. So here is my code I used to generate my PDF on the fly. I contacted the creator of the module in the PDF::Create about GIFImage.pm due to the errors I was having. He looked at the code and found the problem and fixed it and sent me the updated code... So below my code is the updated GIFImage.pm :) |
#!/usr/bin/perl use Text::Autoformat; use Text::ParseWords; use PDF::Create; use strict; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(t +ime); my $pdf = new PDF::Create('filename' => "mypdf.pdf", 'PageMode' => 'UseOutlines', 'Author' => 'My Author', 'Title' => 'My Title', 'CreationDate' => [ localtime ], ); my $root = $pdf->new_page('MediaBox' => [ 0, 0, 612, 792 ]); # Add a page which inherits its attributes from $root my $mpage = $root->new_page; # Prepare 2 fonts my $f1 = $pdf->font('Subtype' => 'Type1', 'Encoding' => 'WinAnsiEncoding', 'BaseFont' => 'Helvetica' ); my $f2 = $pdf->font('Subtype' => 'Type1', 'Encoding' => 'WinAnsiEncoding', 'BaseFont' => 'Helvetica-Bold' ); # Prepare a Table of Content my $toc = $pdf->new_outline('Title' => 'Retention Reports', 'Destination' => $mpage ); my $gif = $pdf->image("mypicture.jpg"); $mpage->image('image' => $gif, 'xpos' => 100, 'ypos' => 426, ); $mpage->stringc($f2, 40, 306, 426, "My Data For PDF"); $year = 1900 + $year; $mpage->stringc($f1, 20, 306, 396, "Final Draft $mon-$mday-$year"); # starting location my $loc = 680; my $firstpage = 0; my $partc = 0; my $recc = 0; my $retc = 0; my $citrc = 0; ## The Part below is/was for me opening a data file and dumpign the da +ta into an array. Then I took the array and parsed the data out to pr +int it. ## To do a new line all I had to do was subtract 14 from each $loc and + then if $loc ever goes below 60.. begin a new page. ## I know most of this is kind of ugly... but hey it may help those wh +o have the task of making a PDF on the fly. ## Sorry for the lack of comments in the code... That is one of my dow +n falls... foreach my $cat (@catagories) { chomp $cat; $cat =~ s/&\;/&/g; ($catid, $catname) = split(/#!#/,$cat); $catid = uc$catid; $page{"$catid"} = $root->new_page; $s{"$catid"} = $toc->new_outline('Title' => "$catname"); foreach $entry (@series) { chomp $entry; $entry =~ s/&\;/&/g; my ($id, $title, $retent, $smdesc, $lngdesc, $recordcopy, $ret +ention, $citref) = split(/\t/,$entry); my ($letter,$number) = $id =~ /(\w+?)(\d+)/; $letter = uc$letter; if ($letter eq $catid) { if ($firstpage != 1) { $page{"$catid"}->stringl($f2, 15, 36, 710, "$catname / + Category $catid"); $firstpage = 1; } $page{"$catid"}->stringl($f2, 12, 36, $loc, "($number) $ti +tle"); $loc -= 14; if ($lngdesc) { $formatted = autoformat $lngdesc, { left=>0, right=>80 + }; } else { $formatted = " "; } my @lng = split(/\n/,$formatted); foreach my $part (@lng) { if ($loc < 60) { $page{"$catid"} = $root->new_page; $loc = 700; } if ($partc != 1) { $page{"$catid"}->stringl($f2, 12, 36, $loc, "Expla +nation: "); $page{"$catid"}->stringl($f1, 12, 110, $loc, $part +); $loc -= 14; $partc = 1; } else { if ($part) { $page{"$catid"}->stringl($f1, 12, 113, $loc, $ +part); $loc -= 14; } } } if ($recordcopy) { $formatted = autoformat $recordcopy, { left=>0, right= +>80 }; } else { $formatted = " "; } my @recordcopy = split(/\n/,$formatted); foreach my $rec (@recordcopy) { chomp $rec; $rec =~ s/^\s+//g; $rec =~ s/\s+$//g; if ($loc < 60) { $page{"$catid"} = $root->new_page; $loc = 700; } if ($recc != 1) { $page{"$catid"}->stringl($f2, 12, 36, $loc, "Recor +d Copy: "); $page{"$catid"}->stringl($f1, 12, 120, $loc, $rec) +; $loc -= 14; $recc = 1; } else { if ($rec) { $page{"$catid"}->stringl($f1, 12, 125, $loc, $ +rec); $loc -= 14; } } } if ($retention) { $formatted = autoformat $retention, { left=>0, right=> +80 }; } else { $formatted = " "; } my @retention = split(/\n/,$formatted); foreach my $ret (@retention) { chomp $ret; $ret =~ s/^\s+//g; $ret =~ s/\s+$//g; if ($loc < 60) { $page{"$catid"} = $root->new_page; $loc = 700; } if ($retc != 1) { $page{"$catid"}->stringl($f2, 12, 36, $loc, "Reten +tion: "); $page{"$catid"}->stringl($f1, 12, 100, $loc, $ret) +; $loc -= 14; $retc = 1; } else { if ($ret) { $page{"$catid"}->stringl($f1, 12, 105, $loc, $ +ret); $loc -= 14; } } } if ($citref) { $formatted = autoformat $citref, { left=>0, right=>80 +}; } else { $formatted = " "; } my @citref = split(/\n/,$formatted); foreach my $citr (@citref) { chomp $citr; $citr =~ s/^\s+//g; $citr =~ s/\s+$//g; if ($loc < 60) { $page{"$catid"} = $root->new_page; $loc = 700; } if ($citrc != 1) { $page{"$catid"}->stringl($f2, 12, 36, $loc, "Citat +ion or Reference: "); $page{"$catid"}->stringl($f1, 12, 165, $loc, $citr +); $loc -= 14; $citrc = 1; } else { if ($citr) { $page{"$catid"}->stringl($f1, 12, 170, $loc, $ +citr); $loc -= 14; } } } $loc -= 14; if ($loc < 60) { $page{"$catid"} = $root->new_page; $loc = 700; } } $partc = 0; $recc = 0; $retc = 0; $citrc = 0; } $loc = 680; $firstpage = 0; } $pdf->close; sub parse2array { return quotewords($_[1],0,$_[0]); }Updated GIFImage.pm in the PDF::Image part... Fixed by the creator himself :) NOTE: This is an update for Perl 5.6.1 ... I cant seem to get the GIF part working on 5.005_3 :( # -*- mode: Perl -*- # PDF::Image::GIFImage - GIF image support # Author: Michael Gross <mdgrosse@sbox.tugraz.at> # Version: 0.06 # Copyright 2001 Michael Gross <mdgrosse@sbox.tugraz.at> package GIFImage; use strict; use vars qw(@ISA @EXPORT $VERSION $DEBUG); use Exporter; use FileHandle; @ISA = qw(Exporter); @EXPORT = qw(); $VERSION = 0.06; $DEBUG = 0; sub new { my $self = {}; $self->{private} = {}; $self->{colorspace} = 0; $self->{width} = 0; $self->{height} = 0; $self->{colorspace} = "DeviceRGB"; $self->{colorspacedata} = ""; $self->{colorspacesize} = 0; $self->{filename} = ""; $self->{error} = ""; $self->{imagesize} = 0; $self->{transparent} = 0; $self->{filter} = ["LZWDecode"]; $self->{decodeparms} = {'EarlyChange' => 0}; $self->{private}->{interlaced} = 0; bless($self); return $self; } sub LZW { my $self = shift; my $data = shift; my $result = ""; my $prefix = ""; my $c; my %hash; my $num; my $codesize = 9; #init hash-table for ($num=0; $num<256; $num++) { $hash{chr($num)} = $num; } #start with a clear $num = 258; my $currentvalue = 256; my $bits = 9; my $pos = 0; while ($pos < length($data)) { $c = substr($data, $pos, 1); if (exists($hash{$prefix . $c})) { $prefix.=$c; } else { #save $hash{$prefix} $currentvalue<<=$codesize; $currentvalue|=$hash{$prefix}; $bits+=$codesize; while ($bits >= 8) { $result.=chr(($currentvalue >> ($bits-8)) & 255); $bits-=8; $currentvalue&=(1 << $bits) - 1; } $hash{$prefix . $c} = $num; $prefix = $c; $num++; #increase code size? if ($num==513 || $num==1025 || $num==2049) { $codesize++; } #hash table overflow? if ($num==4097) { #save clear $currentvalue<<=$codesize; $currentvalue|=256; $bits+=$codesize; while ($bits >= 8) { $result.=chr(($currentvalue >> ($bits-8)) & 255); $bits-=8; $currentvalue&=(1 << $bits) - 1; } #reset hash table $codesize = 9; %hash = (); for ($num=0; $num<256; $num++) { $hash{chr($num)} = $num; } $num=258; } } $pos++; } #save value for prefix $currentvalue<<=$codesize; $currentvalue|=$hash{$prefix}; $bits+=$codesize; while ($bits >= 8) { $result.=chr(($currentvalue >> ($bits-8)) & 255); $bits-=8; $currentvalue&=(1 << $bits) - 1; } #save eoi $currentvalue<<=$codesize; $currentvalue|=257; $bits+=$codesize; while ($bits >= 8) { $result.=chr(($currentvalue >> ($bits-8)) & 255); $bits-=8; $currentvalue&=(1 << $bits) - 1; } #save remainder in $currentvalue if ($bits > 0) { $currentvalue = $currentvalue << (8-$bits); $result.=chr($currentvalue & 255); } $result; } sub UnLZW { my $self = shift; my $data = shift; my $result = ""; my $bits = 0; my $currentvalue = 0; my $codesize = 9; my $pos = 0; my $prefix = ""; my $suffix; my @table; #initialize lookup-table my $num; for ($num=0; $num<256; $num++) { $table[$num] = chr($num); } $table[256] = ""; $num = 257; my $c1; #get first word while ($bits < $codesize) { my $d = ord(substr($data, $pos, 1)); $currentvalue = ($currentvalue<<8) + $d; $bits+=8; $pos++; } my $c2 = $currentvalue >> ($bits - $codesize); $bits-=$codesize; my $mask = (1 << $bits) - 1; $currentvalue = $currentvalue & $mask; DECOMPRESS: while ($pos < length($data)) { $c1 = $c2; #get next word while ($bits < $codesize) { my $d = ord(substr($data, $pos, 1)); $currentvalue = ($currentvalue<<8) + $d; $bits+=8; $pos++; } $c2 = $currentvalue >> ($bits - $codesize); $bits-=$codesize; $mask = (1 << $bits) - 1; $currentvalue = $currentvalue & $mask; #clear code? if ($c2 == 256) { $result.=$table[$c1]; $#table = 256; $codesize = 9; $num = 257; next DECOMPRESS; } #End Of Image? if ($c2 == 257) { last DECOMPRESS; } #get prefix if ($c1 < $num) { $prefix = $table[$c1]; } else { print "Compression Error ($c1>=$num)\n"; } #write prefix $result.=$prefix; #get suffix if ($c2 < $num) { $suffix = substr($table[$c2], 0, 1); } elsif ($c2 == $num) { $suffix = substr($prefix, 0, 1); } else { print "Compression Error ($c2>$num)\n"; } #new table entry is prefix.suffix $table[$num] = $prefix . $suffix; #next table entry $num++; #increase code size? if ($num==512 || $num==1024 || $num==2048) { $codesize++; } } $result.=$table[$c1]; $result; } sub UnInterlace { my $self = shift; my $data = shift; my $row; my @result; my $width = $self->{width}; my $height = $self->{height}; my $idx = 0; #Pass 1 - every 8th row, starting with row 0 $row = 0; while ($row < $height) { $result[$row] = substr($data, $idx*$width, $width); $row+=8; $idx++; } #Pass 2 - every 8th row, starting with row 4 $row = 4; while ($row < $height) { $result[$row] = substr($data, $idx*$width, $width); $row+=8; $idx++; } #Pass 3 - every 4th row, starting with row 2 $row = 2; while ($row < $height) { $result[$row] = substr($data, $idx*$width, $width); $row+=4; $idx++; } #Pass 4 - every 2th row, starting with row 1 $row = 1; while ($row < $height) { $result[$row] = substr($data, $idx*$width, $width); $row+=2; $idx++; } join('', @result); } sub GetDataBlock { my $self = shift; my $fh = shift; my $s; my $count; my $buf; read $fh, $s, 1; $count = unpack("C", $s); if ($count) { read $fh, $buf, $count; } ($count, $buf); } sub ReadColorMap { my $self = shift; my $fh = shift; read $fh, $self->{'colorspacedata'}, 3 * $self->{'colormapsize'}; 1; } sub DoExtension { my $self = shift; my $label = shift; my $fh = shift; my $res; my $buf; my $c; my $c2; my $c3; if ($label eq "\001") { #Plain Text Extension } elsif (ord($label)==0xFF) { #Application Extension } elsif (ord($label)==0xFE) { #Comment Extension } elsif (ord($label)==0xF9) { #Grapgic Control Extension ($res, $buf) = $self->GetDataBlock($fh); #(p, image, (unsigned + char*) buf); ($c, $c2, $c2, $c3) = unpack("CCCC", $buf); if ($c && 0x1 != 0) { $self->{transparent}=1; $self->{mask}=$c3; } } BLOCK: while (1) { ($res, $buf) = $self->GetDataBlock($fh); if ($res == 0) { last BLOCK; } } 1; } sub Open { my $self = shift; my $filename = shift; my $PDF_STRING_GIF = "\107\111\106"; my $PDF_STRING_87a = "\070\067\141"; my $PDF_STRING_89a = "\070\071\141"; my $LOCALCOLORMAP = 0x80; my $INTERLACE = 0x40; my $s; my $c; my $ar; my $flags; $self->{filename} = $filename; my $fh = new FileHandle "$filename"; read $fh, $s, 3; if ($s ne $PDF_STRING_GIF) { close $fh; $self->{error} = "Not a gif file."; return 0; } read $fh, $s, 3; if ($s ne $PDF_STRING_87a && $s ne $PDF_STRING_89a) { close $fh; $self->{error} = "GIF version $s not supported."; return 0; } read $fh, $s, 7; ($self->{width}, $self->{height}, $flags, $self->{private}->{backg +round}, $ar) = unpack("SSCCC", $s); $self->{colormapsize} = 2 << ($flags & 0x07); $self->{colorspacesize} = 3 * $self->{colormapsize}; if ($flags & $LOCALCOLORMAP) { if (!$self->ReadColorMap($fh)) { close $fh; $self->{error} = "Cant read color map."; return 0; } } if ($ar != 0) { $self->{private}->{dpi_x} = -($ar + 15.0) / 64.0; $self->{private}->{dpi_y} = -1.0; } my $imageCount = 0; IMAGES: while (1) { read $fh, $c, 1; if ($c eq ";") { #GIF file terminator close $fh; $self->{error} = "Cant find image in gif file."; return 0; } if ($c eq "!") { #Extension read $fh, $c, 1; $self->DoExtension($c, $fh); next; } if ($c ne ",") { #must be comma next; #ignore } $imageCount++; read $fh, $s, 9; my $x; ($x, $c, $self->{width}, $self->{height}, $flags) = unpack("SS +SSC", $s); if ($flags && $INTERLACE) { $self->{private}->{interlaced} = 1; } if ($flags & $LOCALCOLORMAP) { if (!$self->ReadColorMap($fh)) { close $fh; $self->{error} = "Cant read color map."; return 0; } } read $fh, $s, 1; #read "LZW initial code size" $self->{bpc} = unpack("C", $s); if ($self->{bpc} != 8) { close $fh; $self->{error} = "LZW minimum code size other than 8 not s +upported."; return 0; } if ($imageCount == 1) { last IMAGES; } } $self->{private}->{datapos} = tell($fh); close $fh; 1; } sub ReadData { my $self = shift; # init the LZW transformation vars my $c_size = 9; # initial code size my $t_size = 257; # initial "table" size my $i_buff = 0; # input buffer my $i_bits = 0; # input buffer empty my $o_bits = 0; # output buffer empty my $o_buff = 0; my $c_mask; my $bytes_available = 0; my $n_bytes; my $s; my $c; my $flag13; my $code; my $w_bits; my $result = ""; my $fh = new FileHandle $self->{filename}; seek($fh, $self->{private}->{datapos}, 0); my $pos = 0; my $data; read $fh, $data, (-s $self->{filename}); use integer; $self->{imagesize} = 0; BLOCKS: while (1) { $s = substr($data, $pos, 1); $pos++; $n_bytes = unpack("C", $s); if (!$n_bytes) { last BLOCKS; } $c_mask = (1 << $c_size) - 1; $flag13 = 0; BLOCK: while (1) { $w_bits = $c_size; # number of bits to write $code = 0; #get at least c_size bits into i_buff while ($i_bits < $c_size) { if ($n_bytes == 0) { last BLOCK; } $n_bytes--; $s = substr($data, $pos, 1); $pos++; $c = unpack("C", $s); $i_buff |= $c << $i_bits; #EOF will be caught later $i_bits += 8; } $code = $i_buff & $c_mask; $i_bits -= $c_size; $i_buff >>= $c_size; if ($flag13 && $code!=256 && $code!=257) { $self->{error} = "LZW code size overflow."; return 0; } if ($o_bits > 0) { $o_buff |= $code >> ($c_size - 8 + $o_bits); $w_bits -= 8 - $o_bits; $result.=chr($o_buff & 255); } if ($w_bits >= 8) { $w_bits -= 8; $result.=chr(($code >> $w_bits) & 255); } $o_bits = $w_bits; if ($o_bits > 0) { $o_buff = $code << (8 - $o_bits); } $t_size++; if ($code == 256) { #clear code $c_size = 9; $c_mask = (1 << $c_size) - 1; $t_size = 257; $flag13 = 0; } if ($code == 257) { #end code last BLOCK; } if ($t_size == (1 << $c_size)) { if (++$c_size > 12) { $c_size--; $flag13 = 1; } else { $c_mask = (1 << $c_size) - 1; } } } # while () for block } # while () for all blocks #interlaced? if ($self->{private}->{interlaced}) { #when interlaced first uncompress image $result = $self->UnLZW($result); #remove interlacing $result = $self->UnInterlace($result); #compress image again $result = $self->LZW($result); } $self->{imagesize} = length($result); $result; } 1;Thank you all for those who have helped me get this sytem up and working... :) |
|
---|
Back to
Code Catacombs