Problem mit Videodateiausgabe (wmv) - Server hängt sich auf

[迪拉斯]

Hey,
dein Server hängt, weil dein Programm haufenweise nutzlos Speicher verbrät. Du liest die Datei zeilenweise(!) komplett in den Speicher. Das bedeutet, ein Element in deinem Array kann etliche Megabyte groß sein, bevor das Newlinezeichen am Ende kommt. Das ändert sich auch nicht durch Hinzufügen von binmode.

Wozu brauchst du ein exklusives Filelock auf die Datei, wenn du sie doch nur liest? Möchtest du wirklich jedesmal blockieren und Nachzügler warten lassen, wenn mehrere Leute zufällig dieselbe Datei im gleichen Zeitraum anfordern? Und überhaupt, so wie's jetzt geschrieben ist, ist es weder portabel noch sicher gegen Wettlaufsituationen. So viel kann schiefgehen, wenn man die Rückgabewerte von Systemaufrufen nicht prüft.

Irgendwie riecht dein ganzes Programm nach Cargokultprogrammierung und Stümperei. Ich schreibe es komplett neu.

#!perl -T  
use strict;  
use warnings;  
use CGI qw();  
use Fcntl qw(O_RDONLY O_SHLOCK O_NDELAY);  
  
my $fname = 'video.wmv';  
my $mime = 'video/x-ms-wmv';  
  
my $q = CGI->new;  
print $q->header(  
    -Content_length => -s $fname,  
    -Content_type => $mime,  
);  
  
sysopen my $fh, $fname, O_RDONLY | O_SHLOCK | O_NDELAY or die "could not open/lock <$fname> for reading: $!";  
binmode $fh;  
  
{  
    my $buffer;  
    my $buffersize = 8192 * 16;  
    LOOP: while (1) {  
        my $r = read $fh, $buffer, $buffersize;  
        if (defined $r) {  
            last LOOP if 0 == $r;  
            print $buffer;  
        } else {  
            die "could not read from <$fname>: $!";  
        };  
    };  
};  
  
close $fh;  

Lies bitte perlopentut zum Verständnis. Experimentiere mit der Puffergröße (Vielfaches von 8192), um die optimale Geschwindigkeit für dein System herauszufinden. Mach ihn nicht zu klein (8192 Bytes, langsam), aber auch nicht zu groß (1 MB, Speicherverschwendung).