#!/usr/bin/perl
###########################################
# envelope - Print paper envelopes
# Mike Schilli, 2003 (m@perlmeister.com)
###########################################
use warnings;
use strict;

use PostScript::File;
use PostScript::TextBlock;
use File::Temp qw(tempfile);

my $ADDR_CSV  = "mailaddr.csv";
my $SENDER    = q{Ansel Absender
Amselweg 9
D-78333 Ansbach};
my $PRINT_CMD = "lpr";

open FILE, $ADDR_CSV or  
    die "Cannot open $ADDR_CSV";
    
while(<FILE>) {
  next if /^\s*#/;
  my @addr = split /,/, $_;
  @addr = map { s/"//g; $_; } @addr;

  my $ps = PostScript::File->new(
    landscape   => 1,
    reencode    => 'ISOLatin1Encoding',
    paper       => "Envelope-DL",
  );

  my ($tmp_fh, $tmp_file) = 
                 tempfile(SUFFIX => ".ps");

  my($last, $first, $city, $str) = @addr;

    # Sender
  my($bw, $bh, $b) = textbox($SENDER, 
                  "Helvetica-iso", 10, 12);
  my ($code) = $b->Write($bw, $bh, cm(2), 
                 $ps->get_width() - cm(2));
  $ps->add_to_page($code);

    # Recipient
  my $to = "$first $last\n$str\n\n$city\n";
  ($bw, $bh, $b) = textbox($to, 
                  "Helvetica-iso", 18, 20);
  ($code) = $b->Write($bw, $bh, 
           $ps->get_height() - $bw - cm(2), 
           $bh + cm(2));
  $ps->add_to_page($code);

    # Print to temporary file
  (my $base = $tmp_file) =~ s/\.ps$//;
  $ps->output($base);

    # Send to printer
  system("$PRINT_CMD $tmp_file") and
      die "$PRINT_CMD $tmp_file: $!";

    # Delete
  unlink "$tmp_file" or
      die "Cannot unlink $tmp_file: $!";
}

###########################################
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;
}