#!/usr/bin/perl use CGI; use HTTP::Date; require '/home/spatula/lib/barcode.pl'; @types = qw(upc postnet code39 i25 codabar letter c25 code128 code16k ams); CGI::ReadParse(*cgi); $code=$cgi{'code'}; $type=$cgi{'type'}; if ($ENV{HTTP_REFERER} && $ENV{HTTP_REFERER} !~ /^http:\/\/www\.spatula\.net\//) { print "Location: http://www.spatula.net/proc/barcode/index.src\n\n"; exit; } chop($date=`date`); open (LOG,">>/home/spatula/tmp/barcode.log"); $host = $ENV{REMOTE_HOST} || $ENV{REMOTE_ADDR}; print LOG "$type $date $host $ENV{'HTTP_USER_AGENT'} $ENV{'HTTP_REFERER'} $code\n"; close LOG; if (!$code) { print <Barcode Error You did not enter a code END ; exit ; } if (!grep(/^$type$/,@types)) { print <Barcode Error Internal error END ; exit; } $image=&$type; if ($image) { print "Cache-control: no-cache\n"; print "Last-modified: ".time2str(time())."\n"; print "Expires: ".time2str(time()+1)."\n"; print "Pragma: no-cache\n"; print "Content-type: image/png\n\n"; binmode(STDOUT); print $image->png(); } else { print "Content-type: text/html\n\n"; print "Error: $bc'error $@\n" } exit; sub upc { $upccode=$code; if ($upccode !~ /^\d+$/) { print "Content-type: text/html\n\n"; print "\n\nBad code!\n\n"; print "\nThe barcode you entered ($upccode) is not valid.\n"; print "UPC codes contain digits only."; exit; } $upccode =~s/\D//g; $len=length($upccode); if (!grep(/$len/,(7,8,11,12))) { print "Content-type: text/html\n\n"; print "\n\nBad code!\n\n"; print "\nThe barcode you entered ($upccode) is not valid.\n"; print "
You\n"; print "must enter 7, 8, 11 or 12 digits of the barcode\n"; print "\n\n"; exit; } return(bc'upc($code)); } sub postnet { $zip=$code; $oldzip=$zip; if ($code !~ /^\d+$/) { print "Content-type: text/html\n\n"; print "\n\nBad code!\n\n"; print "\nThe barcode you entered ($upccode) is not valid.\n"; print "Postnet codes contain digits only (leave out hyphens and spaces)"; exit; } $zip =~s/\D//g; if ((length($zip)>11) || (length($zip)<5)) { print "Content-type: text/html\n\n"; print "\n\nBad zip code\n\n"; print "\nThe zip code you entered is not valid\n\n"; print "You must first enter a zip code." if $zip eq ''; print "\n"; exit(0); } return(bc'Postnet($code)); } sub letter { $zip=$code; $oldzip=$zip; $zip =~s/\D//g; $address=$cgi{'address'}; $return=$cgi{'return'}; if ($code !~ /^\d+$/) { print "Content-type: text/html\n\n"; print "\n\nBad code!\n\n"; print "\nThe barcode you entered ($upccode) is not valid.\n"; print "Postnet codes contain digits only (leave out hyphens and spaces)"; exit; } if ((length($zip)>11) || (length($zip)<5)) { print "Content-type: text/html\n\n"; print "\n\nBad zip code\n\n"; print "\nThe zip code you entered is not valid\n\n"; print "You must first enter a zip code." if $zip eq ''; print "\n"; exit(0); } if ((!$address) || (!$return)) { print "Content-type: text/html\n\n"; print "\n\nMissing address\n\n"; print "You must enter an address and a return address.\n"; print "\n"; exit(0); } if ((length($address)>96) || (length($return)>255)) { print "Content-type: text/html\n\n"; print "\n\nAddress too long\n\n"; print "Address too long."; print "\n"; exit(0); } return(bc'Letter($cgi{'return'},$cgi{'address'},$code)); } sub code39 { $string=$code; $docs=$cgi{'docs'}; $nrml=$cgi{'normal'}; bc'code39_init(); if (($string eq '') || (length($string)>30)) { print "Content-type: text/html\n\n"; print "bad input"; print "The string you supplied ($string) is not valid"; print "You must first enter a string\n" if $string eq ''; print ""; exit; } return(bc'code39($string,$docs,$nrml=='yes')); } sub i25 { if ($code !~ /^\d+$/) { print "Content-type: text/html\n\n"; print "\n\nBad code!\n\n"; print "\nThe barcode you entered ($upccode) is not valid.\n"; print "Interleaved 2 of 5 codes contain digits only."; exit; } $code =~ s/\D//g; if (($code eq '') || (length($code)>30)) { print "Content-type: text/html\n\n"; print "bad input"; print "The string you supplied ($code) is not valid"; print "You must first enter a string\n" if $code eq ''; print ""; exit; } return(bc'i25($code)); } sub codabar { $code =~ tr/a-d/A-D/; if ($code !~ /^[\d\-\$\:\/\.\+ABCD]+$/ || $code =~ /^.+[ABCD].+$/) { print "Content-type: text/html\n\n"; print "bad input"; print "The string you supplied ($code) is not valid\n"; print "The following characters are valid: [0-9-$:/.+ABCD].\n"; print "A,B,C,D may only be used as start/stop characters.\n"; exit; } if ($code eq '' || length($code)>30) { print "Content-type: text/html\n\n"; print "bad input"; print "The string you supplied ($code) is not valid"; print "You must first enter a string\n" if $code eq ''; print ""; exit; } return(bc'codabar($code)); } sub c25 { if ($code !~ /^\d+$/) { print "Content-type: text/html\n\n"; print "bad input"; print "The string you supplied ($code) is not valid\n"; print "The following characters are valid: [0-9]\n"; exit; } if ($code eq '' || length($code)>30) { print "Content-type: text/html\n\n"; print "bad input"; print "The string you supplied ($code) is not valid"; print "You must first enter a string\n" if $code eq ''; print ""; exit; } return(bc'code25($code)); } sub code128 { $string=$code; bc'code128_init(); if (($string eq '') || (length($string)>30)) { print "Content-type: text/html\n\n"; print "bad input"; print "The string you supplied ($string) is not valid"; print "You must first enter a string\n" if $string eq ''; print ""; exit; } return(bc'code128($string)); } sub code16k { $string=$code; bc'code16k_init(); if (($string eq '') || (length($string)>77)) { print "Content-type: text/html\n\n"; print "bad input"; print "The string you supplied ($string) is not valid"; print "You must first enter a string\n" if $string eq ''; print ""; exit; } return(bc'code16k($string)); } sub ams { if (length($code)!=13) { print "Content-type: text/html\n\n"; print "bad code"; print "The code must be exactly 13 digits.\n"; exit; } return (bc'ams($code)); }