#!/usr/bin/perl --
use constant DEBUG => !!( 0 || $ENV{PERL_DEBUG_MYAPPNAME} );
use CGI::Carp qw( fatalsToBrowser );
use CGI;

# to avoid those pesky 500 errors
BEGIN {
    CGI::Carp::set_message(
        sub {
            print "<h1>something broke, we know what it is, thank you, try again later</h1>\n";
            if (DEBUG) {
                print '<p>', CGI->escapeHTML(@_), '</p>';
            }
        }
    );
} ## end BEGIN


use strict;
use warnings;

use File::Copy qw' copy ';
use LWP::MediaTypes qw( guess_media_type );
#~  use MIME::Types 'by_suffix'; BEGIN { *guess_media_type = *by_suffix; }
use CGI ();

Main( @ARGV );
exit( 0 );

sub Main {
    
#~     return DebugCGI(); # generic, env.cgi
    return SpitThisImage();
}

sub Main {
    my $document_root = $ENV{'DOCUMENT_ROOT'};
    $document_root =~ s{/$}{};
    my $file = $document_root."/comingsoon.gif";
    
#~ $ perl -MRegex::PreSuf -le " print presuf( @ARGV ) " jpeg jpg jpe bmp gif png
#~ (?:bmp|gif|jp(?:eg|[eg])|png)
    if( $file =~ /(?:bmp|gif|jp(?:eg|[eg])|png)$/i ){
        my $size = -s $file;
        
        $size or die "No file ($file) : $!" ;
        
        my $type = guess_media_type( $file );
        
        print CGI->header(
            -type => $type,
            -Content_length => $size,
        );
        
        copy( $file, \*STDOUT );
        
    } else {
        die "No image ($file) ";
    }
} ## end sub Main

sub DebugCGI {
    my $cgi = CGI->new;
    print $cgi->header();    # Write HTTP header
    print $cgi->start_html,
      $cgi->b( rand time, ' ', scalar gmtime ),
      '<table border="1" width="%100"><tr><td>',
      $cgi->Dump,
      '</td>',
      '<td><div style="white-space: pre-wrap; overflow: scroll;">',
      $cgi->escapeHTML( DD($cgi) ),
      '</div></td></tr></table>',
      CGI->new( \%ENV )->Dump,
      $cgi->end_html;
} ## end sub DebugCGI

sub DD {
    require Data::Dumper;
    scalar Data::Dumper->new( \@_ )->Indent(1)->Useqq(1)->Dump;
}