File Coverage

blib/lib/InfoBrief.pm

Criterion	Covered	Total	%
statement	6	59	10.1
branch	0	22	0.0
condition	0	15	0.0
subroutine	2	7	28.5
pod	0	5	0.0
total	8	108	7.4

#!/app/unido-i06/magic/perl
#                              -*- Mode: Perl -*-
# InfoBrief.pm --
# ITIID           : $ITI$ $Header $__Header$
# Author          : Ulrich Pfeifer
# Created On      : Wed Dec  4 13:40:41 1996
# Last Modified By: Ulrich Pfeifer
# Last Modified On: Thu Jan 16 16:20:10 1997
# Language        : CPerl
# Update Count    : 79
# Status          : Unknown, Use with caution!
#
# (C) Copyright 1996, Universit�t Dortmund, all rights reserved.
#
# $Locker$
# $Log$
#

=head1 NAME

InfoBrief - Perl extension for printing envelopes for Infobrief mailings according to the standards of the Deutsche Bundespost

=head1 SYNOPSIS

  use InfoBrief;
  $x = new InfoBrief %OPTIONS;
  print $x->preamble;
  print $x->page(@address);
  print $x->trailer;

=head1 DESCRIPTION

This modules is probably not very useful outside of Germany. It is a
tool dedicated for printing envelopes for Infobrief mailings according
to the standards of the Deutsche Bundespost. You may customize it for
other standards though.

The output generated is Postscript level 2 and conforms to EPSF 1.2.
Since C ist used, the single pages contain only the new
address and running number and the size of the postscript file is
modest.

=head1 OPTIONS

The Constructor C take a few options to customize the output:

=over 5

=item B

=item B

Generate A4 rsp. A5 output. Default is C5.

=item B I

=item B I

Custom output size. Units are Postscript dots (72 dpi).

=item B I

Set custom border size. Default is C<20>.

=item B I

Set the Postamt for the "Entgelt bezahlt" stamp. Default is C<'44227
Dortmund 52'>.

=item B

Add/Omit the "Entgelt bezahlt" stamp. Default is C.

=item B

Add/Omit the "Infobrief" banner. Default is C since the banner
is not required.

=item B

Add/Omit a running number on each envelope. Default is C.

=head1 AUTHOR

Ulrich Pfeifer EFE

=head1 SEE ALSO

perl(1).

=cut

package InfoBrief;
use strict;
use vars qw($VERSION);

$VERSION = '0.14';

my $POSTAMT = '44227 Dortmund 52';
my $STEMPEL;
my $PROLOG;
# a4 paper size
my $a4_width  = 595;
my $a4_height = 842;
# a5 paper size
my $a5_width     = $a4_height/2;
my $a5_height    = $a4_width;
# c5 paper size
my $c5_width     = 459;
my $c5_height    = 649;

# b5j paper size
my $b5j_width     = 516;
my $b5j_height    = 729;

# b5 paper size
my $b5_width     = 499;
my $b5_height    = 708;

# c6 paper size (309,613)
my $c6_width     = 312;
my $c6_height    = 624;

my $border       = 20;
my $width        = $c5_width;
my $height       = $c5_height;
my $s_s          = 4;           # scale stamp
my $stempel      = 1;           # stamp 'Geb�hr bezahlt'
my $infobrief    = 0;           # banner 'Infobief'
my $numbering    = 1;           # running numbers?
{
#  no strict;
  local ($/) = "\n%--\n";
  ($PROLOG, $STEMPEL) = ;
  close DATA;
  #$PROLOG =~ s/\$(\w+)/eval "\$$1"/eg;
}

my @sender = (
              'Fachbereich Informatik Lehrstuhl VI',
              'UNIVERSIT�T DORTMUND',
              'Aug.-Schmidt-Str. 12, 44221 Dortmund',
             );

sub preamble {
  my $self = shift;
  $self->{preamble};
}

sub new {
  my $type = shift;
  my %parm = @_;
  my $self = {};
  my $date = `date`;
  my $PROLOG = $PROLOG;

  chomp($date);

  if (exists $parm{a4}) {
    $width  = $a4_width;
    $height = $a4_height;
  } elsif (exists $parm{a5}) {
    $width  = $a5_width;
    $height = $a5_height;
  } elsif (exists $parm{b5}) {
    $width  = $b5_width;
    $height = $b5_height;
  } elsif (exists $parm{c6}) {
    $width  = $c6_width;
    $height = $c6_height;
  }
  $self->{width}   = $parm{width}  || $width;
  $self->{height}  = $parm{height} || $height;
  $self->{border}  = $parm{border} || $border;
  my $amt          = $parm{amt}    || $POSTAMT;
  my $scale        = $parm{scale}  || $s_s;
  $self->{numbering} =
    ((exists $parm{numbering})?$parm{numbering}:$numbering)?'true':'false';
  $self->{stempel} =
    ((exists $parm{stempel})?$parm{stempel}:$stempel)?'true':'false';
  $self->{infobrief} =
    ((exists $parm{infobrief})?$parm{infobrief}:$infobrief)?'true':'false';
  $PROLOG =~ s/\$(\w+)/$self->{$1}/g;

  my @sender = @sender;
  if ($parm{sender}) {
    @sender = @{$parm{sender}};
  }
  my ($SENDER,$line);
  for ($line=0;$line<@sender;$line++) {
    $SENDER .= "$line ($sender[$line]) Cshow\n";
  }
  $self->{'preamble'} = <
%!PS-Adobe-2.0 EPSF-1.2
%%Title: (FGIR Umschlaege)
%%Pages: (atend)
%%Creator: $0
%%CreationDate: $date
%%BoundingBox: 0 0 $self->{width} $self->{height}
%%Pages: (atend)
%%EndComments

%%BeginProlog
$PROLOG
%%EndProlog

%%BeginSetup
Rotate {
0 $width 2 mul translate
-90 rotate
} if
% a5 background
Background
  {
    gsave
    newpath
    0 0 moveto
    $width $height  Rechteck
    0.95 setgray
    fill
    grestore
  } if

% STEMPEL
% P4 568 328

gsave
328 $scale div $border add $height 568 $scale div $border add sub translate
90 rotate
gsave
568 $scale div 328 $scale div scale
$STEMPEL
grestore
17 18 moveto
Stempel {
  /AvantGarde-Demi-ISO findfont 8 scalefont setfont
  ($amt) show
} {
  newpath
  0 0 moveto
  568 $scale div 328 $scale div Rechteck
  1 setgray
  fill
} ifelse
grestore
% LS6 Stempel
gsave
/AvantGarde-Demi-ISO findfont 9 scalefont setfont
%$border 3 mul $border 3 mul moveto
%90 rotate
$SENDER
grestore

% INFOBRIEF
Infobrief {
  gsave
  /AvantGarde-Demi-ISO findfont 28 scalefont setfont
  $border 3 mul $height 2 div (Infobrief) stringwidth pop 2 div sub moveto
  90 rotate
  (Infobrief) show
  grestore
  } if
%%EndSetup

EOF
  ;
  $self->{page} = 0;
  bless $self, $type;
}

my %DEC = ("�" => "�",
        "�" => "�",
        "�" => "�",
        '-'    => "�",
        "�"    => "�",
        );

my $DEC = join '|', keys %DEC;

sub ps_string
{
   # Prepare text for printing
   local($_) = shift;
   s/($DEC)/$DEC{$1}/eg;
   s/[\\\(\)]/\\$&/g;
   s/[\001-\037\177-\377]/sprintf("\\%03o",ord($&))/ge;
   $_;    # return string
}

sub page {
  my $self = shift;
  $self->{page}++;
  my $page = <
%%Page: $self->{page} $self->{page}
%Begin page

gsave
newpath
Ax Ay moveto
150 250 $border add Rechteck
Background {0.95}  {1.0} ifelse
setgray
fill

% running number
Numbering {
   newpath
   $width $border 2 mul sub $border  2 mul moveto
   30 30 Rechteck
   Background {0.95}  {1.0} ifelse
   setgray
   fill

   0 setgray
   /AvantGarde-Demi-ISO
   findfont 8 scalefont setfont

   $width $border 2 mul sub $border 2 mul moveto
   ($self->{page}) show
} if

0 setgray
FNAMEFONT

EOP
;
  my $i;
  for ($i=0;$i<@_;$i++) {
    $page .= sprintf "%d (%s) Show\n", $i+1, ps_string($_[$i])
  }
  $page .= <
grestore
copypage
%End page
EOP
;
$page;
}

sub trailer {
  my $self = shift;
  <
%%Trailer
%%Pages: $self->{'page'}
EOT
;
}

__DATA__