Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

On-demand single-pixel GIFs

by dws (Chancellor)
on Aug 19, 2001 at 10:17 UTC ( #105985=sourcecode: print w/replies, xml ) Need Help??
Category: Web Stuff
Author/Contact Info dws
Description: A short CGI script for generating a single pixel GIF of a desired color. Useful, for example, when generating HTML that embeds color-coded, image-based bar charts. Ordinarily, using color in this way requires existing GIFs for all colors used. This script removes the need to make all of those GIFs by hand, allowing one to experiment freely.
#!/usr/bin/perl

# pixel.cgi -- Generate a single-pixel GIF of a given color.
#
# Usage:
#  <img src="pixel.cgi/CC9966.gif" width=25 height=25>
#
# Dave W. Smith <dws@davewsmith.com>

my($rgb) = $ENV{PATH_INFO} =~ m|/([0-9A-Za-z]{6})(?:\.gif)?$|i;
$rgb ||= '888888';

my $gif = pack("H*",
               '47494638396101000100B30000' . $rgb .
               'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' .
               'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' .
               'FFFFFFFFFFFFFFFFFFFFFFFFFF2C0000' .
               '0000010001000004021044003B'
              );

binmode(STDOUT);
print "Content-type: image/gif\r\n";
print "Content-length: ", length($gif), "\r\n";
print "\r\n";
print $gif;
Replies are listed 'Best First'.
Re: On-demand single-pixel GIFs
by giulienk (Curate) on Feb 18, 2002 at 09:59 UTC
    I worked out a slighlty modified version of the great and really useful code above. I added support for 3 hex colors and changed default behavior to exit if no $rgb is matched.
    use strict; my($rgb) = $ENV{PATH_INFO} =~ m|/([0-9A-F]+)(?:\.gif)?$|i; grep {length $rgb == $_} (3, 6) || exit; $rgb = join '', map { $_ x 2 } $rgb =~ /./g if length( $rgb ) == 3; my $gif = pack("H*", '47494638396101000100B30000' . $rgb . 'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' . 'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' . 'FFFFFFFFFFFFFFFFFFFFFFFFFF2C0000' . '0000010001000004021044003B' ); binmode(STDOUT); print "Content-type: image/gif\r\n"; print "Content-length: ", length($gif), "\r\n"; print "\r\n"; print $gif;
    $|=$_='1g2i1u1l2i4e2n0k',map{print"\7",chop;select$,,$,,$,,$_/7}m{..}g
      Here's another take on the same idea.
      I often find myself wanting to output
      temporary color spacer gif's for html design
      and layout purposes.
      Adjust the width, height and color of
      a gif file and output without an image module (ie ImageMagick, GD).
      #!/usr/bin/perl -w # this script outputs a gif # set color, width, and height use strict; &printGIF("0000FF","33","10"); ###################################### sub printGIF{ my $color = $_[0]; my $WH = sprintf("%lX",$_[1]); my $HH = sprintf("%lX",$_[2]); $color =~ s/(..)(..)(..)/$1\|$2\|$3/; my($RH,$GH,$BH)=split(/\|/,$color); print STDOUT "Content-type:image/gif\n\n"; my @gif=( "47", "49", "46", "38", "37", "61", "$WH", "00", "$HH", "00", "A1", "01", "00", "$RH", "$GH", "$BH", "FF", "FF", "FF", "00", "00", "00", "00", "00", "00", "21", "F9", "04", "05", "00", "00", "01", "00", "2C", "00", "00", "00", "00", "$WH", "00", "$HH", "00", "40", "02", "$HH", "84", "8F", "A9", "CB", "ED", "0F", "A3", "9C", "B4", "DA", "8B", "B3", "DE", "9C", "17", "00", "3B" ); binmode (STDOUT); # if needed foreach my $bit(@gif){ my $bita = hex($bit); $bita = pack("C",$bita); print STDOUT $bita; } }#################################### end printGIF
      jtrue
Re: On-demand single-pixel GIFs
by belg4mit (Prior) on May 12, 2002 at 06:29 UTC
    Wouldn't $gif be fixed length? (77 to be exact)

    --
    perl -pew "s/\b;([mnst])/'$1/g"

Re: On-demand single-pixel GIFs
by Anonymous Monk on Aug 20, 2014 at 23:29 UTC
    Bombarded by these files in FireFox for Linux. But not always.
Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://105985]
help
Chatterbox?
[Corion]: ambrus: I think there was some discussion and maybe even an entry in Tidings, but I'm not really sure
[marto]: Back later, got to get the kids ready
[ambrus]: Also, I still have the suspicion that Perlmonks as a website is still horribly insecure, and that a malicious attacker could take over anyone's account easily, and I should tell the details of why I think this in some Cabal-only place.
[Corion]: But the site now is on https (only), and now also with one unified SSL certificate for all PM hoss
[ambrus]: This worries me a lot especially because as a cbstream maintainer, if this happens, I could get falsely blamed for any insecurity.
[ambrus]: Cbstream itself is also insecure because I abandonned it for too long, and it's really ripe for a full rewrite or something now.
[ambrus]: But that's a totally different issue.

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (3)
As of 2018-07-19 08:08 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    It has been suggested to rename Perl 6 in order to boost its marketing potential. Which name would you prefer?















    Results (404 votes). Check out past polls.

    Notices?