Deborah Ward wrote:
>
> The following program (modified from CGI Programming with
> Perl by S. Guelich et al) displays random .gif's from a
> directory holding only ..gif's. All 10 of the images make an
> appearance, but about a qtr. of the time I get an empty box.
> I've tried different buffer sizes. Any ideas what else I can try?
>
> *****
>
> #!/usr/local/bin/perl -w
>
> use strict;
> use CGI;
>
> use constant BUFFER_SIZE => 4_096;
> use constant IMAGE_DIR => "images";
>
> my $q = new CGI;
> my $buffer = "";
>
> my $image = random_file(IMAGE_DIR, '\\.gif$' );
>
> print $q->header(-type=>"image/gif");
> binmode STDOUT;
>
> local *IMAGE;
> open IMAGE, IMAGE_DIR . "/$image" or die "Can't open file $image: $!";
You probably should have binmode here as well.
> while ( read( IMAGE, $buffer, BUFFER_SIZE)) {
> print $buffer;
> }
> close IMAGE;
>
> sub random_file {
> my ($dir, $mask) = @_;
> my $i = 0;
> my $file;
> local (*DIR, $_);
>
> opendir DIR, $dir or die "Can't open directory $dir: $!";
> while (defined ($_ = readdir DIR)) {
> /$mask/o if defined $mask;
This doesn't do anything useful. You probably want something like:
next unless defined($mask) and /$mask/;
Otherwise you are not filtering out files that do not match your regex.
> rand ++$i < 1 and $file = $_;
The expression "rand ++$i < 1" is always true for the first entry, and
true for subsequent entries with rapidly reducing probablilty, which
combined with the above problem probably means that the filename "."
(usually being the first entry in a directory) is returned fairly
regularly.
You might want to add "use CGI::Carp qw(fatalsToBrowser);" at the start
of your script to help with debugging.
> }
> closedir DIR;
> return $file;
> }
HTH
--
Brian Raven
-----------------------------------------------------------------------
The information contained in this e-mail is confidential and solely
for the intended addressee(s). Unauthorised reproduction, disclosure,
modification, and/or distribution of this email may be unlawful. If you
have received this email in error, please notify the sender immediately
and delete it from your system. The views expressed in this message
do not necessarily reflect those of LIFFE Holdings Plc or any of its subsidiary
companies.
-----------------------------------------------------------------------
_______________________________________________
ActivePerl mailing list
[EMAIL PROTECTED]
To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
