001 #!/usr/bin/perl
002 ###########################################
003 # envelope - Print paper envelopes
004 # Mike Schilli, 2003 (m@perlmeister.com)
005 ###########################################
006 use warnings;
007 use strict;
008
009 use PostScript::File;
010 use PostScript::TextBlock;
011 use File::Temp qw(tempfile);
012
013 my $ADDR_CSV  = "mailaddr.csv";
014 my $SENDER    = q{Steven Sender,
015 9 Sender Street,
016 San Francisco, CA 94107};
017 my $PRINT_CMD = "lpr";
018
019 open FILE, $ADDR_CSV or
020     die "Cannot open $ADDR_CSV";
021
022 while(<FILE>) {
023   next if /^\s*#/;
024   my @addr = split /,/, $_;
025   @addr = map { s/"//g; $_; } @addr;
026
027   my $ps = PostScript::File->new(
028     landscape   => 1,
029     reencode    => 'ISOLatin1Encoding',
030     paper       => "Envelope-DL",
031   );
032
033   my ($tmp_fh, $tmp_file) =
034                  tempfile(SUFFIX => ".ps");
035
036   my($last, $first, $city, $str) = @addr;
037
038     # Sender
039   my($bw, $bh, $b) = textbox($SENDER,
040                   "Helvetica-iso", 10, 12);
041   my ($code) = $b->Write($bw, $bh, cm(2),
042                  $ps->get_width() - cm(2));
043   $ps->add_to_page($code);
044
045     # Recipient
046   my $to = "$first $last\n$str\n\n$city\n";
047   ($bw, $bh, $b) = textbox($to,
048                   "Helvetica-iso", 18, 20);
049   ($code) = $b->Write($bw, $bh,
050            $ps->get_height() - $bw - cm(2),
051            $bh + cm(2));
052   $ps->add_to_page($code);
053
054     # Print to temporary file
055   (my $base = $tmp_file) =~ s/\.ps$//;
056   $ps->output($base);
057
058     # Send to printer
059   system("$PRINT_CMD $tmp_file") and
060       die "$PRINT_CMD $tmp_file: $!";
061
062     # Delete
063   unlink "$tmp_file" or
064       die "Cannot unlink $tmp_file: $!";
065 }
066
067 ###########################################
068 sub textbox {
069 ###########################################
070     my($text, $font, $size, $leading) = @_;
071
072     my $b = PostScript::TextBlock->new();
073
074     $b->addText(
075         font    => $font,
076         text    => $text,
077         size    => $size,
078         leading => $leading);
079
080     return(tb_width($text, $font, $size),
081            tb_height($text, $leading),
082            $b);
083 }
084
085 ###########################################
086 sub cm {
087 ###########################################
088     return int($_[0]*72/2.54);
089 }
090
091 ###########################################
092 sub tb_width {
093 ###########################################
094     my($text, $font, $size) = @_;
095
096     $font =~ s/-iso//;
097
098     my $max_width = 0;
099
100     for(split /\n/, $text) {
101         s/[äÄöÖüÜß]/A/ig;
102         my $w =
103           PostScript::Metrics::stringwidth(
104                          $_, $font, $size);
105         $max_width = $w if $w > $max_width;
106     }
107
108     return $max_width;
109 }
110
111 ###########################################
112 sub tb_height {
113 ###########################################
114     my($text, $leading) = @_;
115
116     my $lines = 1;
117     $lines++ for $text =~ /\n/g;
118
119     return $lines*$leading;
120 }