Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
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
  • Outside of code tags, you may need to use entities for some characters:
            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 scrutinizing the Monastery: (8)
    As of 2014-09-19 17:09 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      How do you remember the number of days in each month?











      Results (143 votes), past polls