version 1.1, 2001/08/15 13:56:40
|
version 1.11, 2003/02/03 18:03:52
|
Line 1
|
Line 1
|
#!/usr/bin/perl |
#!/usr/bin/perl |
|
|
# The LearningOnline Network with CAPA |
# The LearningOnline Network with CAPA |
# Scott Harrison |
# barcode.png - A CGI script that dynamically outputs a barcode. |
|
# |
|
# $Id$ |
|
# |
|
# Copyright Michigan State University Board of Trustees |
|
# |
|
# This file is part of the LearningOnline Network with CAPA (LON-CAPA). |
|
# |
|
# LON-CAPA is free software; you can redistribute it and/or modify |
|
# it under the terms of the GNU General Public License as published by |
|
# the Free Software Foundation; either version 2 of the License, or |
|
# (at your option) any later version. |
|
# |
|
# LON-CAPA is distributed in the hope that it will be useful, |
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
# GNU General Public License for more details. |
|
# |
|
# You should have received a copy of the GNU General Public License |
|
# along with LON-CAPA; if not, write to the Free Software |
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
|
# |
|
# /home/httpd/html/adm/gpl.txt |
|
# |
|
# http://www.lon-capa.org/ |
|
# |
# YEAR=2001 |
# YEAR=2001 |
# 8/15 |
# 8/15,9/28,12/11 |
|
# |
# A CGI script that dynamically outputs a barcode. |
### |
|
|
# I'm using format=Code39. |
# I'm using format=Code39. |
# The valid formats are |
# The valid formats are |
# EAN13, EAN8, UPCA, UPCE, NW7, Code39, |
# EAN13, EAN8, UPCA, UPCE, NW7, Code39, |
# ITF, IATA2of5, Matrix2of5, and COOP2of5. |
# ITF, IATA2of5, Matrix2of5, and COOP2of5. |
|
|
|
# Example usage: /cgi-bin/barcode.gif?encode=12345*31*MSUL1 |
|
|
use strict; |
use strict; |
use GD::Barcode::Code39; |
use GD::Barcode::Code39; |
|
|
map { |
$|=1; # Autoflush after each print/write |
|
foreach (split(/&/,$ENV{'QUERY_STRING'})) { |
my ($name, $value) = split(/=/,$_); |
my ($name, $value) = split(/=/,$_); |
$value =~ tr/+/ /; |
$value =~ tr/+/ /; |
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
if ($name eq 'encode') { |
if ($name eq 'encode') { |
$ENV{'form.'.$name}=$value; |
$ENV{'form.'.$name}=$value; |
} |
} |
} (split(/&/,$ENV{'QUERY_STRING'})); |
} |
|
|
# Tell the server we are sending a gif graphic |
# Tell the server we are sending a png graphic |
print <<END; |
print <<END; |
Content-type: image/gif |
Content-type: image/png |
|
|
END |
END |
|
|
my $oGdBar=GD::Barcode::Code39->new($ENV{'form.encode'}); |
unless(defined($ENV{'form.encode'}) and length($ENV{'form.encode'})) { |
warn($GD::Barcode::errStr); |
$ENV{'form.encode'}='***ERROR***UNDEFINED***'; |
|
} |
|
my $text = '*'.uc($ENV{'form.encode'}).'*'; |
|
my $oGdBar=GD::Barcode::Code39->new($text); |
|
if ($GD::Barcode::errStr or !defined($oGdBar)) { |
|
warn($GD::Barcode::errStr); |
|
$oGdBar=GD::Barcode::Code39->new('***ERROR***INVALID***'); |
|
} |
my $bindata=$oGdBar->plot->png; # create barcode image |
my $bindata=$oGdBar->plot->png; # create barcode image |
undef $oGdBar; |
undef $oGdBar; |
binmode(STDOUT); |
binmode(STDOUT); |
open OUT,"|pngtopnm|ppmtogif"; # convert into a gif image |
#open OUT,"|pngtopnm|ppmtogif 2>/dev/null"; # convert into gif image |
print OUT $bindata; # output image |
#print OUT $bindata; # output image |
$|=1; # be sure to flush before closing |
#$|=1; # be sure to flush before closing |
close OUT; |
#close OUT; |
|
print $bindata; |