Home > software > Sticker Generator

Sticker Generator

February 19th, 2011 Leave a comment Go to comments

At KAM MFF CUNI, we have about ~60 to ~70 computers scattered over the department, be them at desks of professors, older ones stocked in the basements or near-identical rack servers. Especially when older machines are shuffled around, it is difficult to track them, and the standard tiny inventory stickers keep falling off (and you have to keep looking up the number).

Therefore, we are making stickers to put on all our computers with some details about them. I used that as a pretense for learning some basic Cairo and I really like the paradigm (though I wish text manipulation was be easier). In case anyone would find this ever useful (or just a good scaffolding for their own Cairo Perl script), the script goes here; the default sticker size is to have height of a 5.25″ drive bay and width so that two rows fit nicely on A4.

# (c) Petr Baudis  2011  MIT licence
# Generate PDF with stickers.
# Expects tab-delimited columns on stdin:
# hostname mac invnumber buydate
use strict;
use warnings;
# -- User configuration --
our @paper = (598, 842); # A4, 72dpi
our @margin = (72, 72);
our @sticker = (227, 116);
our $filename = 'nalepky.pdf';
our $fontface = 'Arial';
our $ffontface = 'Courier New';
# large, normal, small
our @fontsize = (26, 15, 10);
our @linespacing = (18, 4, 18);
our $topmargin = 2;
our $contact = '<contact information>';
# -- User configuration end --
use lib 'perl';
use List::Util qw(min);
use List::MoreUtils qw(pairwise);
use Cairo;
our $surface = Cairo::PdfSurface->create ($filename, @paper);
# Effective surface area
our @surfsize = pairwise { $a - $b * 2 } @paper, @margin;
# Grid layout on effective surface
our @grid = pairwise { int($a / $b) } @surfsize, @sticker;
# Grid surface area
our @gridsurfsize = pairwise { $a * $b } @grid, @sticker;
# Start of grid surface so that it is centered on the paper
our @gridsurfstart = pairwise { ($a - $b) / 2 } @paper, @gridsurfsize;
# Produce a context for single sticker, starting at coordinates [0,0]
sub nalepka_cr {
        my ($surface, $cell) = @_;
        my @startM = pairwise { $a * $b } @sticker, @$cell;
        my @start = pairwise { $a + $b } @gridsurfstart, @startM;
        my $cr = Cairo::Context->create($surface);
        $cr->set_source_rgb(0, 0, 0);
# Centered text with top border at $$y. $size is index in font config above.
sub nalepka_text {
        my ($cr, $y, $face, $slant, $weight, $size, $text) = @_;
        $$y += $linespacing[$size] / 2;
        $cr->select_font_face($face, $slant, $weight);
        my $textents = $cr->text_extents($text);
        my $fextents = $cr->font_extents();
        $$y += $fextents->{height};
        $cr->move_to(($sticker[0] - $textents->{width}) / 2, $$y);
        $$y += $linespacing[$size] / 2;
sub nalepka {
        my ($cr, $host, $mac, $inv, $since) = @_;
        $cr->rectangle(0, 0, @sticker);
        my $invs = $since ? "$inv      $since" : $inv;
        my $ypos = $topmargin - $linespacing[0] / 2;
        nalepka_text($cr, \$ypos, $fontface, 'normal', 'bold', 0, $host);
        nalepka_text($cr, \$ypos, $ffontface, 'normal', 'normal', 1, $mac);
        nalepka_text($cr, \$ypos, $fontface, 'normal', 'normal', 1, $invs);
        nalepka_text($cr, \$ypos, $fontface, 'italic', 'normal', 2, $contact);
my @table;
while (<>) {
 my @col = split(/\t/);
 push @table, \@col;
my ($x, $y) = (0, 0);
for my $c (@table) {
        nalepka(nalepka_cr($surface, [$x, $y]), @$c);
        if ($y >= $grid[1]) {
                $y = 0; $x++;
                if ($x >= $grid[0]) {
                        my $cr = Cairo::Context->create($surface);
                        ($x, $y) = (0, 0);
Categories: software Tags: , ,
  1. Federico (F2) Lucifredi
    February 21st, 2011 at 05:26 | #1

    It is a nice intro to Cairo, you sucked me in :)

    by the way, you have an extra line:
    use KAM::Machines;

    I guess you edited an existing file to start.

    Thanks for sharing -F2

  2. F2
    February 21st, 2011 at 19:57 | #2

    Here is a question – why did you not use PDF::Labels or PostScript::MailLabels? looks like the latter is simpler layout-wise but does not allow to set font sizes, the former however I found no issues with scanning the docs.

    Just curious if you ran into some limitation…if you just wanted to learn Perl+Cairo, that’s a fine answer too :)

  3. pasky
    February 21st, 2011 at 20:13 | #3

    Good catch – the original script does not use stdin for input, but the database of machines accessed through KAM::Machines. I removed the useless use now.

    Admittedly, I have done no research in existing CPAN modules. My original idea has been to use latex, but failing to find a trivial way to do it (I did not get the labels class to work at all, somehow), a friend suggested Cairo so I went straight for that. :-)

    But looking at the modules, even PDF::Labels does not allow any kind of rich formatting – I’m not even sure if it can center text! To me it seems that making the hostname big and bold and the MAC fixed-width wouldn’t be possible with these modules.

  1. No trackbacks yet.

4 + = nine