#!/usr/bin/perl -Tw use strict; $|++; use CGI ":all"; if (length (my $info = path_info())) { # I am the image my $error = eval { # begin Error Block unless ($info =~ m{\A/(\d+)\.\d+\.png\z} and $1 <= time and $1 >= time - 60) { # no bookmarking! print header(-status => '404 Not Found'); exit 0; } require GD::Barcode; if (my $bc = GD::Barcode->new(param('bartype') =~ /\A(\w+)\z/, # untaint scalar param('text'))) { ## good barcode, go for plot my %parms; for (qw(Height NoText)) { $parms{$_} = $1 if defined param("p_$_") and param("p_$_") =~ /\A(\d+)\z/; } print header('image/png'), $bc->plot(%parms)->png; exit 0; } $GD::Barcode::errStr; } || $@; # end Error Block ## make up an image from the error message require GD; ## fix $error here to contain clean chars? my $font = GD::gdLargeFont(); my $image = GD::Image->new($font->width * length $error, $font->height); my $background = $image->colorAllocate(127,127,127); $image->transparent($background); my $red = $image->colorAllocate(255,0,0); $image->string($font, 0, 0, $error, $red); print header('image/png'), $image->png; exit 0; } ## I am the form print header, start_html("Bar Code sampler"), h1("Bar Code sampler"); ## inline image reference if this is a response if (param) { my $url = url()."/".time.".$$.png?".query_string(); print a({href => $url}, img({src => $url})); } ## form print hr, startform, table({border => 0, cellspacing => 0, cellpadding => 2}, Tr(td("text"), td(textfield("text", "01234567890"))), Tr(td("barcode type"), td(radio_group(-name => 'bartype', -values => [qw(COOP2of5 Code39 EAN13 EAN8 IATA2of5 ITF Industrial2of5 Matrix2of5 NW7 UPCA UPCE)], -default => 'UPCA', -rows => 3))), Tr(td("height in pixels", br, "(leave blank to default)"), td(textfield("p_Height"))), Tr(td("suppress text (1 = true)"), td(radio_group("p_NoText", [qw(0 1)])))), submit, endform, hr, end_html;