#
#  $Id$
#

package postnet;

use Exporter();
@ISA = qw( Exporter );
@EXPORT = qw( pnpcl );

my @patterns = ( "11000",  # 0 digit pattern
                 "00011",  # 1 digit pattern
                 "00101",  # 2 digit pattern
                 "00110",  # 3 digit pattern
                 "01001",  # 4 digit pattern
                 "01010",  # 5 digit pattern
                 "01100",  # 6 digit pattern
                 "10001",  # 7 digit pattern
                 "10010",  # 8 digit pattern
                 "10100" );# 9 digit pattern

sub pnpcl {
   # returns PCL to print postnet bar code
   my ( $zip ) = @_;
   return undef unless ( $zip =~ /^[0-9\-]+$/ );
   return undef unless ( length( $zip ) == 5 ||
                         length( $zip ) == 9 ||
                         length( $zip ) == 10 );
   my $sum = 0;
   my $pcl = &PNBar( 1 );
   while ( $zip ne '' ) {
      my $digit = substr( $zip, 0, 1 );
      $zip = substr( $zip, 1 );
      if ( $digit ne '-' ) {
         $sum += $digit;
         my $pat = $patterns[$digit];
         while ( $pat ne '' ) {
            my $bar = substr( $pat, 0, 1 );
            $pat = substr( $pat, 1 );
            $pcl .= &PNBar( $bar );
         }
      }
   }
   $sum %= 10;
   my $pat = $patterns[10 - $sum];
   while ( $pat ne '' ) {
      my $bar = substr( $pat, 0, 1 );
      $pat = substr( $pat, 1 );
      $pcl .= &PNBar( $bar );
   }
   $pcl .= &PNBar( 1 );
   $pcl;
}

sub PNBar {
   my ( $size ) = @_;

   "\e&f0S" .
   "\e*p-38Y" .
   ( ( $size == 0 ) ? "\e*p+21Y" : "" ) .
   "\e*c6A" .
   ( ( $size == 0 ) ? "\e*c17B" : "\e*c38B" ) .
   "\e*c0P" .
   ( ( $size == 0 ) ? "\e*p-21Y" : "" ) .
   "\e*p+38Y" .
   "\e&f1S" .
   "\e*p+15X";
}

$VERSION = "0.10";

sub Version { $VERSION; }

require 5.004;

1;

__END__


=pod
=head1 NAME

postnet - package for producing postnet barcodes for PCL 5 printers

=head1 SYNOPSIS

 use postnet;
 print 'The postnet barcode for 49104 is ' . pnpcl( '49104' );


=head1 DESCRIPTION

This package produces the USPS postnet barcode for standard 5-digit zipcodes
and zip+4 codes.  If the zip code passed is not 5, 9, or 10 characters in
length or contains characters other than 0-9 and the '-', pnpcl returns undef.

=head1 AUTHOR

Brad Christensen <bradc@andrews.edu>

=head1 SEE ALSO

The Hewlett-Packard LaserJet reference manual.

=head1 BUGS

Currently this package only produces PCL 5 code.  It will not produce postnet
barcodes for dot-matrix or PCL3 printers.

=head1 ACKNOWLEDGEMENTS

This package is based upon C routines published in the C Gazette,
Volume 5, Number 2 by Andrew Binstock.

=head1 COPYRIGHT

Copyright 1998, Brad Christensen

This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 AVAILABILITY

The latest version of this library is likely to be available from:

http://www.andrews.edu/~bradc/perl/postnet/

=cut