perlunity.de - PERL | JAVASCRIPT | PHP | MySQL | APACHE



#!/COMMUNITY

Members: 5374
davon online: 1
weitere User: 34
 Click for quality!



08.02.2012 / 22:13
Community-Member werden   |   Paßwort vergessen   |   OnlineMonitor (1) Wer ist online ... OnlineMonitor starten !
     

 

Home

PERLscripts

PHPscripts

JAVAscripts

Hilfreiches

Links2www

Newscenter

Community

Interna



Community  »  Perl: Allgemeines Forum zur Themenübersicht Themensuche Themenansicht in Thread-Modus


BeitragPerl/Tk Speichermüll bei repeat
 Seitenanfang
Hallo!

Ich würde gerne alle 2 Sekunden ein neues Bild auf meiner Canvas ausgeben lassen.
Dazu habe ich mir folgendes gebastelt (ist noch in der Mache):


#!/Perl/bin/perl
use strict;
use warnings;
#use diagnostics;
use Data::Dumper();
#print Data::Dumper::Dumper();
use Tk;
use Tk::JPEG;
use Tk::PNG;
my $gdir = 'c:/apache/htdocs/grafiken/';
my @fotos = qw(visitenKarte.png cms/cms_logo2.gif igs/logo5_o.jpg);
my $mw = MainWindow->new(-width=>800, -height=>640,);
$mw->packPropagate(0);
my $c = $mw->Canvas(
        -width  => 1,
        -height => 1,
        -background => 'dark slate gray',
)->pack;
my $id = undef;
my $cnt = 0;
$id = $mw->repeat(2000, sub{ main::count($mw) });
my $foto = $c->Photo(-file => $gdir.$fotos[$cnt]);
sub count {
    $foto->destroy();
    $c->destroy();
$c = $mw->Canvas(
        -width  => 1,
        -height => 1,
        -background => 'dark slate gray',
)->pack;
    $foto = $c->Photo(-file => $gdir.$fotos[$cnt]);
#    print Data::Dumper::Dumper($foto);
    $c->createImage(0, 0,
            -image => $foto,
            -tag   => $fotos[$cnt],
            -anchor => 'nw',
    );
    $c->configure(-width => $foto->width(), -height => $foto->height());
    $c->update();
    $mw->update();
    if( $cnt < scalar(@fotos)-1 ){
        $cnt++;
    }else{
        $cnt = 0;
    }
}
MainLoop;
exit(0);

Das Ding funktioniert soweit auch ganz gut.
Nur leider müllt mir das Script den Arbeitsspeicher mehr und mehr zu :(
Binnen weniger Sekunden steigt der Speicherbedarf um ca. ein bis zwei Megabyte.
Dabei lösche ich doch bei jedem Durchlauf extra die alte Canvas und das alte Bild (oder?).
Wie kann ich das vermeiden?
mfg pktm

Datum: 16.11.2004-00:21
Beitragre: Perl/Tk Speichermüll bei repeat
 Seitenanfang
Vielleicht soltest du $c nicht 'destroyen' sondern einfach nur leeren... mit $foto das selbe.

Mach einfach sowas wie $foto->configure(-file => ...);

Datum: 21.11.2004-15:07
BeitragLösung
 Seitenanfang
Hallo!

Habe es nun so geregelt, dass ich sogar eine Abfall der Speicherlast binnen 40min Testphase registrieren kann.
Die Funktionsweise:
1. Canvas gegen ein eher trivialeres Label getauscht (kenne die Canvas und ihre Eigenschaften noch nciht so)
2. Die Objekte zur Erstellung des Bildes nicht löschen sondern umkonfigurieren (config)
3. nurnoch das entsprechende widget refreshen


#!/Perl/bin/perl
use strict;
use warnings;
#use diagnostics;
use Data::Dumper();
#print Data::Dumper::Dumper();
use Tk;
use Tk::JPEG;
use Tk::PNG;
my $gdir = 'c:/apache/htdocs/grafiken/';
my @fotos = qw(visitenKarte.png cms/cms_logo2.gif igs/logo5_o.jpg);
my $mw = MainWindow->new(-width=>800, -height=>640,);
$mw->packPropagate(0);
my $cnt = 0;
my $foto = $mw->Photo('IMG', -file => $gdir.$fotos[$cnt]);
my $f = $mw->Label(-image=>$foto);
$f->repeat(2000, sub{
    $cnt = main::setCnt($cnt);
    $foto->blank();
#    $foto->destroy();
#    $f->destroy();
#    $foto = $mw->Photo('IMG', -file => $gdir.$fotos[$cnt]);
#    $f = $mw->Label(-image=>$foto);
    $foto->configure(-file => $gdir.$fotos[$cnt]);
#    print Data::Dumper::Dumper( $f );
#$VAR1 = bless( {
#                 '_TkValue_' => '.label'
#               }, 'Tk::Label' );
    $f->update();
#    $mw->update();
});
$f->pack(-anchor=>'nw');
    
MainLoop;
sub setCnt {
    my $cnt = shift;
    if( $cnt < scalar(@fotos)-1 ){
        $cnt++;
    }else{
        undef $cnt;
        $cnt = 0;
    }
    return $cnt;
} # /setCnt
exit(0);

Kritik, Anregungen und Verbesserungsvorschläge (besonders ein OO-Interface) sind herzlichst willkommen.
mfg pktm

Datum: 22.11.2004-21:04
-






-
 -