Inexistence has asked for the wisdom of the Perl Monks concerning the following question:

(SOLVED by Anonymous Monk)

Hello Perl Monks,

After hours of googling again, testing and trying everything I could find reference to, nothing has worked

This is the closest to functional code I can figure out, but it only shows partial images if they're >10k etc. I don't know the exact point where the error happens, but I believe it is do to gzip compression atm. How do I fix this? or a better method would equally be welcomed

Thank-you 

#!\usr\bin\perl.exe
use strict;
my $defaultDir=$ENV{'DOCUMENT_ROOT'};
my $fName = $defaultDir."/comingsoon.gif"; ##Example only @_[0]
$fName =~ tr/+/ /;
$fName =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$fName =~ s/<!--(.|\n)*-->//g;
my ($ext) = $fName =~ /\.([^.]+)$/; 
my ($ext) = $fName =~ /\.([^.]+)$/; 

if(-e $fName and ($ext eq "jpg"||"gif"||"bmp")) {
    my $length = (stat($fName)) [10];
    print "Content-type: image/$ext\n\n";
    binmode STDOUT;
    open (picfile,'<', $fName) || die "Could not open $fName: $!";
    my $buffer = "";
    while (read(picfile, $buffer, 10240)) { 
         print $buffer;
    }
    close(picfile);
}
exit;

[download]

PS: The reason i'm serving up images in this manner is so I can monitor WHO is using them and to count the usage. In the future, it will be used to block usage depending on account privilages etc

There isn't in existence

Replies are listed 'Best First'.
Re: Gzip compression issue?
by Anonymous Monk on Dec 25, 2011 at 02:33 UTC

    binmode

    You binmode STDOUT but not picfile

[reply]
      OMG!!! Thank-you thank-you :) I never saw an example using that idea, it just makes sense to do so
      There isn't in existence
[reply]

        I'm not finished :D

        the eq and || opearators don't chain like that

        here is how I might write this 

        #!/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_suffi
+x; }
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 b
+mp 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;
}

        [download]

        See perlintro, perlop

        See also http://learn.perl.org/books/beginning-perl/ and the Modern Perl Book

[reply]
[d/l]

Back to Seekers of Perl Wisdom