Perl Mojo::DOM to find and replace html blocks - html

Since everyone here advised on using the Perl module Mojo::DOM for this task, I am asking how to do it with it.
I have this html code in template:
some html content here top base
<!--block:first-->
some html content here 1 top
<!--block:second-->
some html content here 2 top
<!--block:third-->
some html content here 3a
some html content here 3b
<!--endblock-->
some html content here 2 bottom
<!--endblock-->
some html content here 1 bottom
<!--endblock-->
some html content here bottom base
What I want to do (please do not suggest using Templates modules again), I want to find the inner block first:
<!--block:third-->
some html content here 3a
some html content here 3b
<!--endblock-->
then replace it with some html code, then find the second block:
<!--block:second-->
some html content here 2 top
<!--block:third-->
some html content here 3a
some html content here 3b
<!--endblock-->
some html content here 2 bottom
<!--endblock-->
then replace it with some html code, then find the third block:
<!--block:first-->
some html content here 1 top
<!--block:second-->
some html content here 2 top
<!--block:third-->
some html content here 3a
some html content here 3b
<!--endblock-->
some html content here 2 bottom
<!--endblock-->
some html content here 1 bottom
<!--endblock-->

I did not advise using Mojo::DOM for this task, as it's probably overkill, but ... you could.
The real answer is the one that I've already stated in other questions, and that is to use an already existing framework such as Template::Toolkit. It's powerful, well tested, and speedy since it allows for the caching of templates.
However, you desire to roll your own templating solution. Any such solution should include a parsing, validation, and execution phase. We're just going to be focusing on the first two steps as you've shared no real info on the last.
There is not going to be any real magic in Mojo::DOM. Its benefit and power is that it can fully and easily parse HTML, catching all of those potential edge cases. It will only be able to help with the parsing phase of templating though as it's your own rules that decide the validation. In fact, it basically just performs like a drop in replacement for split in my earlier solution I provided to you. That's why it's probably too heavy weight of a solution.
Because it's not hard to make the modifications, I've went ahead coded a full solution below. However, to make things more interesting, and to try to prove one of my greater points, it's time to share some Benchmark testing between the 3 available solutions:
Mojo::DOM for parsing as demonstrated below.
split for parsing as proposed by me in Match nested html comment blocks regex
recursive regex proposed by sln in Perl replace nested blocks regex
The below contains all three solutions:
use strict;
use warnings;
use Benchmark qw(:all);
use Mojo::DOM;
use Data::Dump qw(dump dd);
my $content = do {local $/; <DATA>};
#dd parse_using_mojo($content);
#dd parse_using_split($content);
#dd parse_using_regex($content);
timethese(100_000, {
'regex' => sub { parse_using_regex($content) },
'mojo' => sub { parse_using_mojo($content) },
'split' => sub { parse_using_split($content) },
});
sub parse_using_mojo {
my $content = shift;
my $dom = Mojo::DOM->new($content);
# Resulting Data Structure
my #data = ();
# Keep track of levels of content
# - This is a throwaway data structure to facilitate the building of nested content
my #levels = ( \#data );
for my $html ($dom->all_contents->each) {
if ($html->node eq 'comment') {
# Start of Block - Go up to new level
if ($html =~ m{^<!--\s*block:(.*)-->$}s) {
#print +(' ' x #levels) ."<$1>\n"; # For debugging
my $hash = {
block => $1,
content => [],
};
push #{$levels[-1]}, $hash;
push #levels, $hash->{content};
next;
# End of Block - Go down level
} elsif ($html =~ m{^<!--\s*endblock\s*-->$}) {
die "Error: Unmatched endblock found before " . dump($html) if #levels == 1;
pop #levels;
#print +(' ' x #levels) . "</$levels[-1][-1]{block}>\n"; # For debugging
next;
}
}
push #{$levels[-1]}, '' if !#{$levels[-1]} || ref $levels[-1][-1];
$levels[-1][-1] .= $html;
}
die "Error: Unmatched start block: $levels[-2][-1]{block}" if #levels > 1;
return \#data;
}
sub parse_using_split {
my $content = shift;
# Tokenize Content
my #tokens = split m{<!--\s*(?:block:(.*?)|(endblock))\s*-->}s, $content;
# Resulting Data Structure
my #data = (
shift #tokens, # First element of split is always HTML
);
# Keep track of levels of content
# - This is a throwaway data structure to facilitate the building of nested content
my #levels = ( \#data );
while (#tokens) {
# Tokens come in groups of 3. Two capture groups in split delimiter, followed by html.
my ($block, $endblock, $html) = splice #tokens, 0, 3;
# Start of Block - Go up to new level
if (defined $block) {
#print +(' ' x #levels) ."<$block>\n"; # For Debugging
my $hash = {
block => $block,
content => [],
};
push #{$levels[-1]}, $hash;
push #levels, $hash->{content};
# End of Block - Go down level
} elsif (defined $endblock) {
die "Error: Unmatched endblock found before " . dump($html) if #levels == 1;
pop #levels;
#print +(' ' x #levels) . "</$levels[-1][-1]{block}>\n"; # For Debugging
}
# Append HTML content
push #{$levels[-1]}, $html;
}
die "Error: Unmatched start block: $levels[-2][-1]{block}" if #levels > 1;
return \#data;
}
sub parse_using_regex {
my $content = shift;
my $href = {};
ParseCore( $href, $content );
return $href;
}
sub ParseCore
{
my ($aref, $core) = #_;
# Set the error mode on/off here ..
my $BailOnError = 1;
my $IsError = 0;
my ($k, $v);
while ( $core =~ /(?is)(?:((?&content))|(?><!--block:(.*?)-->)((?&core)|)<!--endblock-->|(<!--(?:block:.*?|endblock)-->))(?(DEFINE)(?<core>(?>(?&content)|(?><!--block:.*?-->)(?:(?&core)|)<!--endblock-->)+)(?<content>(?>(?!<!--(?:block:.*?|endblock)-->).)+))/g )
{
if (defined $1)
{
# CONTENT
$aref->{content} .= $1;
}
elsif (defined $2)
{
# CORE
$k = $2; $v = $3;
$aref->{$k} = {};
# $aref->{$k}->{content} = $v;
# $aref->{$k}->{match} = $&;
my $curraref = $aref->{$k};
my $ret = ParseCore($aref->{$k}, $v);
if ( $BailOnError && $IsError ) {
last;
}
if (defined $ret) {
$curraref->{'#next'} = $ret;
}
}
else
{
# ERRORS
print "Unbalanced '$4' at position = ", $-[0];
$IsError = 1;
# Decide to continue here ..
# If BailOnError is set, just unwind recursion.
# -------------------------------------------------
if ( $BailOnError ) {
last;
}
}
}
return $k;
}
__DATA__
some html content here top base
<!--block:first-->
<table border="1" style="color:red;">
<tr class="lines">
<td align="left" valign="<--valign-->">
<b>bold</b>mewsoft
<!--hello--> <--again--><!--world-->
some html content here 1 top
<!--block:second-->
some html content here 2 top
<!--block:third-->
some html content here 3 top
<!--block:fourth-->
some html content here 4 top
<!--block:fifth-->
some html content here 5a
some html content here 5b
<!--endblock-->
<!--endblock-->
some html content here 3a
some html content here 3b
<!--endblock-->
some html content here 2 bottom
<!--endblock-->
some html content here 1 bottom
<!--endblock-->
some html content here1-5 bottom base
some html content here 6-8 top base
<!--block:six-->
some html content here 6 top
<!--block:seven-->
some html content here 7 top
<!--block:eight-->
some html content here 8a
some html content here 8b
<!--endblock-->
some html content here 7 bottom
<!--endblock-->
some html content here 6 bottom
<!--endblock-->
some html content here 6-8 bottom base
The results for the simple template with 3 nested blocks:
Benchmark: timing 100000 iterations of mojo, regex, split...
mojo: 50 wallclock secs (50.36 usr + 0.00 sys = 50.36 CPU) # 1985.78/s (n=100000)
regex: 14 wallclock secs (13.42 usr + 0.00 sys = 13.42 CPU) # 7453.79/s (n=100000)
split: 2 wallclock secs ( 2.70 usr + 0.00 sys = 2.70 CPU) # 37050.76/s (n=100000)
Normalizing to regex at 100%, equates to mojo at 375%, and split at 20%.
And for the more complicated template included in the above code:
Benchmark: timing 100000 iterations of mojo, regex, split...
mojo: 237 wallclock secs (236.61 usr + 0.02 sys = 236.62 CPU) # 422.61/s (n=100000)
regex: 46 wallclock secs (47.25 usr + 0.00 sys = 47.25 CPU) # 2116.31/s (n=100000)
split: 7 wallclock secs ( 6.65 usr + 0.00 sys = 6.65 CPU) # 15046.64/s (n=100000)
Normalizing to regex at 100%, equates to mojo at 501%, and split at 14%. (7 times as fast)
Does speed matter?
As is demonstrated above, we can see without question that my split solution is going to be faster than any of the other solutions thus far. This should not be a surprise. It's an extremely simple tool and therefore it's fast.
In truth though, speed doesn't really matter.
Why not? Well, because whatever data structure you build from parsing and validating the template can be cached and reloaded each time you want to execute a template, until a template changes.
Final decisions
Because speed doesn't matter with caching, what you should focus on instead is how readable is the code, how fragile is it, how easily can it be extended and debugged, etc.
As much as I appreciate a well crafted regex, they tend to be fragile. Putting all of your parsing and validation logic into a single line of code is just asking for trouble.
That leaves either the split solution or mojo.
If you're caching like I described, you can actually choose either one without concern. The code I provided for each is essentially the same with slight variations, so it gets to be personal preference. Even though split is 20-35 times faster for the initial parsing matters less than if the code is more maintainable using an actual HTML Parser.
Good luck choosing your final approach. I still have my fingers crossed you'll go with TT some day, but you'll pick your own poison :)

Related

Cannot prettify html code with sublime text nor beautiful soup

I am trying to webscrape some website for information. i have saved the page I want to scrape as .html file and have opened it with sublime text but there are some parts that cannot be displayed in a prettified way ; I have the same problem when trying to use beautifulsoup ; see picture below (I cannot really share full code since it's disclosing private info).
Just feed the HTML as a multiline string to BeautifulSoup object and use soup.prettify(). That should work. However beautifulsoup has default indentation to 2 spaces. So if you want custom indent you can writeup a little wrapper like this:
def indentPrettify(soup, indent=4):
# where desired_indent is number of spaces as an int()
pretty_soup = str()
previous_indent = 0
# iterate over each line of a prettified soup
for line in soup.prettify().split("\n"):
# returns the index for the opening html tag '<'
current_indent = str(line).find("<")
# which is also represents the number of spaces in the lines indentation
if current_indent == -1 or current_indent > previous_indent + 2:
current_indent = previous_indent + 1
# str.find() will equal -1 when no '<' is found. This means the line is some kind
# of text or script instead of an HTML element and should be treated as a child
# of the previous line. also, current_indent should never be more than previous + 1.
previous_indent = current_indent
pretty_soup += writeOut(line, current_indent, indent)
return pretty_soup
def writeOut(line, current_indent, desired_indent):
new_line = ""
spaces_to_add = (current_indent * desired_indent) - current_indent
if spaces_to_add > 0:
for i in range(spaces_to_add):
new_line += " "
new_line += str(line) + "\n"
return new_line

HTML Parsing using HTML::Tree in Perl

I'm trying to scrape a webpage and get the values that are inside the html tags. The end result would be a way to separate values in a way that looks like
Club: x Location: y URL: z
Here's what I have so far
use HTML::Tree;
use LWP::Simple;
$url = "http://home.gotsoccer.com/clubs.aspx?&clubname=&clubstate=AL&clubcity=";
$content = get($url);
$tree = HTML::Tree->new();
$tree->parse($content);
#td = $tree->look_down( _tag => 'td', class => 'ClubRow');
foreach $1 (#td) {
print $1->as_text();
print "\n";
}
And what is printed is like
AYSO UnitedMadison, ALwww.aysounitednorthalabama.org
This is what the HTML looks like
<td class="ClubRow" width="80%">
<div>
AYSO United</div>
<div class="SubHeading">Madison, AL</div>
<img src="/images/icons/ArrowRightSm.png" class="LinkIcon"><font color="black">www.aysounitednorthalabama.org</font>
</td>
I need a way to either split these fields into separate variables or add some sort of deliminating character so I can do it with Regex. There isn't much documentation online so any help would be appreciative.
First, this is an abomination:
foreach $1 (#td) {
print $1->as_text();
print "\n";
}
You might think it is cute, but it is confusing to use regex capture variables such as $1 as a loop variable especially since you also say "I need a way... so I can do it with Regex." (emphasis mine)
This is the kind of nonsense that leads to unmaintainable programs which give Perl a bad name.
Always use strict and warnings and use a plain variable for your loops.
Second, you are interested in three specific elements in each td: 1) The text of a[class="ClubLink"]; 2) The text of div[class="SubHeading"]; and 3) The text of font[color="black"].
So, just extract those three bits of information instead of flattening the text inside a td:
#!/usr/bin/env perl
use strict;
use warnings;
use HTML::Tree;
my $html = <<HTML;
<td class="ClubRow" width="80%"> <div> AYSO United</div>
<div class="SubHeading">Madison, AL</div> <a
href="http://www.aysounitednorthalabama.org" target="_blank"><img
src="/images/icons/ArrowRightSm.png" class="LinkIcon"><font
color="black">www.aysounitednorthalabama.org</font></a> </td>
HTML
my $tree = HTML::Tree->new_from_content( $html );
my #wanted = (
[class => 'ClubLink'],
[class => 'SubHeading'],
[_tag => 'font', color => 'black'],
);
my #td = $tree->look_down( _tag => 'td', class => 'ClubRow');
for my $td ( #td ) {
my ($club, $loc, $www) = map $td->look_down(#$_)->as_text, #wanted;
print join(' - ', $club, $loc, $www), "\n";
}
Output:
$ ./gg.pl
AYSO United - Madison, AL - www.aysounitednorthalabama.org
Of course, I would have probably used HTML::TreeBuilder::XPath to take advantage of XPath queries.
Here's a Mojolicious example. It's the same thing that Sinan did but with a different toolbox which has the tools to fetch and process the webpage. It looks a bit long, but that's just the comments and documentation. ;)
I like that Mojolicious is "batteries included", so once I load one of the modules, I probably have everything else I need for the task:
use v5.10;
use Mojo::UserAgent;
my $url = "http://home.gotsoccer.com/clubs.aspx?&clubname=&clubstate=AL&clubcity=";
my $ua = Mojo::UserAgent->new;
my $tx = $ua->get( $url );
# You could do some error checking here in case the fetch fails
$tx->res->dom
# there are lots of ClubRow td cells, but we want the one with
# the width attribute. Find all of those. See Mojo::DOM::CSS for
# docs on CSS selectors.
->find( 'td[class=ClubRow][width=80%]' )
# now go through each td and extract several things
->map( sub {
# these selectors represent the club location, name, and website
state $find = [ qw(
a[class=ClubLink]
div[class=SubHeading]
font[color=black]
) ];
my $chunk = $_;
# return the location, name, and link as a tuple for later
# processing
[
map { s/\t+/ /gr } # remove tabs so we can use them as a separator
map { $chunk->find( $_ )->map( 'text' )->[0] }
#$find
]
} )
# do something will all tuples. In this case, output them as tab
# separated values (which is why you removed tabs already). You
# should be able to easily import this into a spreadsheet application.
->each( sub { say join "\t", #$_ } );
The output has that annoying first line, but you can fix that up on your own:
*****Other Club*****
Alabama Soccer Association www.alsoccer.org
Alabaster Competitive SC acsc.teampages.com/
Alabaster Parks and Rec
Alex City YSL www.alexcitysoccer.com/
Auburn Thunder SC auburnthundersoccer.com/
AYSO United Madison, AL www.aysounitednorthalabama.org
Birmingham Area Adult Soccer League
Birmingham Bundesliga LLC Birmingham, AL www.birmingham7v7.com
Birmingham Premier League
Birmingham United SA Birmingham, AL, AL www.birminghamunited.com/
Blount County Youth Soccer Oneonta, AL bcysfury.com
Briarwood SC Birmingham, AL www.questrecreation.org/briarwood-soccer-club.html...
Capital City Streaks Montgomery, AL www.capitalcitystreaks.org
City of Calera Youth Soccer

Highlight a matched pattern in a DNA sequence with HTML markup using Perl

I am working on generating an HTML page using a CGI script in Perl.
I need filter some sequences in order to check whether they contain a specific pattern; if they contain it I need to print those sequences on my page with 50 bases per line, and highlight the pattern in the sequences. My sequences are in an hash called %hash; the keys are the names, the values are the actual sequences.
my %hash2;
foreach my $key (keys %hash) {
if ($hash{$key} =~ s!(aaagg)!<b>$1</b>!) {
$hash2{$key} = $hash{$key}
}
}
foreach my $key (keys %hash2) {
print "<p> <b> $key </b> </p>";
print "<p>$_</p>\n" for unpack '(A50)*', $hash2{$key};
}
This method "does" the job however if I highlight the pattern "aaagg" using this method I am messing up the unpacking of the line (for unpack '(A50)*'); because now the sequences contains the extra characters of the bold tags which are included in the unpacking count. This beside making the lines of different length it is also a big problem if the tag falls between 2 lines due to unpacking 50 characters, it basically remains open and everything after that is bold.
The script below uses a single randomly generated DNA sequence of length 243 (generated using http://www.bioinformatics.org/sms2/random_dna.html) and a variable length pattern.
It works by first recording the positions which need to be highlighted instead of changing the sequence string. The highlighting is inserted after the sequence is split into chunks of 50 bases.
The highlighting is done in reverse order to minimize bookkeeping busy work.
#!/usr/bin/env perl
use utf8;
use strict;
use warnings;
use YAML::XS;
my $PRETTY_WIDTH = 50;
# I am using bold-italic so the highlighting
# is visible on Stackoverflow, but in real
# life, this would be something like:
# my #PRETTY_MARKUP = ('<span class="highlighted-match">', '</span>');
my #PRETTY_MARKUP = ('<b><i>', '</i></b>');
use constant { BAŞ => 0, SON => 1, ROW => 0, COL => 1 };
my $sequence = q{ccggtgagacatccagttagttcactgagccgacttgcatcagtcatgcttttccccgtaatgagggccccatattcaggccgtcgtccggaattgtcttggatccggaatgcagcttttctcaccgcttgatgaacattcactgaatatctgacgccgcgaaaacagggtcactagcctgtttccggtcgcccgagaccggcgagtttgtggtatcgcgagcgcccccgggcggtagggtct};
my $wanted = 'c..?gg';
my #pos;
while ($sequence =~ /($wanted)/g) {
push #pos, [ pos($sequence) - length($1), pos($sequence) ];
}
print Dump \#pos;
my #output = unpack "(A$PRETTY_WIDTH)*", $sequence;
print Dump \#output;
while (my $pos = pop #pos) {
my #rc = map pos_to_rc($_, $PRETTY_WIDTH), #$pos;
substr($output[ $rc[$_][ROW] ], $rc[$_][COL], 0, $PRETTY_MARKUP[$_]) for SON, BAŞ;
}
print Dump \#output;
sub pos_to_rc {
my $r = int( $_[0] / $_[1] );
my $c = $_[0] - $r * $_[1];
[ $r, $c ];
}
Output:
C:\...\Temp> perl s.pl
---
- - 0
- 4
- - 76
- 80
- - 87
- 91
- - 97
- 102
- - 104
- 108
- - 165
- 170
- - 184
- 188
- - 198
- 202
- - 226
- 231
---
- ccggtgagacatccagttagttcactgagccgacttgcatcagtcatgct
- tttccccgtaatgagggccccatattcaggccgtcgtccggaattgtctt
- ggatccggaatgcagcttttctcaccgcttgatgaacattcactgaatat
- ctgacgccgcgaaaacagggtcactagcctgtttccggtcgcccgagacc
- ggcgagtttgtggtatcgcgagcgcccccgggcggtagggtct
---
- ccggtgagacatccagttagttcactgagccgacttgcatcagtcatgct
- tttccccgtaatgagggccccatattcaggccgtcgtccggaattgtctt
- ggatccggaatgcagcttttctcaccgcttgatgaacattcactgaatat
- ctgacgccgcgaaaacagggtcactagcctgtttccggtcgcccgagacc
- ggcgagtttgtggtatcgcgagcgcccccgggcggtagggtct
Especially since this turns out to have been a homework assignment, it is now up to you to take this and apply it to all sequences in your hash table.

How to parse all the text content from the HTML using Beautiful Soup

I wanted to extract an email message content. It is in html content, used the BeautifulSoup to fetch the From, To and subject. On fetching the body content, it fetches the first line alone. It leaves the remaining lines and paragraph.
I miss something over here, how to read all the lines/paragraphs.
CODE:
email_message = mail.getEmail(unreadId)
print (email_message['From'])
print (email_message['Subject'])
if email_message.is_multipart():
for payload in email_message.get_payload():
bodytext = email_message.get_payload()[0].get_payload()
if type(bodytext) is list:
bodytext = ','.join(str(v) for v in bodytext)
else:
bodytext = email_message.get_payload()[0].get_payload()
if type(bodytext) is list:
bodytext = ','.join(str(v) for v in bodytext)
print (bodytext)
parsedContent = BeautifulSoup(bodytext)
body = parsedContent.findAll('p').getText()
print body
Console:
body = parsedContent.findAll('p').getText()
AttributeError: 'list' object has no attribute 'getText'
When I use
body = parsedContent.find('p').getText()
It fetches the first line of the content and it is not printing the remaining lines.
Added
After getting all the lines from the html tag, I get = symbol at the end of each line and also &nbsp ; , &lt is displayed.How to overcome those.
Extracted text:
Dear first,All of us at GenWatt are glad to have xyz as a
customer. I would like to introduce myself as your Account
Manager. Should you = have any questions, please feel free to
call me at or email me at ash= wis#xyz.com. You
can also contact GenWatt on the following numbers: Main:
810-543-1100Sales: 810-545-1222Customer Service & Support:
810-542-1233Fax: 810-545-1001I am confident GenWatt will serve you
well and hope to see our relationship=
Let's inspect the result of soup.findAll('p')
python -i test.py
----------
import requests
from bs4 import BeautifulSoup
bodytext = requests.get("https://en.wikipedia.org/wiki/Earth").text
parsedContent = BeautifulSoup(bodytext, 'html.parser')
paragraphs = soup.findAll('p')
----------
>> type(paragraphs)
<class 'bs4.element.ResultSet'>
>> issubclass(type(paragraphs), list)
True # It's a list
Can you see? It's a list of all paragraphs. If you want to access their content you will need iterate over the list or access an element by an index, like a normal list.
>> # You can print all content with a for-loop
>> for p in paragraphs:
>> print p.getText()
Earth (otherwise known as the world (...)
According to radiometric dating and other sources of evidence (...)
...
>> # Or you can join all content
>> content = []
>> for p in paragraphs:
>> content.append(p.getText())
>>
>> all_content = "\n".join(content)
>>
>> print(all_content)
Earth (otherwise known as the world (...) According to radiometric dating and other sources of evidence (...)
Using List Comprehension your code will looks like:
parsedContent = BeautifulSoup(bodytext)
body = '\n'.join([p.getText() for p in parsedContent.findAll('p')]
When I use
body = parsedContent.find('p').getText()
It fetches the first line of the content and it is not printing the
remaining lines.
Do parsedContent.find('p') is exactly the same that do parsedContent.findAll('p')[0]
>> parsedContent.findAll('p')[0].getText() == parsedContent.find('p').getText()
True

perl: Creating PDF Avery lables on linux?

Which would a the best and most flexible process for creating formatted PDF's of Avery labels on a linux machine with perl?
The labels need to include images and will have formatting similar to spanned rows and columns in an html table. And example would be several rows of text on the left hand side and an image on the right hand side that spans the text.
These are my thoughts but if you have additional ideas please let me know.
perl to PDF with PDF::API2
perl to PS with ??? -> PS to PDF with ???
perl to HTML w/ CSS formatting -> HTML to PDF with wkhtmltopdf
Has anybody done this and have any pointers, examples or links that may be of assistance?
Thank You,
~Donavon
They are all viable options.
I found wkhtmltopdf to be too resource intensive and slow. If you do want to go down that route there are existing html templates already which can be found by a quick google search.
PDF::API2 performs very well, and I run it on a server system with no problems. Here's an example script I use for laying out elements in a grid format;
#!/usr/bin/env perl
use strict 'vars';
use FindBin;
use PDF::API2;
# Min usage, expects bank.pdf to exist in same location
render_grid_pdf(
labels => ['One', 'Two', 'Three', 'Four'],
cell_width => 200,
cell_height => 50,
no_of_columns => 2,
no_of_rows => 2,
);
# Advanced usage
render_grid_pdf(
labels => ['One', 'Two', 'Three', 'Four'],
cell_width => 200,
cell_height => 50,
no_of_columns => 2,
no_of_rows => 2,
font_name => "Helvetica-Bold",
font_size => 12,
template => "blank.pdf",
save_as => "my_labels.pdf",
# Manually set coordinates to start prinding
page_offset_x => 20, # Acts as a left margin
page_offset_y => 600,
);
sub render_grid_pdf {
my %args = #_;
# Print data
my $labels = $args{labels} || die "Labels required";
# Template, outfile and labels
my $template = $args{template} || "$FindBin::Bin/blank.pdf";
my $save_as = $args{save_as} || "$FindBin::Bin/out.pdf";
# Layout Properties
my $no_of_columns = $args{no_of_columns} || die "Number of columns required";
my $no_of_rows = $args{no_of_rows} || die "Number of rows required";
my $cell_width = $args{cell_width} || die "Cell width required";
my $cell_height = $args{cell_height} || die "Cell height required";
my $font_name = $args{font_name} || "Helvetica-Bold";
my $font_size = $args{font_size} || 12;
# Note: PDF::API2 uses cartesion coordinates, 0,0 being
# bottom. left. These offsets are used to set the print
# reference to top-left to make things easier to manage
my $page_offset_x = $args{page_offset_x} || 0;
my $page_offset_y = $args{page_offset_y} || $no_of_rows * $cell_height;
# Open an existing PDF file as a templata
my $pdf = PDF::API2->open("$template");
# Add a built-in font to the PDF
my $font = $pdf->corefont($font_name);
my $page = $pdf->openpage(1);
# Add some text to the page
my $text = $page->text();
$text->font($font, $font_size);
# Print out labels
my $current_label = 0;
OUTERLOOP: for (my $row = 0; $row < $no_of_columns; $row++) {
for (my $column = 0; $column < $no_of_columns; $column++) {
# Calculate label x, y positions
my $label_y = $page_offset_y - $row * $cell_height;
my $label_x = $page_offset_x + $column * $cell_width;
# Print label
$text->translate( $label_x, $label_y );
$text->text( $labels->[$current_label]);
# Increment labels index
$current_label++;
# Exit condition
if ( $current_label > scalar #{$labels}) {
last OUTERLOOP;
}
}
}
# Save the PDF
$pdf->saveas($save_as);
}
Great you have found an answer you like.
Another option, which may or may not have suited you, would be to prepare the sheet that will be printed as labels as an open/libreoffice document, with pictures, layout, non-variant text ... (and can do all your testing runs through open/libreoffice).
Then:
use OpenOffice::OODoc;
then: read you data from a database
then:
my $document = odfDocument( file => "$outputFilename",
create => "text",
template_path => $myTemplateDir );
then:
for (my $r = 0; $r < $NumOfTableRows; $r++ ) {
for (my $c = 0; $c < $NumOfTableCols; $c++) {
:
$document->cellValue($theTableName, $r, $c, $someText);
# test: was written properly ?
my $writtenTest = $document->cellValue($theTableName, $r, $c);
chomp $writtenTest;
if ($someText ne $writtenTest) {
:
}
}
}
then:
$document->save($outputFilename );
# save (convert to) a pdf
# -f format;
# -n no start new listener; use existing
# -T timeout to connect to its *OWN* listener (only);
# -e exportFilterOptions
`unoconv -f pdf -n -T 60 -e PageRange=1-2 $outputFilename `;
# I remove the open/libreoffice doc, else clutter and confusion
`rm $outputFilename `;
As a quick overview of the practical issues:
name the layout tables
place your nice, correct open/libreoffice doc in "/usr/local/lib/site_perl/myNewTemplateDir/" say. You will need this (I think that this is the default, but I pass it anyway as $myTemplateDir
gotcha: the modules routines to wait for Open/Libreoffice to start (for the unoconv converter to start) do NOT work - unoconv will still not work after they say it will. I create dummy pdfs until one actually works - exists and has a non-zero size.