http://www.perlmonks.org?node_id=190074


in reply to Dynamic PDF files with Perl

Oddly enough I just spent the morning doing much the same thing. I have some on-the-fly html pages like this and I have to use the same data to create PDFs that look like this. I wrote some methods which, though in some respects slightly cronky, I found useful. An important feature which these examples don't demo is that the methods cope with the case where you need more than one page. You find below a sample script, and the module with the methods. Enjoy!

§ George Sherston

The script, coursevenue.pdf

#!/usr/bin/perl -w use strict; use PDF::Create; use TrainingBoard::Utilities; use TrainingBoard::PDF; use CGI qw/:standard/; use URI::Escape; print "Content-type: application/pdf\n\n"; # initialise variables and get the submitted venue id and course title +: my $dbh= GetDBH; my $Params; my $VenueID = param('ID'); my $Title = ''; if (param('Title')) { $Title = '(Course: ' . uri_unescape(param('Title')) . ')'; } # get the data from db and load into Params my @VenueCols = qw/ VenueName VenueAddress1 VenueAddress2 VenueAddress3 VenuePostTown VenuePostCode VenueTelephone VenueFAX VenueEMail VenueWebSite VenueRating VenueGym VenueSwimmingPool VenueDisabled /; my $sth = $dbh->prepare("SELECT " . join (",", @VenueCols) . " FROM ve +nue WHERE VenueID = ?") or die $dbh->errstr; $sth->execute($VenueID) or die $dbh->errstr; $Params = $sth->fetchrow_hashref; if ($Params->{VenueRating}) { push @{$Params->{Info}}, "$Params->{VenueRating} star rating"; } if ($Params->{VenueDisabled}) { push @{$Params->{Info}}, 'Facilities for disabled people'; } if ($Params->{VenueGym}) { push @{$Params->{Info}}, 'Gym Facilities'; } if ($Params->{VenueSwimmingPool}) { push @{$Params->{Info}}, 'Swimming Pool'; } my @addr = qw/ VenueAddress1 VenueAddress2 VenueAddress3 VenuePostTown VenuePostCode /; for (@addr) { push @{$Params->{Address}}, $Params->{$_} if $Params->{$_}; } $Params->{Title} = $Title; # initialise pdf creation - set up print header, fonts and pdf object, # and set default values for positioning my $pdf = new PDF::Create( 'Version' => 1.2, 'Author' => 'jbr', 'Title' => time, 'fh' => *STDOUT, ); $pdf->{width} = 530; $pdf->{x} = 60; $pdf->{bottom} = 110; $pdf->{gap} = 60; $pdf->{cols} = 2; $pdf->{colnr} = 1; $pdf->{pagenr} = 0; $pdf->{pagearray} = []; my $fn = $pdf->font( 'Subtype' => 'Type1', 'Encoding' => 'WinAnsiEncoding', 'BaseFont' => 'Helvetica' ); my $fb = $pdf->font( 'Subtype' => 'Type1', 'Encoding' => 'WinAnsiEncoding', 'BaseFont' => 'Helvetica-Bold' ); my $fo = $pdf->font( 'Subtype' => 'Type1', 'Encoding' => 'WinAnsiEncoding', 'BaseFont' => 'Helvetica-Oblique' ); $pdf->{pagearray}->[$pdf->{pagenr}] = $pdf->new_page('MediaBox' => [ 0 +, 0, 650, 920 ]); # get height of header based on height of text in course title and # course provider name, and initialise top of print-out my $h = GetHeight($pdf,"$Params->{VenuePostTown} Venue",250,$fb,20,30) +; $h += GetHeight($pdf,$Params->{Title},250,$fo,20,30); $h += 10; $pdf->{top} = 840 - $h, $pdf->{y} = 825 - $h, # insert info AddBreak($pdf,11,8,0); AddLine($pdf,["Venue Information"],[$fb],12); AddBreak($pdf,11,8,0); AddBreak($pdf,11,8,1); AddBreak($pdf,11,8,0); AddGenInfo( $pdf, $fn, $fo, 'Venue:', $Params->{VenueName} ); AddBreak($pdf,11,8,1); AddBreak($pdf,11,8,0); my $addr = 'Address:'; for (@{$Params->{Address}}) { AddGenInfo( $pdf, $fn, $fo, $addr, $_ ); $addr = ''; } if ($Params->{VenueTelephone}) { AddBreak($pdf,11,8,1); AddBreak($pdf,11,8,0); AddGenInfo( $pdf, $fn, $fo, 'Tel No:', $Params->{VenueTelephone} ) } if ($Params->{VenueFAX}) { AddBreak($pdf,11,8,1); AddBreak($pdf,11,8,0); AddGenInfo( $pdf, $fn, $fo, 'Fax No:', $Params->{VenueFAX} ) } if ($Params->{VenueEMail}) { AddBreak($pdf,11,8,1); AddBreak($pdf,11,8,0); AddGenInfo( $pdf, $fn, $fo, 'EMail:', $Params->{VenueEMail} ) } if ($Params->{VenueWebSite}) { AddBreak($pdf,11,8,1); AddBreak($pdf,11,8,0); AddGenInfo( $pdf, $fn, $fo, 'Website:', $Params->{VenueWebSite} ) } if ($Params->{Info}) { AddBreak($pdf,11,8,1); AddBreak($pdf,11,8,0); AddLine($pdf,["Other Facilities:"],[$fb],10); for (@{$Params->{Info}}) { $pdf->{pagearray}->[$pdf->{pagenr}]->string($fb,20,$pdf->{x},$ +pdf->{y} - 4,'·'); $pdf->{x} += 10; AddLine($pdf,[$_],[$fn],10,15); $pdf->{x} -= 10; } } AddBreak($pdf,22,15,0); AddBreak($pdf,11,8,1); # add headers and footers: my $tl = scalar @{$pdf->{pagearray}}; my $no = $tl; for (reverse @{$pdf->{pagearray}}) { # I simply don't know why it has to be done backwards, or how I # get away without changing the page number. Maybe I shd # try and figure this out later on. $_->string($fo,14,60,860,'allmytraining.com'); $_->stringr($fo,14,590,860,'venue info sheet'); $_->line(60,850,590,850); $pdf->{y} = 825; $pdf->{x} = 60; $pdf->{cols} = 1; AddLine($pdf,["$Params->{VenuePostTown} Venue"],[$fb],20); AddLine($pdf,[$Params->{Title}],[$fo],20); $_->line(60,$pdf->{y}+18,590,$pdf->{y}+18); $_->line(60,80,590,80); $_->stringr($fn,10,590,50,"Page $no of $tl"); $no --; } $pdf->close;

The module, TrainingBoard::PDF

package TrainingBoard::PDF; require Exporter; @ISA = ("Exporter"); use PDF::Create; sub AddBreak { #--------------------------------------------------------------- # Inserts a break in the text, with a horizontal line if the # last argument is true. The first four args, which are # essential, are the pdf object, the position hashref, and the # height of the break. The fifth arg is the lineheight for # determining posn for new column - defaults to 15. #--------------------------------------------------------------- my $pdf = shift; my $space = shift; my $lineheight = shift || 15; my $line = shift || 0; # get width of current column from $posn (do this outside sub?) my $wholewidth = ($pdf->{width} - $pdf->{gap} * ($pdf->{cols} - 1) +) / $pdf->{cols}; if ($pdf->{y} - $space < $pdf->{bottom}) { if ($line) { if ($pdf->{y} - $space < $pdf->{bottom}) { $pdf->{y} = $pdf->{bottom}; } else { $pdf->{y} -= $space / 2; } $pdf->{pagearray}->[$pdf->{pagenr}]->line( $pdf->{x}, $pdf->{y}, $pdf->{x} + GetWidth($pdf), $pdf->{y} ); } $pdf->{y} = $pdf->{top} - $lineheight; if ($pdf->{colnr} >= $pdf->{cols}) { $pdf->{pagenr} ++; $pdf->{pagearray}->[$pdf->{pagenr}] = $pdf->new_page('Medi +aBox' => [ 0, 0, 650, 920 ]); $pdf->{x} = $pdf->{x} - ($wholewidth + $pdf->{gap}) * ($pd +f->{cols} - 1); $pdf->{colnr} = 1; } else { $pdf->{x} += GetWidth($pdf) + $pdf->{gap}; $pdf->{colnr} ++; } } else { if ($line) { $pdf->{pagearray}->[$pdf->{pagenr}]->line( $pdf->{x}, $pdf->{y} - $space / 2, $pdf->{x} + GetWidth($pdf), $pdf->{y} - $space / 2, ); } $pdf->{y} -= $space; } } sub AddLine { #--------------------------------------------------------------- # Adds a line of text, either a single line or a set of lines # in a table, to a pdf document #--------------------------------------------------------------- # get arguments. The first 2 are essential - the document # object and the text itself, in the form of an arrayref (if it # has more than one element, it's treated as a table). The # last 4 have defaults supplied at the point where they are # retrieved (to save space): font; font size; line height; # column width specifications for a table of text (default is # even spacing). my $pdf = shift; my $block = shift; my $font = shift;# || []; my $fontsize = shift || 10; my $lineheight = shift || int ($fontsize * 1.5); # n.b. this is also used for the gap between table cols my $cols = shift; # turn @$block into an array of arrays words, and # escape brackets (necessary to avoid messing up pdf): for (0..$#$block) { $block->[$_] =~ s/([\(\)])/\\$1/g; @$block->[$_] = [split /\s+/, $block->[$_]]; } # get default font values if necessary: for (@$font) { next if $_; $_ = $pdf->font( 'Subtype' => 'Type1', 'Encoding' => 'WinAnsiEncoding', 'BaseFont' => 'Helvetica' ); } # default table col widths if necessary unless ($cols) { $cols->[0] = 0; my $n = scalar(@$block) - 1; if ($n) { my $w = int ($wholewidth / ($n + 1)); for (1..$n) { push @$cols, $cols->[$#$cols] + $w; } } } # get width of current column from $posn (do this outside sub?) my $wholewidth = ($pdf->{width} - $pdf->{gap} * ($pdf->{cols} - 1) +) / $pdf->{cols}; # cycle through $block making up a row of text no wider than # $width and adding it to the page, adjusting the position # info accordingly while (@$block) { # take each array in the $block arrayref in turn, work out the # width of the column it's meant to go in for (0..$#$block) { my @text = @{$block->[$_]}; my $line = shift @text; my $left = $cols->[$_]; my $width = $#$cols > $_ ? $cols->[$_ + 1] - $cols->[$_] : + $wholewidth - $cols->[$_] ; $width -= $lineheight if (@$cols > 1 and $#$cols > $_); # i.e., if we're dealing with a table, make a gap to t +he right # now cycle through the sub-array, shifting off word after word # until we've got enough to fill the column my $sent = 0; while (@text) { my $word = shift @text; # so we always get at least one word - if this word + is wider than $width, it'll # overlap the next col, but that's better than neve +r printing it out. Ideally # at this pt I'd insert a hyphen if necessary. # if the text fills the column (i.e. if it wd overflow the column # with the addition of one more word) add it to the page if ($pdf->{pagearray}->[$pdf->{pagenr}]->string_width( +$font->[$_], $line . " " . $word) * $fontsize > $width) { $pdf->{pagearray}->[$pdf->{pagenr}]->string($font- +>[$_], $fontsize, ($pdf->{x} + $left), $pdf->{y}, $line ); unshift @text, $word; $sent ++; last; } # otherwise, add another word else { $line .= " " . $word; } } # send the remaining line if we've come to the end and haven't # sent it already $pdf->{pagearray}->[$pdf->{pagenr}]->string($font->[$_], $ +fontsize, ($pdf->{x} + $left), $pdf->{y}, $line) unless $sent or !$li +ne; # now put the remainder of the array back in the master array ($block) $block->[$_] = \@text; } # having gone through each element in @$block and sent part or all of # it to the page, we now adjust the position properties: if ($pdf->{y} < $pdf->{bottom}) { #diagnostics: #$pdf->{pagearray}->[0]->string($font->[$_], 40, 50, $c, "colnr: $pdf- +>{colnr} pagenr: $pdf->{pagenr} x: $pdf->{x} y: $pdf->{y} $pdf->{page +array}"); #$c -= 100; # need to initialise $c $pdf->{y} = $pdf->{top} - $lineheight; if ($pdf->{colnr} >= $pdf->{cols}) { $pdf->{pagenr} ++; $pdf->{pagearray}->[$pdf->{pagenr}] = $pdf->new_page(' +MediaBox' => [ 0, 0, 650, 920 ]); $pdf->{x} = $pdf->{x} - ($wholewidth + $pdf->{gap}) * +($pdf->{cols} - 1); $pdf->{colnr} = 1; } else { $pdf->{x} += $wholewidth + $pdf->{gap}; $pdf->{pagearray}->[$pdf->{pagenr}]->line( $pdf->{x} - $pdf->{gap} / 2, $pdf->{top}, $pdf->{x} - $pdf->{gap} / 2, $pdf->{bottom} ); $pdf->{colnr} ++; } } else { $pdf->{y} -= $lineheight; } # check whether all the arrays in @$block are empty, and get out # of the loop if they are last unless grep {scalar @$_ > 0} @$block; } } sub ProcessText { #--------------------------------------------------------------- # High level sub using AddLine repeatedly to create a # paragraph of text with bullet points if necessary #--------------------------------------------------------------- my $pdf = shift; my $text = shift; my $font = shift; my $fb = shift; my $fontsize = shift; my $lineheight = shift; my $paraheight = shift; my @text = split /\n/, $text; for my $line (@text) { if ($line =~ /^\s*$/) { AddBreak($pdf,$paraheight,15,0); } else { # manage creation of bps: if ($line =~ s/^-\s*//) { $pdf->{pagearray}->[$pdf->{pagenr}]->string($fb,20,$pd +f->{x},$pdf->{y} - 4,'·'); $pdf->{x} += 10; AddLine($pdf,[$line],[$font],$fontsize,$lineheight); $pdf->{x} -= 10; } else { AddLine($pdf,[$line],[$font],$fontsize,$lineheight); } } } } sub AddGenInfo { #--------------------------------------------------------------- # High level sub which inserts a row in a General Info table #--------------------------------------------------------------- my $pdf = shift; my $fn = shift; my $fo = shift; my @text = @_; AddLine( $pdf, \@text, [ $fo, $fn, ], 0, 17, [ 0, 80 ] ); } sub AddEvent { #--------------------------------------------------------------- # High level sub which inserts a row in the Events table (used # in tearsheet) #--------------------------------------------------------------- my $pdf = shift; my $fn = shift; my $placefont = shift; my @text = @_; AddLine( $pdf, \@text, [ $fn, $placefont, ], 0, 17, [ 0, 110 ] ); } sub AddKey { #--------------------------------------------------------------- # High level sub which inserts a row in the Keyword table (used # in tearsheet) #--------------------------------------------------------------- my $pdf = shift; my $fn = shift; my $fo = shift; my @text = @_; AddLine( $pdf, \@text, [ $fn, $fn, ], 0, 17, [ 0, 190 ] ); } sub GetHeight { #--------------------------------------------------------------- # Utility sub to get the height of a piece of text #--------------------------------------------------------------- my $pdf = shift; my $words = shift; my $width = shift; my $font = shift; my $fontsize = shift; my $lineheight = shift || 1.5 * $fontsize; my @words = split /\s+/, $words; my $height = $lineheight; my $string; my $word = shift @words; while (@words) { $string .= $word; $word = shift @words; if ($pdf->{pagearray}->[$pdf->{pagenr}]->string_width($font, $ +string . " " . $word) * $fontsize > $width) { $string = ''; $height += $lineheight; } } return $height; } sub GetWidth { #--------------------------------------------------------------- # Utility sub to get the width of a piece of text #--------------------------------------------------------------- my $pdf = shift; my $width = ($pdf->{width} - $pdf->{gap} * ($pdf->{cols} - 1)) / $ +pdf->{cols}; return $width; } @EXPORT = qw/ AddLine AddBreak GetHeight GetWidth ProcessText AddGenInfo AddEvent AddKey /;