File Coverage

blib/lib/PostScript/MailLabels.pm

Criterion	Covered	Total	%
statement	339	536	63.2
branch	56	160	35.0
condition	8	42	19.0
subroutine	19	30	63.3
pod	0	26	0.0
total	422	794	53.1

package PostScript::MailLabels;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

use PostScript::MailLabels::BasicData;

require Exporter;

@ISA = qw(Exporter);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw( labelsetup labeldata averycode);

$VERSION = '2.32';

use Carp;

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = {};

	$self->{SETUP} = {};
	$self->{FREETEXT} = {};
	$self->{COMPONENTS} = {};
	$self->{LABELDEF} = [];

	$self->{MAKEBOX} = ''; # ps code to draw a box
	$self->{MAKERULE} = ''; # ps code to make rulers
	$self->{PRTTEXT} = ''; # ps code to output the text
	$self->{PRTBAR} = ''; # ps code to output the barcode

	$self->{DATA} = {}; # pointer to various arrays & hashes of basic data.

    bless $self, $class;

	&initialize($self);

     return $self;
}

sub initialize {

	#		Initialize with some reasonable default values
	#	printable area : define width of borders
	#	printable_left, printable_right, printable_top, printable_bot

	#	output definition : define left and top offsets, width and
	#	height of a label
	#	output_left, output_top, output_width, output_height

	#	Other controls
	#	Postnet => 'yes' : print barcode on bottom for zip code
	#	Font => 'Helvetica'
	#	units => 'inches' or 'cm'
	#

	my $self = shift;

	%{$self -> {SETUP}} = (

		#	paper size

		papersize		=> 'Letter',
		orientation		=> 'portrait',

		#	printable area on physical page

		printable_left		=> 0.0,
		printable_right		=> 0.0,
		printable_top		=> 0.0,
		printable_bot		=> 0.0,

		#	define where the labels live (ideally)

		output_top		=> 0.0,
		output_left		=> 0.0,
		output_width	=> 0.0,
		output_height	=> 0.0,
		x_gap			=> 0.0,
		y_gap			=> 0.0,
		number			=> 0,
		columns			=> 0,

		#	Adjustments for printer idiosyncracies

		x_adjust		=> 0.0,
		y_adjust		=> 0.0,

		#	Other controls

		postnet		=> 'yes',
		font		=> 'Helvetica',
		fontsize 	=> 12,
		units    	=> 'english',
		firstlabel	=> 1,

		#	Character encoding

		encoding    => 'StandardEncoding', # or ISOLatin1Encoding

		# set equal to the Avery(tm) product code, and the label description
		# will be updated from the database.
		avery		=> undef,

		# set equal to the Avery(tm) product code, and the label description
		# will be updated from the database.
		dymo		=> undef,

				   );

	#	Default (US-style) address components

	%{$self -> {COMPONENTS}} = (
		#	first name
		fname	=> { type => 'name', adj => 'yes', font => 'Helvetica', 'index' => 0 },
		#	last name
		lname	=> { type => 'name', adj => 'yes', font => 'Helvetica', 'index' => 1 },
		#	street address and street
		street	=> { type => 'road', adj => 'yes', font => 'Helvetica', 'index' => 2 },
		#	city
		city	=> { type => 'place', adj => 'yes', font => 'Helvetica', 'index' => 3 },
		#	state
		state	=> { type => 'place', adj => 'no', font => 'Helvetica', 'index' => 4 },
		#	country
		country	=> { type => 'place', adj => 'no', font => 'Helvetica', 'index' => 6 },
		#	zip
		zip	=> { type => 'place', adj => 'no', font => 'Helvetica', 'index' => 5 },
		#	postnet
		postnet	=> { type => 'bar', adj => 'no', font => 'PostNetJHC', 'index' => 5 },
				   );

	#	Default label definition

	@{$self -> {LABELDEF}} = (
		#	line 1
		[ 'fname', 'lname' ],
		#	line 2
		[ 'street', ],
		#	line 3
		[ 'city', 'state', 'zip' ],
		#	line 4
		[ 'postnet', ],
	   );

	#	Default free text

	%{$self->{FREETEXT}} = (
		X => 0,
		Y => 0,
		Text => '',
	);


	#	Go get the basic data

	$self->{DATA} = new PostScript::MailLabels::BasicData;
}

##########################################################
## Add or Edit a component                              ##
##########################################################

#	editcomponent(name, type, adjust, index, font, )
#		where
#			name = component name
#			type = name, road, place (controls trimming)
#			adjust = yes or no (can I shorten it?)
#			index = which element of input array?
#			font = which font to use
sub editcomponent {
	my $self = shift;
	my ($name, $type, $adj, $index, $font) = @_;

	if (!defined $name) {return [keys %{$self->{COMPONENTS}}];}

	if (!defined $type) {return [values %{$self->{COMPONENTS}{$name}}];}

	if (!defined $font) {$font = $self->{SETUP}{font};}
	if (!defined $adj) {$adj = 'no';}

	if (!defined $index && defined $self->{COMPONENTS}{$name}) {
		$index = $self->{COMPONENTS}{$name}->{'index'};
	}
	elsif (!defined $index) {
	}
	elsif ($index !~ /^\d+$/) {
	}

	if ($type ne 'name' && $type ne 'road' && $type ne 'place' && $type ne 'bar') {
		print STDERR "Invalid type $type, in editcomponent call\n";
		die;
	}
	if ($adj ne 'yes' && $adj ne 'no') {
		print STDERR "Invalid adjust $adj, in editcomponent call\n";
		die;
	}
	my @fonts = ListFonts($self);
	my $okay=0;
	foreach (@fonts) {
		if ($font eq $_){
			$okay=1;
			last;
		}
	}
	if (!$okay) {
		print STDERR "Invalid font, $font, requested.\n",
					 "Available fonts are :\n",
					 join("\n",@fonts),"\n";
		die;
	}

	#	Whew! input verified, lets apply it...

	$self->{COMPONENTS}{$name} = { type => $type,
	                               adj => $adj,
	                               'index' => $index,
								   font => $font};
	return ;
}

##########################################################
## Label definition                                     ##
##########################################################

#	definelabel(line #, component, component, ...)

sub definelabel {
	my $self = shift;
	my $line = shift;
	my @comps;

	if (!defined $line) { return $self->{LABELDEF};}

	if ($line eq 'clear') { # clear old definition
		$self -> {LABELDEF} = ();
		return;
	}

	if ($#_<0) {return $self->{LABELDEF}[$line];}

	if ($line !~ /^\d+$/) {
		print STDERR "Invalid line number $line, in definelabel call\n";
		die;
	}

	#	verify components exist

	my $postnet=0;
	foreach (@_) {
		push @comps, $_; # take this opportunity to do a deep copy...
		if ($_ eq 'postnet') {$postnet=1;}
		if (!defined $self->{COMPONENTS}{$_}) {
			print STDERR "Invalid component $_, in definelabel call\n";
			die;
		}
	}

	#	Make certain that if barcode is requested, it is the only component
	#	on that line

	if ($postnet && $#comps > 0) {
		print STDERR "postnet (barcode) must be the only component on the line, in definelabel call\n";
		die;
	}

	$self -> {LABELDEF}[$line] = \@comps;

	return ;
}

##########################################################
## Free Text                                            ##
##########################################################

sub freetext {
	my $self = shift;
	my %args = @_;

	foreach (keys %args) {
		if (/^X$/i) {
			$self->{FREETEXT}{X} = $args{$_};
		}
		elsif (/^Y$/i) {
			$self->{FREETEXT}{Y} = $args{$_};
		}
		elsif (/^text$/i) {
			$self->{FREETEXT}{Text} = $args{$_};
		}
		else {
			print STDERR "Invalid parameter, $_, given to FREETEXT\n";
		}
	}
	return;
}

##########################################################
## Set the settings                                     ##
##########################################################

sub labelsetup {
	my $self = shift;
	my %args = @_;

	my %params;
	#	when adding a parameter, be sure to increment the array at the end of the statement.
	@params{ qw / papersize height width orientation printable_left printable_right printable_top printable_bot output_top
		output_left output_width output_height x_gap y_gap number x_adjust y_adjust
		postnet font fontsize units firstlabel avery dymo columns encoding / } = (0..25);

	my @papers = @{$self->{DATA}{PAPER}};

	my @encodings = qw / ISOLatin1Encoding StandardEncoding / ;

    #   conversion from inches/centimeters to points

	my $f = 72;
	if (defined($args{units}) && $args{units} eq 'metric') {$f = 28.3465;}

	foreach (keys %args)
		{
          #  print "$_\n"; #################################
			if (!defined $params{lc($_)}) {
				print STDERR "Invalid setup parameter $_\n";
				die;
			}
			if ( lc($_) eq 'font') {
				my @fonts = ListFonts($self);
				my $okay=0;
				foreach my $font (@fonts) {
					if ($font eq $args{$_}){
						$okay=1;
						last;
					}
				}
				if (!$okay) {
					print STDERR "Invalid font, $args{$_}, requested.\n",
					             "Available fonts are :\n",
								 join("\n",@fonts),"\n";
					die;
				}
				$self->{SETUP}{lc($_)} = $args{$_};
			}
			elsif (lc($_) eq 'encoding') {
				my $okay=0;
				foreach my $encoding (@encodings) {
					if ($encoding =~ /$args{$_}/i){
						$okay=1;
						$args{$_} = $encoding;
						last;
					}
				}
				if (!$okay) {
					print STDERR "Invalid encoding, $args{$_}, requested.\n",
					             "Available values are :\n",
								 join("\n",@encodings),"\n";
					die;
				}
				$self->{SETUP}{lc($_)} = $args{$_};
			}
			elsif (lc($_) eq 'papersize') {
				my $okay=0;
				foreach my $paper (@papers) {
					if ($paper =~ /$args{$_}/i){
						$okay=1;
						$args{$_} = $paper;
						last;
					}
				}
				if (!$okay) {
					print STDERR "Invalid papersize, $args{$_}, requested.\n",
					             "Available sizes are :\n",
								 join("\n",@papers),"\n";
					die;
				}
				$self->{SETUP}{lc($_)} = $args{$_};
			}
			elsif (lc($_) eq 'width') {
			    my($val) = lc($args{$_});
				$self->{SETUP}{papersize} = 'Userdefined';
                $self->{DATA}->{WIDTH}{Userdefined} = $val*$f;
			}
			elsif (lc($_) eq 'height') {
			    my($val) = lc($args{$_});
				$self->{SETUP}{papersize} = 'Userdefined';
                $self->{DATA}->{HEIGHT}{Userdefined} = $val*$f;
			}
			elsif (lc($_) eq 'orientation') {
			    my($val) = lc($args{$_});
			    if ($val ne 'portrait' && $val ne 'landscape') {
				die "Invalid orientation \"$args{$_}\" -- must be \"portrait\" or \"landscape\"\n";
			    }
			    $self->{SETUP}{lc($_)} = $val;
			}
			else {
				$self->{SETUP}{lc($_)} = lc($args{$_});
				$args{lc($_)} = $args{$_};
			}
		}

	#	convert all parameters to points

	foreach (qw/output_left output_top output_width output_height printable_left printable_right printable_top printable_bot x_gap y_gap x_adjust y_adjust /) {
		if (defined $args{$_}) {$self->{SETUP}{$_} *= $f;}
	}


	############  Process and verify parameters

	#	If avery code is defined, use it.
 # layout=>[paper-size,[list of product codes], description,
 #          number per sheet, left-offset, top-offset, width, height]
 #			distances measured in points


my( $labelmaker ) = grep { defined $self->{SETUP}{$_} && $self->{SETUP}{$_} ne '' } qw(avery dymo);

if ( $labelmaker ) {
		my $code = $self->{SETUP}{$labelmaker};

		my $key  = uc $labelmaker;

		$self->{SETUP}{papersize}     = $self->{DATA}{$key}{$code}->[0];
		$self->{SETUP}{number}        = $self->{DATA}{$key}{$code}->[3];
		$self->{SETUP}{output_left}   = $self->{DATA}{$key}{$code}->[4];
		$self->{SETUP}{output_top}    = $self->{DATA}{$key}{$code}->[5];
		$self->{SETUP}{output_width}  = $self->{DATA}{$key}{$code}->[6];
		$self->{SETUP}{output_height} = $self->{DATA}{$key}{$code}->[7];
		$self->{SETUP}{x_gap}         = $self->{DATA}{$key}{$code}->[8];
		$self->{SETUP}{y_gap}         = $self->{DATA}{$key}{$code}->[9];
	}

	#	Verify that measurements sum correctly...

#	$self->{SETUP}{columns} = 1 if( $self->{SETUP}{columns} == 0 and $labelmaker eq 'dymo' );

	if ($self->{SETUP}{columns} > 0) {
		my $pwidth = $self->{SETUP}{output_width}*$self->{SETUP}{columns}
					 + $self->{SETUP}{x_gap}*($self->{SETUP}{columns}-1)
					 + $self->{SETUP}{output_left}*2;
		if (abs($pwidth - papersize($self, 1)->[0]) > $self->{SETUP}{output_width}/2) {
			print STDERR "Sum of label widths ($pwidth) differs from paper width (",
			              papersize($self, 1)->[0],
			             ") by > ",$self->{SETUP}{output_width}/2," points\n";
			die;
		}
	}
	return $self->{SETUP};
}



# ****************************************************************

	#	printable area : define width of borders
	#	printable_left, printable_right, printable_top, printable_bot

	#	output definition : define left and top offsets, width and
	#	height of a label
	#	output_left, output_top, output_width, output_height

	#	Other controls
	#	Postnet => 'yes' : print barcode on bottom for zip code
	#	Font => 'Helvetica'
	#

# ****************************************************************
sub labelcalibration {
    my $self = shift;

	#	Create a postscript file that will place centered axes on the page
	#	marked off in inches or centimeters, that will allow the user to
	#	actually see what the printable area of their printer is.

	#	Calculate the following quantites to place in the postscript file :
	#	x and y coordinates of page center in points
	#	inc = 0.1 inch or 0.1 cm depending on units, but expressed in points
	#	numx and numy : number of inches or cm on each axis, rounded up.

	my $paperwidth = papersize($self)->[0] ; # total width of paper
	my $paperheight = papersize($self)->[1] ; # total height of paper

	my $xcenter = papersize($self, 1)->[0]/2;
	my $ycenter = papersize($self, 1)->[1]/2;
	my $landscape = ($self->{SETUP}{orientation} eq 'landscape');
        my $translate = $landscape ? "$paperwidth 0 translate 90 rotate" : '';

	my $inc = 7.2;
	if ($self->{SETUP}{units} eq 'metric') {$inc = 2.8346457;}

	my $numx = int((($xcenter*2)/($inc*10))+0.9);
	my $numy = int((($ycenter*2)/($inc*10))+0.9);

	my $postscript = $self->{DATA}{CALIBRATE};

	$postscript =~ s/%pagesize%/<< \/PageSize [$paperwidth $paperheight]>> setpagedevice/g;
	$postscript =~ s/%translate%/$translate/g;
	$postscript =~ s/%xcenter%/$xcenter/g;
	$postscript =~ s/%ycenter%/$ycenter/g;
	$postscript =~ s/%inc%/$inc/g;
	$postscript =~ s/%numx%/$numx/g;
	$postscript =~ s/%numy%/$numy/g;

     return $postscript;
}

# ****************************************************************
sub labeltest {
    my $self = shift;

	#	Create a postscript file to test the calibration

	my $postscript = $self->{DATA}{TESTPAGE};

	my $cols = $self->{SETUP}{columns} || int(papersize($self)->[0] / ($self->{SETUP}{x_gap} + $self->{SETUP}{output_width}));
	my $rows = $self->{SETUP}{number}/$cols;

	my $physical_paperwidth = papersize($self)->[0] ; # total width of paper
	my $physical_paperheight = papersize($self)->[1] ; # total height of paper
	my $paperwidth = papersize($self, 1)->[0] ;
	my $paperheight = papersize($self, 1)->[1] ;

	my $landscape = ($self->{SETUP}{orientation} eq 'landscape');
        my $translate = $landscape ? "$physical_paperwidth 0 translate 90 rotate" : '';

	$postscript =~ s/%pagesize%/<< \/PageSize [$physical_paperwidth $physical_paperheight]>> setpagedevice/g;
	$postscript =~ s/%translate%/$translate/g;
	$postscript =~ s/%paperwidth%/$paperwidth/g ; # total width of paper
	$postscript =~ s/%paperheight%/$paperheight/g ; # total height of paper
	$postscript =~ s/%boxwidth%/$self->{SETUP}{output_width}/e ; # label width
	$postscript =~ s/%boxheight%/$self->{SETUP}{output_height}/e ; # label height
	$postscript =~ s/%xgap%/$self->{SETUP}{x_gap}/e ; # x gap between labels
	$postscript =~ s/%ygap%/$self->{SETUP}{y_gap}/e ; # y gap between labels
	$postscript =~ s/%rows%/$rows/ ; # rows of labels on each page
	$postscript =~ s/%cols%/$cols/ ; # columns of labels on each page
	$postscript =~ s/%by%/$self->{SETUP}{output_top}/e ; # gap between top of first label and top of page

	# adjustments
	$postscript =~ s/%xadjust%/$self->{SETUP}{x_adjust}/e ; # adjustment if paper not x centered
	$postscript =~ s/%yadjust%/$self->{SETUP}{y_adjust}/e ; # adjustment if paper not y centered
	$postscript =~ s/%lbor%/$self->{SETUP}{printable_left}/e ; # left border
	$postscript =~ s/%rbor%/$self->{SETUP}{printable_right}/e ; # right border
	$postscript =~ s/%tbor%/$self->{SETUP}{printable_top}/e ; # top border
	$postscript =~ s/%bbor%/$self->{SETUP}{printable_bot}/e ; # bottom border

    return $postscript;
}

# ****************************************************************
#	Make mailing labels

sub makelabels {
    my $self = shift;
	my $addrs = shift;

	my $pageno=1;

#---------- set up preamble
	my $postscript = <<'LABELS';
%!PS

% This code copyright 1999, Alan Jackson, [e-mail] and is
% protected under the Open Source license. Code may be copied and
% modified so long as attribution to the original author is
% maintained.

% Notes : the -15 points for the barcode is to produce the legally required
%         13.5 point gap above the codes
%         The barcode font must be 12 point or greater

LABELS
#---------- end preamble
	my $physical_paperwidth = papersize($self)->[0] ; # total width of paper
	my $physical_paperheight = papersize($self)->[1] ; # total height of paper
	my $paperwidth = papersize($self, 1)->[0] ;
	my $paperheight = papersize($self, 1)->[1] ;
	my $landscape = ($self->{SETUP}{orientation} eq 'landscape');
        my $translate = $landscape ? "%\tlandscape orientation\n$paperheight 0 translate 90 rotate\n" : '';

	$postscript .= "%	set the page size\n" .
	               "<< /PageSize [$physical_paperwidth $physical_paperheight]>> setpagedevice\n";

        $postscript .= "gsave\n" . $translate;

	if ($self->{SETUP}{postnet} eq 'yes') {
		$postscript .= $self->{DATA}{POSTNET}; # add in barcode stuff
	}

	my $cols = $self->{SETUP}{columns} || int(papersize($self)->[0] / ($self->{SETUP}{x_gap} + $self->{SETUP}{output_width}));

	my $rows = $self->{SETUP}{number}/$cols;

	my $boxwidth = $self->{SETUP}{output_width} ; # label width
	my $boxheight = $self->{SETUP}{output_height} ; # label height
	my $xgap = $self->{SETUP}{x_gap} ; # x gap between labels
	my $ygap = $self->{SETUP}{y_gap} ; # y gap between labels
	my $by = $self->{SETUP}{output_top} ; # gap between top of first label and top of page

	# adjustments
	my $xadjust = $self->{SETUP}{x_adjust} ; # adjustment if paper not x centered
	my $yadjust = $self->{SETUP}{y_adjust} ; # adjustment if paper not y centered
	my $lbor = $self->{SETUP}{printable_left} ; # left border
	my $rbor = $self->{SETUP}{printable_right} ; # right border
	$rbor = $paperwidth - $rbor;
	my $tbor = $self->{SETUP}{printable_top} ; # top border
	my $bbor = $self->{SETUP}{printable_bot} ; # bottom border

	my $fontsize = $self->{SETUP}{fontsize};
	my $font = $self->{SETUP}{font};

	#	Can I fit all the rows desired onto the page?

	if (($rows*$boxheight + $by) > ($paperheight - $bbor)) {
		$rows--; # not enough room, drop the last row.
	}

#	Build arrays of sx, y, and width that define the locations and widths
#	of all the labels on a page. They are numbered starting at the top left,
#	going across and then down.

	my @y_arr = qw/0/;
	my @x_arr = qw/0/;
	my @w_arr = qw/0/;

	my ($sx,$ex); # start x, end x for each label
	my $bx = ($paperwidth - ($cols-1)*$xgap - $boxwidth*$cols)/2; # begin x
	my $y = $paperheight - $by - $yadjust; # initial y position
	for (my $r=1;$r<=$rows;$r++) {
		my $x = $bx;
		for (my $c=1;$c<=$cols;$c++) {
			if ($x < $lbor) { $sx = $lbor;} # adjust leftmost label
			else {$sx = $x;}
			$x += $boxwidth;
			if ( $x > $rbor) {$ex = $rbor} # adjust rightmost labelh
			else {$ex = $x;}
			$x += $xgap;
			my $width = $ex - $sx;
			$sx += $xadjust;
			push @y_arr,$y;
			push @x_arr,$sx+$xadjust+5;
			push @w_arr,$width-10; # leave 5 points slop on both ends.
		}
		$y = $y - $boxheight - $ygap;
	}

	#	set the desired font and size
	#The following lines have been modified to account for Portuguese characters
	# Nuno Faria, 2000/Mars/03
#	$postscript .= "/$font findfont\n".
#	               "dup length dict begin\n".
#		           "{1 index /FID ne {def} {pop pop} ifelse} forall\n".
#			   	   "/Encoding $self->{SETUP}{encoding} def\n".
#			       "currentdict\n".
#			       "end\n".
#		           "/$font exch definefont pop\n";
	#End of modifications
	# new mods by Juan Manuel Calvo to generalize the process (Nov 2005)
##### make a list of fonts

        my %fontlist;
        foreach (@{$addrs}){
                foreach my $line (@{$self->{LABELDEF}}) {
                        foreach my $comp (@{$line}) {
                                $fontlist{$self->{COMPONENTS}{$comp}->{font}}++;
                        }
                }
        }
        $fontlist{$font}++;
####### define enconding for all fonts
        for my $k (keys %fontlist ) {
            $postscript .= "% encoding for $k\n" .
                           "/$k findfont\n".
                           "dup length dict begin\n".
                               "{1 index /FID ne {def} {pop pop} ifelse} forall\n".
                                       "/Encoding $self->{SETUP}{encoding} def\n".
                                   "currentdict\n".
                                   "end\n".
                               "/$k exch definefont pop\n";
        }
#####

	$postscript .= "/$font findfont $fontsize scalefont setfont\n".
	               "/fontsize $fontsize def\n";

	#	scroll through the address array, building the commands
	#	to print. Test each field to see if it will fit on the
	#	label. If it is too long, do some "intelligent" shortening.

	my $lab = $self->{SETUP}{firstlabel};
	foreach (@{$addrs}){
		my $linenum = 1;
		foreach my $line (@{$self->{LABELDEF}}) {
			my @text = prepare_text($self, $_, $line, $w_arr[$lab]);
			next if length(join('',@text)) == 0; # data-less line
			$postscript .= "/sx $x_arr[$lab] def /y $y_arr[$lab] def\n";
			$postscript .= "/cury y fontsize $linenum mul sub def\n";
			$postscript .= "sx cury moveto\n";
			foreach my $comp (@{$line}) {
				$postscript .= "/$self->{COMPONENTS}{$comp}->{font} findfont $fontsize scalefont setfont\n";
				my $text = shift @text;
				if ($self->{COMPONENTS}{$comp}->{'type'} eq 'bar') { # barcode
					#$postscript .= "gsave\n";
					$postscript .= "/fontsize 12 def\n";
					$postscript .= "/PostNetJHC findfont fontsize scalefont setfont\n";
					$postscript .= "/cury cury 15 sub def\n";
					$postscript .= "/cury y fontsize $linenum mul sub def\n";
					$postscript .= "sx cury moveto\n";
					$postscript .= "($text) show\n";
					$postscript .= "/$font findfont $fontsize scalefont setfont\n".
								   "/fontsize $fontsize def\n";
					#$postscript .= "grestore\n";
				}
				else { # not barcode
				$postscript .= "($text) show\n";
				}
			}
			$linenum++;
		}
		$lab++;
		if ($lab > $rows*$cols) { # end of page
			#	Add a free label, like page number, where ever user wishes
			#	token %page% is replaced with page number
			if ($self->{FREETEXT}{Text} ne '') {
				my $freetext = $self->{FREETEXT}{Text};
				$freetext =~ s/%page%/$pageno/;
				$postscript .= $self->{FREETEXT}{X}." ".$self->{FREETEXT}{Y}." moveto ($freetext) show\n";
			}
			$postscript .= "showpage\n% ------- start new page\n\n";
			$pageno++;
			$lab = 1;
		}
	}
	if ($self->{FREETEXT}{Text} ne '') {
		my $freetext = $self->{FREETEXT}{Text};
		$freetext =~ s/%page%/$pageno/;
		$postscript .= $self->{FREETEXT}{X}." ".$self->{FREETEXT}{Y}." moveto ($freetext) show\n";
	}
	$postscript .= "showpage\n% ------- end of data\n" unless $lab == 1;

	$postscript .= "grestore\n";

	return $postscript;
}

sub prepare_text {
	my $self = shift;
	my $addrs = shift;
	my $line = shift;
	my $width = shift;

	my @text ; # array to be returned

	#	If barcode, handle and return

	if ($self->{COMPONENTS}{$line->[0]}->{'type'} eq 'bar') { # trim barcode
		my $text = $_->[$self->{COMPONENTS}{$line->[0]}->{'index'}];
		$text = trimbar($self,$text,
			$addrs->[$self->{COMPONENTS}{'street'}->{'index'}], $width);
		return $text;
	}

	#	If it's not Standard Encoding, then I don't know how to calculate
	#	the string length, so I can't do any trimming for you. Maybe later...

	if ($self->{SETUP}{encoding} ne 'StandardEncoding') {
		foreach my $comp (@{$line}) {
			my $text = $addrs->[$self->{COMPONENTS}{$comp}->{'index'}] . " ";
			push @text, escape($text);
		}
		chop $text[-1];
		return @text;
	}

	#	Find longest adjustable string

	my $fontsize = $self->{SETUP}{fontsize};
	my ($type, $adjcomp, $maxlen, $totlen) = (0,0,0,0);
	my $strlen = $width;
	foreach my $comp (@{$line}) {
		if (!defined $addrs->[$self->{COMPONENTS}{$comp}->{'index'}]) {
			print STDERR "Empty address field encountered. Use a blank in empty fields.\n";
			$addrs->[$self->{COMPONENTS}{$comp}->{'index'}] = " ";
		}
		my $text = $addrs->[$self->{COMPONENTS}{$comp}->{'index'}] . " ";
		my $length = stringlen($self,"$text",$self->{COMPONENTS}{$comp}->{font}, $fontsize);
		$totlen += $length;
		if ($self->{COMPONENTS}{$comp}->{'adj'} eq 'yes') {
			if ($maxlen < $length) {
				$maxlen = $length;
				$adjcomp = $comp;
				$type = $self->{COMPONENTS}{$comp}->{'type'};
			}
		}
		push @text, escape($text);
	}

	#	trim back the longest adjustable string, if necessary

	if ($maxlen == 0 || $totlen <= $width) { # trimming not possible / needed
		chop $text[-1];
		return @text;
	}

	$strlen -= ($totlen - $maxlen); # how much space is left?
	if ($type eq 'name') {
		$addrs->[$self->{COMPONENTS}{$adjcomp}->{'index'}] =
			trimname ($self,$addrs->[$self->{COMPONENTS}{$adjcomp}->{'index'}],$strlen);
	}
	elsif ($type eq 'road') {
		$addrs->[$self->{COMPONENTS}{$adjcomp}->{'index'}] =
			trimaddr ($self,$addrs->[$self->{COMPONENTS}{$adjcomp}->{'index'}],$strlen);
	}
	elsif ($type eq 'place') {
		$addrs->[$self->{COMPONENTS}{$adjcomp}->{'index'}] =
			trimcity ($self,$addrs->[$self->{COMPONENTS}{$adjcomp}->{'index'}],$strlen);
	}

	#	build output array
	@text = ();
	foreach my $comp (@{$line}) {
		my $text = $addrs->[$self->{COMPONENTS}{$comp}->{'index'}] . " ";
		push @text, escape($text);
	}
	chop $text[-1];
	return @text;
}

sub escape {
	#	escape special characters
	my $text = shift;
	$text =~ s/\(/\\(/g;
	$text =~ s/\)/\\)/g;
	$text =~ s/([\200-\377])/sprintf "\\%3.3o", ord $1/eg;
	return $text;
}

# ****************************************************************
# Intelligently trim back name if needed
sub trimname {
	my $self = shift;
	my $name = shift;
	my $width = shift;

	$name =~ s/^\s*//;
	$name =~ s/\s*$//;

	my $strwidth = stringwidth($self,"$name");

	if ($strwidth > $width) {
		my $nchar = (($strwidth-$width)/$strwidth)*length($name); # approx # extra chars

		if ($name =~ / and / ) {
			$name =~ s/ and / & /;
			$nchar -= 2;
		}
		if ($nchar > 0) {
			#	Trim first names, leaving last name intact
			$name = substr($name,0,(length($name)-$nchar));
		}
		$strwidth = stringwidth($self,$name);
		if ($strwidth > $width) {chop $name;}
	}
	return $name;
}

# ****************************************************************
# Intelligently trim back street address if needed
sub trimaddr {
	my ($self, $addr, $width) = @_;

	$addr =~ s/^\s*//;
	$addr =~ s/\s*$//;

	my $strwidth = stringwidth($self,$addr);

	if ($strwidth > $width) {
		$addr =~ s/\.//g;
		$addr =~ s/\s*rd$//i;
		$addr =~ s/\s*ave$//i;
		$addr =~ s/\s*st$//i;
		$addr =~ s/\s*ln$//i;
		$strwidth = stringwidth($self,$addr);
		if ($strwidth > $width) {
			my $nchar = (($strwidth-$width)/$strwidth)*length($addr); # approx # extra chars
			$addr = substr($addr,0,(length($addr)-$nchar));
		}
	}
	return $addr;
}

# ****************************************************************
# Intelligently trim back city if needed
sub trimcity {
	my ($self, $city, $width) = @_;

	$city =~ s/^\s*//;
	$city =~ s/\s*$//;

	my $strwidth = stringwidth($self,$city);

	if ($strwidth > $width) {
		my $nchar = (($strwidth-$width)/$strwidth)*length($city); # approx # extra chars
		$city = substr($city,0,(length($city)-$nchar));
	}
	return $city;
}

# ****************************************************************
# Intelligently set up for barcode
sub trimbar {
	my ($self, $zip, $street, $width) = @_;

	if (!defined $zip || length($zip) < 5) {
		return ' ';
	}

	$zip =~ s/^\s*//;
	$zip =~ s/\s*$//;
	$street =~ s/^\s*//;
	$street =~ s/\s*$//;

	$zip =~ s/\-//;
	if ($zip =~ /[^0-9]/) {
		print STDERR "not a US zipcode : $zip\n";
		return ' ';
	}

	my $keepfont = $self->{SETUP}{font};
	my $keepfontsize = $self->{SETUP}{fontsize};
	$self->{SETUP}{font} = 'PostNetJHC';
	$self->{SETUP}{fontsize} = 12;

	my $zip5 = substr($zip,0,5);
	my $zipcode = 'I' . $zip5 . chksum($zip5) . "I";

	my $strwidth = stringwidth($self,$zipcode);
	if ($strwidth > $width) { # can't make it short enough
		$self->{SETUP}{font} = $keepfont;
		$self->{SETUP}{fontsize} = $keepfontsize;
		return ' ';
	}

	if (length($zip) == 5) {
		$self->{SETUP}{font} = $keepfont;
		$self->{SETUP}{fontsize} = $keepfontsize;
		return $zipcode;
	}

	if (length($zip) != 9) {
		print STDERR "error in zipcode $zip\n";
		$self->{SETUP}{font} = $keepfont;
		$self->{SETUP}{fontsize} = $keepfontsize;
		return $zipcode;
	}

	my $zip_plus = 'I' . $zip . chksum($zip) . "I";
	$strwidth = stringwidth($self,$zip_plus);
	$self->{SETUP}{font} = $keepfont;
	$self->{SETUP}{fontsize} = $keepfontsize;
	if ($strwidth > $width) {
		return $zipcode;
	}
	return $zip_plus;
}

sub chksum {
	my $num = shift;
	return (10 - eval(join('+',(split(//,$num))))%10)%10;
}

# ****************************************************************
#	return label description : Output_Left Output_Top Output_Width Output_Height

sub labeldata {
    my $self = shift;

    return [ $self->{SETUP}{output_left},
             $self->{SETUP}{output_top},
             $self->{SETUP}{output_width},
             $self->{SETUP}{output_height},
	       ];
}

# ****************************************************************
#	return the avery layout code given a product code
sub averycode {
    my $self = shift;
	my $product = shift;

 # layout=>[paper-size,[list of product codes], description,
 #          number per sheet, left-offset, top-offset, width, height]
 #			distances measured in points

	foreach (keys %{$self->{DATA}{AVERY}}) {
		if (grep /$product/,@{$self->{DATA}{AVERY}{$_}->[1]}) {
			return $_;
		}
	}

    return 0;
}

# ****************************************************************
#	return the avery data
sub averydata {
    my $self = shift;

 # layout=>[paper-size,[list of product codes], description,
 #          number per sheet, left-offset, top-offset, width, height,
 #			x-gap, y-gap]
 #			distances measured in points

    return $self->{DATA}{AVERY};
}

# ****************************************************************
#	return the dymo layout code given a product code
sub dymocode {
    my $self = shift;
	my $product = shift;

 # layout=>[paper-size,[list of product codes], description,
 #          number per sheet, left-offset, top-offset, width, height]
 #			distances measured in points

	foreach (keys %{$self->{DATA}{DYMO}}) {
		if (grep /$product/,@{$self->{DATA}{DYMO}{$_}->[1]}) {
			return $_;
		}
	}

    return 0;
}

# ****************************************************************
#	return the dymo data
sub dymodata {
    my $self = shift;

 # layout=>[paper-size,[list of product codes], description,
 #          number per sheet, left-offset, top-offset, width, height,
 #			x-gap, y-gap]
 #			distances measured in points

    return $self->{DATA}{DYMO};
}

# ****************************************************************
#		Return width & height of paper
sub papersize {
    my $self = shift;
    my $logical = shift;

    my($width) = $self->{DATA}->{WIDTH}{$self->{SETUP}{papersize}};
    my($height) = $self->{DATA}->{HEIGHT}{$self->{SETUP}{papersize}};

    if (!$logical || $self->{SETUP}{orientation} eq 'portrait') {
	return [$width, $height];
    }
    else {
	return [$height, $width];
    }
}

# ****************************************************************
#		Return paper names
sub papers {
    my $self = shift;

    return $self->{DATA}->{PAPER};
}


sub stringlen {
   my ($self,$string,$fontname,$fontsize) = @_;
   my $returnval = 0;

   foreach my $char (unpack("C*",$string)) {
       $returnval+=$self->{DATA}->{FONTS}{$fontname}->[$char-32];
   }
   return ($returnval*$fontsize/1000);

}

sub stringwidth {
   my ($self,$string,) = @_;
   my $returnval = 0;
   my $fontname = $self->{SETUP}{font};
   my $fontsize = $self->{SETUP}{fontsize};

   foreach my $char (unpack("C*",$string)) {
       $returnval+=$self->{DATA}->{FONTS}{$fontname}->[$char-32];
   }
   return ($returnval*$fontsize/1000);

}


sub ListFonts {
	my $self = shift;
    my @tmp = %{$self->{DATA}->{FONTS}};
    my @returnval =();
    while (@tmp) {
        push @returnval, shift(@tmp);
	shift @tmp;
    }
    return sort( {$a cmp $b;} @returnval);
}

1;
__END__