#! /usr/bin/perl -w
use strict;
# in inches
my $unit = 0.01; # width of smallest element
my $height = 0.6; # height of readable area
my $quiet = 0.25; # white area around barcode
my $factor = 5; # pixels per element
# ---------
use POSIX;
use CGI;
my $q = new CGI;
defined( $q->param('factor') ) and ($q->param('factor') =~ /^([1-9])/) and $factor = $1;
if( defined( $q->param('q') ) )
{
$factor=1;
$height = 0.18;
$quiet = 0.1;
};
my $image = '';
my $err = '';
sub hyphenate
{
my ($isbn) = @_;
# source: http://usin.org/software/servers/ISBN-ISSN.phps
my @country_group_partition = ( 0, 80, 950, 9960, 99900 );
my %country_group_map = (
0 => [ '00',200,7000,85000,900000,9500000 ],
1 => [ '00000000',55000,869800,9999900 ],
2 => [ '00',200,40000000,500,7000,84000,900000,9500000 ],
3 => [ '00',200,7000,85000,900000,9500000 ],
4 => ['00',200,7000,85000,900000,9500000],
5 => ['00',200,7000,85000,900000,9500000],
7 => ['00',100,5000,80000,900000],
80 => ['00',200,7000,85000,900000],
81 => ['00',200,7000,85000,900000],
82 => ['00',200,7000,90000,990000],
83 => ['00',200,7000,85000,900000],
84 => ['00',200,7000,85000,900000,95000,9700],
85 => ['00',200,7000,85000,900000],
86 => ['00',300,7000,80000,900000],
87 => ['00',400,7000,85000,970000],
88 => ['00',200,7000,85000,900000],
89 => ['00',300,7000,85000,950000],
90 => ['00',200,5000,70000,800000,9000000],
91 => ['0',20,500,6500000,7000,8000000,85000,9500000,970000],
92 => ['0',60,800,9000],
93 => ['0000000'],
950 => ['00',500,9000,99000],
951 => ['0',20,550,8900,95000],
952 => ['00',200,5000,89,9500,99000],
953 => ['0',10,150,6000,96000],
954 => ['00',400,8000,90000],
955 => ['0',20,550,800000,9000,95000],
956 => ['00',200,7000],
957 => ['00',440,8500,97000],
958 => ['0',600,9000,95000],
959 => ['00',200,7000],
960 => ['00',200,7000,85000],
961 => ['00',200,6000,90000],
962 => ['00',200,7000,85000],
963 => ['00',200,7000,85000],
964 => ['00',300,5500,90000],
965 => ['00',200,7000,90000],
966 => ['00',500,7000,90000],
967 => ['0',60,900,9900,99900],
968 => ['000000',10,400,500000,6000,800,900000],
969 => ['0',20,400,8000],
970 => ['00',600,9000,91000],
971 => ['00',500,8500,91000],
972 => ['0',20,550,8000,95000],
973 => ['0',20,550,9000,95000],
974 => ['00',200,7000,85000,900000],
975 => ['00',300,6000,92000,980000],
976 => ['0',40,600,8000,95000],
977 => ['00',200,5000,70000],
978 => ['000',2000,30000],
979 => ['0',20,300000,400,700000,8000,95000],
980 => ['00',200,6000],
981 => ['00',200,3000],
982 => ['00',100,500000],
983 => ['000',2000,300000,50,800,9000,99000],
984 => ['00',400,8000,90000],
985 => ['00',400,6000,90000],
986 => ['000000'],
987 => ['00',500,9000,99000],
9952 => ['00000'],
9953 => ['0',20,9000],
9954 => ['00',8000],
9955 => ['00',400],
9956 => ['00000'],
9957 => ['00',8000],
9958 => ['0',10,500,7000,9000],
9959 => ['00'],
9960 => ['00',600,9000],
9961 => ['0',50,800,9500],
9962 => ['00000'],
9963 => ['0',30,550,7500],
9964 => ['0',70,950],
9965 => ['00',400,9000],
9966 => ['00',70000,800,9600],
9967 => ['00000'],
9968 => ['0',10,700,9700],
9970 => ['00',400,9000],
9971 => ['0',60,900,9900],
9972 => ['0',40,600,9000],
9973 => ['0',10,700,9700],
9974 => ['0',30,550,7500],
9975 => ['0',50,900,9500],
9976 => ['0',60,900,99000,9990],
9977 => ['00',900,9900],
9978 => ['00',950,9900],
9979 => ['0',50,800,9000],
9980 => ['0',40,900,9900],
9981 => ['0',20,800,9500],
9982 => ['00',40000,800,9900],
9983 => ['00',500,80,950,9900],
9984 => ['00',500,9000],
9985 => ['0',50,800,9000],
9986 => ['00',400,9000],
9987 => ['00',400,8800],
9988 => ['0',30,550,7500],
9989 => ['0',30,600,9700],
99901 => ['00'],
99903 => ['0',20,900],
99904 => ['0',60,900],
99905 => ['0',60,900],
99906 => ['0',60,900],
99908 => ['0',10,900],
99909 => ['0',40,950],
99910 => ['0000'],
99911 => ['00',600],
99912 => ['0',60,900],
99913 => ['0',30,600],
99914 => ['0',50,900],
99915 => ['0',50,800],
99916 => ['0',30,700],
99917 => ['0',30],
99918 => ['0',40,900],
99919 => ['0',40,900],
99920 => ['0',50,900],
99921 => ['0',20,700],
99922 => ['0',50],
99923 => ['0',20,800],
99924 => ['0',30],
99925 => ['0',40,800],
99926 => ['0000',600],
99927 => ['0',30,600],
99928 => ['0',50,800],
99929 => ['0000'],
99930 => ['0',50,800],
99931 => ['0000'],
99932 => ['0',10],
99933 => ['00',300],
99934 => ['0'],
99935 => ['0000'],
99936 => ['0000'],
99937 => ['0',20]
);
# determine country group
my $group = substr($isbn, 0, length($country_group_partition[0]));
{
my $ngroup = 1;
while( defined($country_group_partition[$ngroup]) and ( ( $country_group_partition[$ngroup] cmp substr($isbn, 0, length($country_group_partition[$ngroup])) ) < 0 ) )
{
$group = substr($isbn, 0, length($country_group_partition[$ngroup]));
$ngroup++;
}
}
# determine publisher prefix
my $prefix = substr($isbn, length($group), length($country_group_map{$group}->[0]));
{
my $nprefix = 1;
while( defined($country_group_map{$group}->[$nprefix]) and ( ( $country_group_map{$group}->[$nprefix] cmp substr($isbn, length($group), length($country_group_map{$group}->[$nprefix])) ) < 0 ) )
{
$prefix = substr($isbn, length($group), length($country_group_map{$group}->[$nprefix]));
$nprefix++;
}
}
my $itemstart = length($group) + length($prefix);
my $itemlength = length($isbn) - $itemstart - 1;
return $group . '-' . $prefix . '-' . substr($isbn, $itemstart, $itemlength) . '-' . substr($isbn, $itemstart + $itemlength, 1);
};
sub errorexit
{
print $q->header, $q->start_html;
$err =~ s/\n/
\n/g;
print 'ISBN->barcode
';
print $err;
print @_;
print $q->start_form(-method=>'GET');
print $q->textfield('isbn','1905038003',13,200);
print $q->end_form;
print 'Click here to go to ISBN lookup instead.';
print $q->end_html;
exit(0);
};
my %A =
(
'0' => '0001101',
'1' => '0011001',
'2' => '0010011',
'3' => '0111101',
'4' => '0100011',
'5' => '0110001',
'6' => '0101111',
'7' => '0111011',
'8' => '0110111',
'9' => '0001011'
);
my %B =
(
'0' => '0100111',
'1' => '0110011',
'2' => '0011011',
'3' => '0100001',
'4' => '0011101',
'5' => '0111001',
'6' => '0000101',
'7' => '0010001',
'8' => '0001001',
'9' => '0010111'
);
my %C =
(
'0' => '1110010',
'1' => '1100110',
'2' => '1101100',
'3' => '1000010',
'4' => '1011100',
'5' => '1001110',
'6' => '1010000',
'7' => '1000100',
'8' => '1001000',
'9' => '1110100'
);
my %G =
(
'L' => '101',
'C' => '01010',
'R' => '101'
);
my %tables =
(
'A' => \%A,
'B' => \%B,
'C' => \%C,
'G' => \%G
);
my %ean13 =
(
'0' => 'GAAAAAAGCCCCCCG',
'1' => 'GAABABBGCCCCCCG',
'2' => 'GAABBABGCCCCCCG',
'3' => 'GAABBBAGCCCCCCG',
'4' => 'GABAABBGCCCCCCG',
'5' => 'GABBAABGCCCCCCG',
'6' => 'GABBBAAGCCCCCCG',
'7' => 'GABABABGCCCCCCG',
'8' => 'GABABBAGCCCCCCG',
'9' => 'GABBABAGCCCCCCG'
);
my %font =
(
'height' => 10,
'width' => 7,
'0' => [
'0000000',
'0000000',
'0000000',
'0011100',
'0100010',
'0100010',
'0100010',
'0100010',
'0011100',
'0000000'
],
'1' => [
'0000000',
'0000000',
'0000000',
'0001000',
'0011000',
'0001000',
'0001000',
'0001000',
'0011100',
'0000000'
],
'2' => [
'0000000',
'0000000',
'0000000',
'0011100',
'0100010',
'0000010',
'0001100',
'0010000',
'0111110',
'0000000'
],
'3' => [
'0000000',
'0000000',
'0000000',
'0011100',
'0100010',
'0000100',
'0000100',
'0100010',
'0011100',
'0000000'
],
'4' => [
'0000000',
'0000000',
'0000000',
'0000100',
'0001100',
'0010100',
'0111110',
'0000100',
'0000100',
'0000000'
],
'5' => [
'0000000',
'0000000',
'0000000',
'0111110',
'0100000',
'0111100',
'0000010',
'0000010',
'0111100',
'0000000'
],
'6' => [
'0000000',
'0000000',
'0000000',
'0011110',
'0100000',
'0111100',
'0100010',
'0100010',
'0011100',
'0000000'
],
'7' => [
'0000000',
'0000000',
'0000000',
'0111110',
'0000010',
'0000100',
'0001000',
'0001000',
'0001000',
'0000000'
],
'8' => [
'0000000',
'0000000',
'0000000',
'0011100',
'0100010',
'0011100',
'0100010',
'0100010',
'0011100',
'0000000'
],
'9' => [
'0000000',
'0000000',
'0000000',
'0011100',
'0100010',
'0100010',
'0011110',
'0000010',
'0111100',
'0000000'
],
'I' => [
'0000000',
'0000000',
'0000000',
'0011100',
'0001000',
'0001000',
'0001000',
'0001000',
'0011100',
'0000000'
],
'S' => [
'0000000',
'0000000',
'0000000',
'0011110',
'0100000',
'0011100',
'0000010',
'0000010',
'0111100',
'0000000'
],
'B' => [
'0000000',
'0000000',
'0000000',
'0111100',
'0100010',
'0111100',
'0100010',
'0100010',
'0111100',
'0000000'
],
'N' => [
'0000000',
'0000000',
'0000000',
'0100010',
'0110010',
'0101010',
'0100110',
'0100010',
'0100010',
'0000000'
],
'x' => [
'0000000',
'0000000',
'0000000',
'0100010',
'0010100',
'0001000',
'0001000',
'0010100',
'0100010',
'0000000'
],
'X' => [
'0000000',
'0000000',
'0000000',
'0100010',
'0010100',
'0001000',
'0001000',
'0010100',
'0100010',
'0000000'
],
':' => [
'0000',
'0000',
'0000',
'0000',
'0110',
'0000',
'0000',
'0110',
'0000',
'0000'
],
'-' => [
'00000',
'00000',
'00000',
'00000',
'00000',
'01110',
'00000',
'00000',
'00000',
'00000'
],
' ' => [
'00',
'00',
'00',
'00',
'00',
'00',
'00',
'00',
'00',
'00'
],
'L' => [
'101',
'101',
'101',
'101',
'101',
'101',
'000',
'000',
'000',
'000'
],
'C' => [
'01010',
'01010',
'01010',
'01010',
'01010',
'01010',
'00000',
'00000',
'00000',
'00000'
],
'R' => [
'101',
'101',
'101',
'101',
'101',
'101',
'000',
'000',
'000',
'000'
]
);
sub isbncheckdigit
{
my($string) = @_;
my $weight = 10;
my $sum = 0;
foreach my $digit(split('', $string))
{
$digit =~ /[0-9]/ or errorexit("Not a digit: $digit.\n");
$sum += $digit * $weight;
$weight--;
}
$sum = (11 - ($sum % 11)) % 11;
if ($sum == 10)
{
$sum = 'X';
}
return $sum;
};
sub checkdigit
{
my($string) = @_;
my $weight = 1;
my $sum = 0;
foreach my $digit(split('', $string))
{
$digit =~ /[0-9]/ or errorexit("Not a digit: $digit.\n");
$sum += $digit * $weight;
$weight = 4 - $weight;
}
return (10 - ($sum % 10)) % 10;
};
sub code
{
my($code) = @_;
my $out = '';
defined($code) or return '';
foreach my $char(split('',$code))
{
$out .= $char x $factor;
}
return $out;
}
sub encode
{
my ($string) = @_;
my $out = '';
$string =~ /^(.)(......)(......)$/ or errorexit("EAN13 needs 13 digits!\n");
$string = 'L' . $2 . 'C' . $3 . 'R';
my @encoding = split('', $ean13{$1});
my @digits = split('', $string);
foreach my $digit(@digits)
{
$out .= &code( $tables{shift @encoding}->{$digit} );
}
return $out;
};
if(!defined($q->param('isbn')))
{
errorexit("Please type in a valid ISBN, then hit ENTER.
");
}
# -------------------------------------------
my $isbn = $q->param('isbn');
$err .= "String: $isbn\n";
$isbn =~ s/[^0-9xX]//g;
my $ean = undef;
# missing first digit?
if(length($isbn)==12)
{
if( $isbn =~ /^78/ )
{
$err .= "Prepending '9'.\n";
$isbn = '9' . $isbn;
$err .= "String: $isbn\n";
}
else
{
$err .= "Generating EAN check digit.\n";
$isbn = $isbn . &checkdigit($isbn);
$err .= "String: $isbn\n";
}
}
if( length($isbn) == 9 )
{
# 10-digit ISBN without its checkdigit?
$err .= "Generating ISBN check digit.\n";
$ean = '978'.$isbn . &checkdigit('978'.$isbn);
$isbn = $isbn . &isbncheckdigit($isbn);
$err .= "ISBN: $isbn\n";
}
elsif( length($isbn) == 10 )
{
$isbn =~ /((?:[0-9]){9}?)([0-9xX])/ or errorexit("Please supply a valid ISBN!\n");
my $check = $2;
$ean = $1;
my $expected = &isbncheckdigit($ean);
if( $check ne $expected )
{
errorexit("Invalid check digit: the correct digit for $ean would be $expected, but you typed $isbn. There's probably a typo there.\n");
}
$ean = '978' . $ean . &checkdigit('978' . $ean);
}
elsif( length($isbn) == 13 )
{
if( $isbn =~ /^([0-9]+)([0-9xX])$/)
{
my $i = $1;
my $c = $2;
my $e = &checkdigit($i);
if( uc($c) eq $e )
{
$ean = $isbn;
if( $isbn =~ /^978([0-9]+)([0-9xX])$/)
{
$isbn = $1 . &isbncheckdigit($1);
}
}
else
{
errorexit("Invalid check digit: the correct digit for $i would be $e, but you typed $i $c. There's probably a typo there.\n");
}
}
}
else
{
errorexit("Please supply a valid ISBN!\n");
}
$err .= "ISBN OK.\n";
$err .= "EAN13: $ean\n";
if( $ean =~ /^978/ )
{
$err .= "Will produce human-readable ISBN.\n";
}
else
{
$err .= "Will NOT produce human-readable ISBN.\n";
$isbn = undef;
}
my $scanline = &encode($ean);
my $lines = ceil(((1/$unit)*$height)*$factor);
my $gap = ceil(((1/$unit)*$quiet*$factor));
my $th = $lines + $gap + $gap;
my $tw = length($scanline) + $gap + $gap;
my $i;
# -------------------------------------------
$image .= 'P1';
$image .= '# NB. minimum width: ' . $tw * $unit / $factor . '" minimum height: ' . $th * $unit / $factor. '"' . "\n";
$err .= 'Generating netpbm image. Minimum width: ' . $tw * $unit / $factor . '" minimum height: ' . $th * $unit / $factor . '"' . "\n";
$image .= $tw . ' ' . $th . "\n";
if( $isbn )
{
(length($isbn)==10) or errorexit("ISBN needs 10 digits!\n");
$isbn = 'ISBN ' . hyphenate($isbn);
}
else
{
$isbn = ' ' . (' ' x 10);
}
my @humanreadable = split('', $isbn);
$i = 0;
while( $i++ < $gap )
{
$scanline = '';
my $csr = floor(($i - (($gap - ($font{'height'}*$factor)))) / $factor);
if( ($csr >= 0) && ($csr < $font{'height'}) )
{
foreach my $digit(@humanreadable)
{
$scanline .= &code( $font{$digit}->[$csr] );
}
$scanline = ('0' x floor(($tw - length($scanline)) / 2)) . $scanline;
$scanline .= '0' x ($tw - length($scanline));
}
else
{
$scanline = '0' x $tw;
}
$image .= $scanline;
$image .= "\n";
}
$scanline = &encode($ean);
$i = 0;
while($i++ < $lines)
{
$image .= '0' x $gap;
$image .= $scanline;
$image .= '0' x $gap;
$image .= "\n";
}
$i = 0;
$ean =~ /^(.)(......)(......)$/ or errorexit("EAN13 needs 13 digits!\n");
$ean = $1 . 'L' . $2 . 'C' . $3 . 'R';
@humanreadable = split('', $ean);
while( $i++ < $gap )
{
my $csr = floor($i / $factor);
if( $csr < $font{'height'} )
{
$scanline = '0' x ($gap - ($font{'width'} * $factor));
foreach my $digit(@humanreadable)
{
$scanline .= &code( $font{$digit}->[$csr] );
}
$scanline .= '0' x $gap;
}
else
{
$scanline = '0' x $tw;
}
$image .= $scanline;
$image .= "\n";
}
# ---------------------
my $try = 0;
while((!mkdir('/tmp/isbn')) && ($try++ < 20))
{
# if($try++ > 10)
#{
# errorexit("Can't get lock on /tmp/isbn.");
# assume something crashed
#};
sleep 1;
}
use FileHandle;
my $fh = new FileHandle;
$fh->open('> /tmp/isbn/isbn');
print $fh $image;
$fh->close();
`pnmtopng /tmp/isbn/isbn > /tmp/isbn/isbn.png`;
my @stats = stat '/tmp/isbn/isbn.png';
print $q->header(-type=>'image/png', "Content-Length"=>($stats[7]));
print `cat /tmp/isbn/isbn.png`;
unlink '/tmp/isbn/isbn.png';
unlink '/tmp/isbn/isbn';
rmdir '/tmp/isbn';