#! /usr/bin/perl -w
use strict;

# in inches
my $unit = 0.01;
my $height = 0.25;
my $quiet = 0.1;
my $factor = 6;

# ---------

use POSIX;
use CGI;
my $q = new CGI;

my %table = 
(
	'0' => '101001101101',
	'C' => '110110100101',
	'O' => '110101101001',
	'-' => '100101011011',
	'1' => '110100101011',
	'D' => '101011001011',
	'P' => '101101101001',
	'.' => '110010101101',
	'2' => '101100101011',
	'E' => '110101100101',
	'Q' => '101010110011',
	' ' => '100110101101',
	'3' => '110110010101',
	'F' => '101101100101',
	'R' => '110101011001',
	'*' => '100101101101',
	'4' => '101001101011',
	'G' => '101010011011',
	'S' => '101101011001',
	'$' => '100100100101',
	'5' => '110100110101',
	'H' => '110101001101',
	'T' => '101011011001',
	'/' => '100100101001',
	'6' => '101100110101',
	'I' => '101101001101',
	'U' => '110010101011',
	'+' => '100101001001',
	'7' => '101001011011',
	'J' => '101011001101',
	'V' => '100110101011',
	'%' => '101001001001',
	'8' => '110100101101',
	'K' => '110101010011',
	'W' => '110011010101',
	'9' => '101100101101',
	'L' => '101101010011',
	'X' => '100101101011',
	'A' => '110101001011',
	'M' => '110110101001',
	'Y' => '110010110101',
	'B' => '101101001011',
	'N' => '101011010011',
	'Z' => '100110110101'
);

sub encodechar
{
  my($c) = @_;
	$c = uc $c;
	$table{$c} or $c = '-';

  my $out = '';
	my $code = $table{$c};
	foreach my $char(split('',$code))
	{
	  $out .= $char x $factor;
	}

  return $out;
}

sub encode
{
  my ($string) = @_;
	my $out = '';
	
	$out .= &encodechar('*');

	while($string =~ /^(.)(.*)$/)
	{
	  my $c = $1;
		$string = $2;

	  $out .= ('0' x $factor) . &encodechar($c);
	}

	$out .= ('0' x $factor) . &encodechar('*');

	return $out;
};

my $image = '';
sub errorexit
{
  print $q->header, $q->start_html;
        print @_;
	  print $q->start_form(-method=>'GET');
	    print $q->textfield('text','',16,16);
	      print $q->end_html;
	        exit(0);
		};

my $query = $q->param('text');
(defined($query) and length($query))
 or errorexit('Please enter the text to encode.');

my $scanline = &encode($query);

my $lines = ceil(((1/$unit)*$height)*$factor);
my $gap = ceil(((1/$unit)*$quiet*$factor));

my $th = $lines;
my $tw = length($scanline) + $gap + $gap;

my $i;

# -------------------------------------------

$image .= 'P1';

$image .= '# NB. minimum width: ' . $tw * $unit / $factor . '"   minimum height: ' . $th * $unit / $factor. '"' . "\n";
$image .= $tw . ' ' . $th . "\n";

$i = 0;

$i = 0;
while($i++ < $lines)
{
  $image .= '0' x $gap;
	$image .= $scanline;
  $image .= '0' x $gap;
	$image .= "\n";
}


my $try = 0;
while(!mkdir('/tmp/code39'))
{
  if($try++ > 10)
    {
        errorexit("Can't get lock on /tmp/code39.");
	  };
	    sleep 1;
	    }
use FileHandle;
my $fh = new FileHandle;
$fh->open('> /tmp/code39/code39');
print $fh $image;
$fh->close();
`pnmtopng /tmp/code39/code39 > /tmp/code39/code39.png`;
my @stats = stat '/tmp/code39/code39.png';
print $q->header(-type=>'image/png', "Content-Length"=>($stats[7]));
print `cat /tmp/code39/code39.png`;
unlink '/tmp/code39/code39.png';
unlink '/tmp/code39/code39';
rmdir '/tmp/code39';