Grafiken "on the fly" mit Perl

Im nachfolgenden Fenster sehen Sie den Sourcecode dieses Beispiels:

#!/usr/bin/perl
#
# created by Marlen Bredehoeft
#            TUHH - Rechenzentrum
#            26-07-2000
#

$URL1="http://" . $ENV{'HTTP_HOST'} . $ENV{'SCRIPT_NAME'};
$URL2="https://" . $ENV{'HTTP_HOST'} . $ENV{'SCRIPT_NAME'};

if ($ENV{'HTTP_REFERER'} ne $URL1 &&  $ENV{'HTTP_REFERER'} ne $URL2 )

{ ############ HTML-Seite ausgeben #######################

use CGI qw/:standard/;
use CGI::Carp qw/fatalsToBrowser/;
$CGI::DISABLE_UPLOADS = 1;           # disable uploads
$CGI::POST_MAX=1024*500;             # max 0.5 MB

print "Content-type: text/html\n\n";

print "<html><body><br><h1>Grafiken \"on the fly\" mit Perl </h1><hr>";

###
###  Tabelle mit 4 bunten Rechtecken erzeugen und ausgeben
###  Die URL der Rechtecke ist dieses Perl-Script.
###  Die Rechteck-Parameter werden der URL angehaengt (GET request method)
###
print "\n<p><table border=\"0\" cellpadding=\"0\" cellspacing=\"0\"><tr>",
      "\n<td width=\"0\" height=\"160\" align=\"center\" valign=\"middle\">",
      "\n<img src=\"".$ENV{'SCRIPT_NAME'}."?x=100&y=100&r=255&g=0&b=0\" border=\"1\"> <br>",
      "\n</td>";
print  "\n<td width=\"0\" align=\"center\" valign=\"middle\">",
       "<img src=\"".$ENV{'SCRIPT_NAME'}."?x=100&y=40&r=0&g=255&b=0\" border=\"1\"> <br>",
      "\n</td>";
print  "\n<td width=\"0\" align=\"left\" valign=\"top\">",
       "<img src=\"".$ENV{'SCRIPT_NAME'}."?x=40&y=80&r=0&g=255&b=255\" border=\"1\"> <br>",
      "\n</td>";
print  "\n<td width=\"0\" align=\"center\" valign=\"bottom\">",
       "<img src=\"".$ENV{'SCRIPT_NAME'}."?x=80&y=80&r=0&g=0&b=255\" border=\"1\"> <br>",
       "\n</td></tr></table>\n";

print "<p><hr>";
print "\n<p>Im nachfolgenden Fenster sehen Sie den Sourcecode dieses",
      " Beispiels: <p>";

print "\n<form>",            
      "\n<textarea name=\"sourceCode\" ",
      "\n          rows=\"30\" ",
      "\n          cols=\"100\" >",
      "\n"; 
###
###  Quelltext wird eingelesen und ins Textfeld ausgegeben
###
      open(FILE, $ENV{'SCRIPT_FILENAME'});
      while(defined($zeile = <FILE>)) { print $zeile }
      close(FILE);

print "\n </text" . "area>", # die merkwuerdige Schreibweise ist
                             # notwendig, da sonst der Browser das 
                             # Ende der Textarea  bereits bei Ausgabe 
                             # dieses Sourcecodes an dieser Stelle 
                             # vermutet.
      "\n </form>",
      "<p>";
###
###  Link to go back
###
print "<hr><a href=\"$ENV{'HTTP_REFERER'}\">go back</a>";
print "</body></html>";

} ############ Ausgabe der HTML-Seite beendet #######################

else { ############ Graphik erzeugen und ausgeben ###################

use CGI qw/:standard/;
use GD;

print "Content-type: image/png\n\n";
###
###  Aufruf-Parameter zuweisen
###
$x = param('x');     
$y = param('y'); 
$r = param('r'); 
$g = param('g'); 
$b = param('b'); 
###
###  Unterprogramm aufrufen
###
&draw_rect($x,$y,$r,$g,$b);   # Graphik-Unterprogramm aufrufen

} ############ Graphik erzeugt und ausgegeben beendet #################
#
################################################################
# Unterprogramm draw_rect zum Zeichnen der gefuellten Rechtecke
#
# Aufruf &draw_rect($x,$y,$r,$g,$b);
# 
#         x: Rechteckbreite
#         y: Rechteckhoehe
#         r: Rotwert fuer Rechteckfarbe (0 ,+ r <= 255)
#         g: Gruenwert fuer Rechteckfarbe (0 ,+ r <= 255)
#         b: Blauwert fuer Rechteckfarbe (0 ,+ r <= 255)
# 
################################################################
sub draw_rect {

$width=$_[0];
$height=$_[1];

# create a new image
    $image = new GD::Image($width,$height);
# allocate some colors
    $color = $image->colorAllocate($_[2],$_[3],$_[4]);
# Draw a blue oval
    $image->filledRectangle(0,0,$width,$height,$color);
# make sure we are writing to a binary stream
    binmode STDOUT;
# Convert the image to PNG and print it on standard output
    print $image->png;
#
}

go back