Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
#!/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/&amp\;/&/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/&amp\;/&/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... :)

In reply to Dynamically Generate PDF's On The Fly by LostS

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others studying the Monastery: (11)
    As of 2015-07-31 20:11 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (281 votes), past polls