#!/usr/bin/perl
#-*-PERL-*-
use strict;
use warnings;
use Image::Magick;
use Apache;

my $image_dir    = '/tmp/hostname_images';
my $replace      = 0;
my $image_type   = 'gif';
my $c_foreground = 'black';
my $c_background = 'darkgrey';

my $r = Apache->request();
$r->content_type( "image/$image_type" );

my $remote_host = $r->get_remote_host || $r->connection()->remote_ip()
+;

my $image = new Image::Magick( );
# We have to create a blank image to work with for Image::Magick::Quer
+yFontMetrics() to work
$image->Read('xc:white');

my %text = (
        text      => $remote_host,
        pointsize => 24,
#        font      => 'Times',
        gravity   => 'Center',
        fill      => $c_foreground,
        antialias => 'true',
       );

my @data = $image->QueryFontMetrics( %text );
my ($x_ppem, $y_ppem, $ascender, $descender, $width, $height, $max_adv
+ance) = @data;

@$image = ();
$image->Set( size => "${width}x${height}" );
$image->Read( "xc:${c_background}" );
$image->Annotate( %text );
$image->Transparent( $c_background );

unless ( -d $image_dir ) {
    mkdir $image_dir or die "failed creating $image_dir: $!";
}

my $filename = "$image_dir/$remote_host.$image_type";

unlink( $filename ) if $replace;
unless ( -f $filename ) {
    $image->Write( $filename );
}

open( my $file, $filename )
  or die "failed opening $filename for reading: $!";

$r->send_http_header;
local $/ = undef;
$r->print( <$file> );

sub die {
    $r->content_type( 'text/html' );
    $r->print( join( "<br>\n", "error:", @_ ) );
    exit;
}
[download]