#!/usr/bin/perl ########################################### # envelope - Print paper envelopes # Mike Schilli, 2003 (m@perlmeister.com) # support for file output, configurable margins, setpagedevice and EPS logo by: # Alexander Becher, 2003 (abecher@kawo2.rwth-aachen.de) ########################################### use warnings; use strict; use PostScript::File; use PostScript::TextBlock; use Fcntl; use File::Basename qw(dirname); use File::Spec::Functions; my $ADDR_CSV = "mailaddr.csv"; my $SENDER = q{Ansel Absender Amselweg 9 D-78333 Ansbach}; my $LOGO_EPS = "logo.eps"; # Left, Upper, Right and Bottom margins my %MARGINS = (L => cm(2.2), # CAUTION: HP Deskjet 690C needs >= 2.1 cm U => cm(1), R => cm(2), B => cm(2)); @ARGV and $ADDR_CSV = shift; open FILE, $ADDR_CSV or die "Cannot open $ADDR_CSV"; my $dirname = dirname ($ADDR_CSV); my $logo_code = eval { cat ($LOGO_EPS) }; while() { next if /^\s*#/; chomp; my @addr = split /,/, $_; @addr = map { s/"//g; $_; } @addr; my $ps = PostScript::File->new( landscape => 1, reencode => 'ISOLatin1Encoding', #paper => "Envelope-DL", # ''Envelope-C6'' width => cm(11.4), height => cm(16.2), dir => $dirname, ); my $width = $ps->get_width (); my $height = $ps->get_height (); $ps->add_setup ("<< /PageSize [$width $height] >> setpagedevice"); my($last, $first, $city, $str) = @addr; # Sender my($bw, $bh, $b) = textbox($SENDER, "Helvetica-iso", 10, 12); my ($code) = $b->Write($bw, $bh, $MARGINS{L}, $ps->get_width() - $MARGINS{U}); $ps->add_to_page($code); # Recipient my $to = "$first $last\n$str\n\n$city"; ($bw, $bh, $b) = textbox($to, "Helvetica-iso", 18, 20); ($code) = $b->Write($bw, $bh, $ps->get_height() - $bw - $MARGINS{R}, $bh + $MARGINS{B}); $ps->add_to_page($code); # Logo if ($logo_code) { $ps->add_to_page (<<"EOL"); /EPSsave save def $MARGINS{L} $MARGINS{B} translate /showpage { } def %%BeginDocument: $LOGO_EPS $logo_code %%EndDocument: $LOGO_EPS EPSsave restore EOL } my $output = "$._${last}_${first}"; $output =~ s/[^\wäöüÄÖÜß]/_/g; # restrict filename to safe characters my $path = catfile ($dirname, "$output.ps"); unlink ($path); sysopen (TEMP, $path, O_CREAT | O_EXCL | O_RDWR) or die "$0: $path: $!\n"; close TEMP; $ps->output ($output); } ########################################### sub cat { ########################################### my ($file) = @_; open LOGO, '<', $file or die "$0: $file: $!\n"; local $/ = undef; my $res = ; close LOGO; return $res; } ########################################### sub textbox { ########################################### my($text, $font, $size, $leading) = @_; my $b = PostScript::TextBlock->new(); $b->addText( font => $font, text => $text, size => $size, leading => $leading); return(tb_width($text, $font, $size), tb_height($text, $leading), $b); } ########################################### sub cm { ########################################### return int($_[0]*72/2.54); } ########################################### sub tb_width { ########################################### my($text, $font, $size) = @_; $font =~ s/-iso//; my $max_width = 0; for(split /\n/, $text) { s/[äÄöÖüÜß]/A/ig; my $w = PostScript::Metrics::stringwidth( $_, $font, $size); $max_width = $w if $w > $max_width; } return $max_width; } ########################################### sub tb_height { ########################################### my($text, $leading) = @_; my $lines = 1; $lines++ for $text =~ /\n/g; return $lines*$leading; }