in reply to Tk, threads, and mjpeg stream
To use Tk and threads together, all your interaction with Tk objects *must* be from one thread only.
In the following code, the threads load the image data into shared buffers and then set a flag to indicate that the data is ready.
In the main thread, I've set up a repeating callback that checks the flags and when set, does the steps necessary to load the new image into the gui.
I've simulated the network fetch by loading a randomly selected, suitably sized image from a directory, but all the principal steps remain:
- Do the slow stuff (network interaction or file loading) in the thread(s).
- Share the data through shared buffers with the main (Tk) thread.
- Use a callback in the main thread to update the gui.
To run this demo as is, create 4 directories (c:\test\pics\(one|two|three|four) in this example), and place a number of suitably sized jpgs in each directory.
#! perl -slw
use Tk;
#use Tk::X11Font;
use Tk::JPEG;
use LWP::UserAgent;
use MIME::Base64;
use IO::Socket;
use threads;
use threads::shared;
my $host = 'c:\test\pics'; ## Dummy 'host' for testing
my @urls = qw[ one two three four ]; ## Dummy 'urls' for testing
my @data :shared = ('') x 4; ## 4 shared image data buffers
my @flags :shared = (0) x 4; ## 4 shared 'image ready' flags
sub loadJpg {
my( $host, $url, $no, $dataref ) = @_;
my @jpgs = glob "$host/$url/*.jpg";
while( sleep 1+rand 4 ) { ## Simulate network delays
next if $flags[ $no ]; ## If the flag is still set do nothing
## Load the image
my $jpg = $jpgs[ rand @jpgs ];
open my $fh, '<:raw', $jpg or warn "$jpg : $!" and next;
my $data = do{ local $/; <$fh> };
close $fh;
## copy to the appropriate shared buffer
$dataref->[ $no ] = $data;
## Set the appropriate 'image ready' flag
$flags[ $no ] = 1;
}
}
## Start the threads passing
## The host, url, buffer/flag number and buffer reference
my @threads = map{
threads->new( \&loadJpg, $host, $urls[ $_ ], $_, \@data );
} 0 .. 3;
my $stop = 0;
my $mw = MainWindow->new(title=>"Cams");
$mw->minsize( qw(640 480));
my $top = $mw->Frame()->pack(-side=>'top');
my $bottom = $mw->Frame()->pack(-side=>'bottom');
## Use an array, indexed by passed number
my @photos = (
$top->Label()->pack(-side => 'left'),
$top->Label()->pack(-side => 'right'),
$bottom->Label()->pack(-side => 'left'),
$bottom->Label()->pack(-side => 'right'),
);
$mw->Button(-text=>"Stop",-command => sub { $stop=1; })->pack();
## Set up a regular callback in the main thread that
## a) checks the flags for each image
## and if it is set
## b) Locks the data
## c) Encodes the data
## d) Creates a Photo object from it
## e) Sets it into the widget
## f) Clears the flag ready for the next
$mw->repeat( 1000, sub{
for my $n ( 0 .. 3 ) {
if( $flags[ $n ] ) {
lock( @data );
my $data = encode_base64( $data[ $n ] );
$image[ $n ]->delete if $image[ $n ]; ## Addendum:
$image[ $n ] = $mw->Photo( -format=>'jpeg', -data=>$data )
+;
$photos[ $n ]->configure( -image => $image[ $n ] );
$flags[ $n ] = 0;
}
}
} );
MainLoop;
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
Lingua non convalesco, consenesco et abolesco. -- Rule 1 has a caveat! -- Who broke the cabal?
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
Re^2: Tk, threads, and mjpeg stream
by satanklawz (Beadle) on Apr 18, 2006 at 15:05 UTC
|
BrowserUK,
Thanks again for your excellent suggestion. Below is where I currently am in the learning phase of how all this works.
#!/usr/bin/perl -slw
use Tk;
use Tk::JPEG;
use LWP::UserAgent;
use MIME::Base64;
use IO::Socket;
use threads;
use threads::shared;
my $host = 'someipaddress';
my @urls = qw[ /cgi-bin/nph-zms?mode=jpeg&monitor=1&scale=100&maxfps=5
+&user=web&pass=webuser /cgi-bin/nph-zms?mode=jpeg&monitor=2&scale=100
+&maxfps=5&user=web&pass=webuser /cgi-bin/nph-zms?mode=jpeg&monitor=3&
+scale=100&maxfps=5&user=web&pass=webuser /cgi-bin/nph-zms?mode=jpeg&m
+onitor=4&scale=100&maxfps=5&user=web&pass=webuser ];
my @data :shared = ('') x 4; ## 4 shared image data buffers
my @flags :shared = (0) x 4; ## 4 shared 'image ready' flags
sub loadJpg {
my( $host, $url, $no, $dataref ) = @_;
next if $flags[ $no ]; ## If the flag is still set do nothing
#load the image
my $sock = IO::Socket::INET->new(PeerAddr=>$host,Proto=>'tcp',Peer
+Port=>80,);
return unless defined $sock;
$sock->autoflush(1);
print $sock "GET $url HTTP/1.0\r\nHost: $host\r\n\r\n";
my $status = <$sock>;
die unless ($status =~ m|HTTP/\S+\s+200|);
my ($grab,$jpeg,$data,$image,$thisbuf,$lastimage);
while (my $nread = sysread($sock, $thisbuf, 4096)) {
$grab .= $thisbuf;
if ( $grab =~ s/(.*?)\n--ZoneMinderFrame\r\n//s ) {
$jpeg .= $1;
$jpeg =~ s/--ZoneMinderFrame\r\n//; # Heh, what a
$jpeg =~ s/Content-Length: \d+\r\n//; # Nasty little
$jpeg =~ s/Content-Type: \S+\r\n\r\n//; # Hack
$data = encode_base64($jpeg);
## copy to the appropriate shared buffer
$dataref->[ $no ] = $data;
## Set the appropriate 'image ready' flag
$flags[ $no ] = 1;
$lastimage->delete if ($lastimage); #essential as Photo le
+aks!
$lastimage = $image;
undef $jpeg;
undef $data;
}
$jpeg .= $1 if ($grab =~ s/(.*)(?=\n)//s);
}
}
## Start the threads passing
## The host, url, buffer/flag number and buffer reference
my @threads = map{
threads->new( \&loadJpg, $host, $urls[ $_ ], $_, \@data );
} 0 .. 3;
my $stop = 0;
my $mw = MainWindow->new(title=>"Cams");
$mw->minsize( qw(640 480));
my $top = $mw->Frame()->pack(-side=>'top');
my $bottom = $mw->Frame()->pack(-side=>'bottom');
## Use an array, indexed by passed number
my @photos = (
$top->Label()->pack(-side => 'left'),
$top->Label()->pack(-side => 'right'),
$bottom->Label()->pack(-side => 'left'),
$bottom->Label()->pack(-side => 'right'),
);
$mw->Button(-text=>"Stop",-command => sub { $stop=1; })->pack();
## Set up a regular callback in the main thread that
## a) checks the flags for each image
## and if it is set
## b) Locks the data
## c) Encodes the data
## d) Creates a Photo object from it
## e) Sets it into the widget
## f) Clears the flag ready for the next
$mw->repeat( 1000, sub{
for my $n ( 0 .. 3 ) {
if( $flags[ $n ] ) {
lock( @data );
my $data = encode_base64( $data[ $n ] );
$image[ $n ]->delete if $image[ $n ]; ## Addendum:
$image[ $n ] = $mw->Photo( -format=>'jpeg', -data=>$data )
+;
$photos[ $n ]->configure( -image => $image[ $n ] );
$flags[ $n ] = 0;
}
}
} );
MainLoop;
When I run this, I get the following errors
XS_Tk__Callback_Call error:couldn't recognize image data at /usr/lib/p
+erl5/site_perl/5.8.0/i386-linux-thread-multi/Tk/Image.pm line 21.
Tk::Error: couldn't recognize image data at /usr/lib/perl5/site_perl/5
+.8.0/i386-linux-thread-multi/Tk/Image.pm line 21.
Tk callback for image
Tk::After::repeat at /usr/lib/perl5/site_perl/5.8.0/i386-linux-thread
+-multi/Tk/After.pm line 79
[repeat,[{},after#4,1000,repeat,[\&main::__ANON__]]]
("after" script)
XS_Tk__Callback_Call error:couldn't recognize image data at /usr/lib/p
+erl5/site_perl/5.8.0/i386-linux-thread-multi/Tk/Image.pm line 21.
Tk::Error: couldn't recognize image data at /usr/lib/perl5/site_perl/5
+.8.0/i386-linux-thread-multi/Tk/Image.pm line 21.
Tk callback for image
Tk::After::repeat at /usr/lib/perl5/site_perl/5.8.0/i386-linux-thread
+-multi/Tk/After.pm line 79
[repeat,[{},after#5,1000,repeat,[\&main::__ANON__]]]
("after" script)
XS_Tk__Callback_Call error:couldn't recognize image data at /usr/lib/p
+erl5/site_perl/5.8.0/i386-linux-thread-multi/Tk/Image.pm line 21.
Tk::Error: couldn't recognize image data at /usr/lib/perl5/site_perl/5
+.8.0/i386-linux-thread-multi/Tk/Image.pm line 21.
Tk callback for image
Tk::After::repeat at /usr/lib/perl5/site_perl/5.8.0/i386-linux-thread
+-multi/Tk/After.pm line 79
[repeat,[{},after#6,1000,repeat,[\&main::__ANON__]]]
("after" script)
XS_Tk__Callback_Call error:couldn't recognize image data at /usr/lib/p
+erl5/site_perl/5.8.0/i386-linux-thread-multi/Tk/Image.pm line 21.
Tk::Error: couldn't recognize image data at /usr/lib/perl5/site_perl/5
+.8.0/i386-linux-thread-multi/Tk/Image.pm line 21.
Tk callback for image
Tk::After::repeat at /usr/lib/perl5/site_perl/5.8.0/i386-linux-thread
+-multi/Tk/After.pm line 79
[repeat,[{},after#7,1000,repeat,[\&main::__ANON__]]]
("after" script)
I had thought that the string that was being passed was not being encoded correctly (or something along those lines) so I inserted a print statement of the array $data$n and got back actual jpeg information.
/9j/4AAQSkZJRgABAQAAAQABAAD/2wBDAAgGBgcGBQgHBwcJCQgKDBQNDAsLDBkSEw8UHR
+ofHh0a
HBwgJC4nICIsIxwcKDcpLDAxNDQ0Hyc5PTgyPC4zNDL/2wBDAQkJCQwLDBgNDRgyIRwhMj
+IyMjIy
AAF9AQIDAAQRBRIhMUEGE1FhByJxFDKBkaEII0KxwRVS0fAkM2JyggkKFhcYGRolJicoKS
+o0NTY3
...
<trunkated because there's a lot of stuff, and it's a live image>
...
TFRuykAemab5oJKnG4VHuJbpRcY4vuwM8jjFOQttBdAM0cFtygZ9KGyxBZulArAMvnHAz3
+pxJWMg
kcDr+NCEBQR3PBFRyHltpBJx/OmrAf/ZDQoN
Thanks again, I'm still working on this one... | [reply] [d/l] [select] |
|
I solved it- after I sent the post I realized I had encoded in 64, and did it again! DOH; regardless it works now! Here's the code for all to see:
#!/usr/bin/perl -slw
# Origional:
# Test program to decode the multipart-replace stream that
# ZoneMinder sends. It's a hack for this stream only though
# and could be easily improved. For example we ignore the
# Content-Length.
#
# Mark J Cox, mark@awe.com, February 2006
#
# Added onto by Russ Handorf to support multiple "monitors"
# Russ Handorf, rhandorf@handorf.org, April 2006
# Thanks to BrowserUK and perlmonks for the wonderous teachings of thr
+eads!
use Tk;
use Tk::JPEG;
use LWP::UserAgent;
use MIME::Base64;
use IO::Socket;
use threads;
use threads::shared;
my $host = 'enter an ip';
my @urls = qw[ /cgi-bin/nph-zms?mode=jpeg&monitor=1&scale=100&maxfps=5
+&user=web&pass=webuser /cgi-bin/nph-zms?mode=jpeg&monitor=2&scale=100
+&maxfps=5&user=web&pass=webuser /cgi-bin/nph-zms?mode=jpeg&monitor=3&
+scale=100&maxfps=5&user=web&pass=webuser /cgi-bin/nph-zms?mode=jpeg&m
+onitor=4&scale=100&maxfps=5&user=web&pass=webuser ];
my @data :shared = ('') x 4; ## 4 shared image data buffers
my @flags :shared = (0) x 4; ## 4 shared 'image ready' flags
sub loadJpg {
my( $host, $url, $no, $dataref ) = @_;
next if $flags[ $no ]; ## If the flag is still set do nothing
#load the image
my $sock = IO::Socket::INET->new(PeerAddr=>$host,Proto=>'tcp',Peer
+Port=>80,);
return unless defined $sock;
$sock->autoflush(1);
print $sock "GET $url HTTP/1.0\r\nHost: $host\r\n\r\n";
my $status = <$sock>;
die unless ($status =~ m|HTTP/\S+\s+200|);
my ($grab,$jpeg,$data,$image,$thisbuf,$lastimage);
while (my $nread = sysread($sock, $thisbuf, 4096)) {
$grab .= $thisbuf;
if ( $grab =~ s/(.*?)\n--ZoneMinderFrame\r\n//s ) {
$jpeg .= $1;
$jpeg =~ s/--ZoneMinderFrame\r\n//; # Heh, what a
$jpeg =~ s/Content-Length: \d+\r\n//; # Nasty little
$jpeg =~ s/Content-Type: \S+\r\n\r\n//; # Hack
#$data = encode_base64($jpeg);
$data=$jpeg;
## copy to the appropriate shared buffer
$dataref->[ $no ] = $data;
## Set the appropriate 'image ready' flag
$flags[ $no ] = 1;
$lastimage->delete if ($lastimage); #essential as Photo le
+aks!
$lastimage = $image;
undef $jpeg;
undef $data;
}
$jpeg .= $1 if ($grab =~ s/(.*)(?=\n)//s);
}
}
## Start the threads passing
## The host, url, buffer/flag number and buffer reference
my @threads = map{
threads->new( \&loadJpg, $host, $urls[ $_ ], $_, \@data );
} 0 .. 3;
my $stop = 0;
my $mw = MainWindow->new(title=>"Cams");
$mw->minsize( qw(640 480));
my $top = $mw->Frame()->pack(-side=>'top');
my $bottom = $mw->Frame()->pack(-side=>'bottom');
## Use an array, indexed by passed number
my @photos = (
$top->Label()->pack(-side => 'left'),
$top->Label()->pack(-side => 'right'),
$bottom->Label()->pack(-side => 'left'),
$bottom->Label()->pack(-side => 'right'),
);
$mw->Button(-text=>"Stop",-command => sub { $stop=1; })->pack();
## Set up a regular callback in the main thread that
## a) checks the flags for each image
## and if it is set
## b) Locks the data
## c) Encodes the data
## d) Creates a Photo object from it
## e) Sets it into the widget
## f) Clears the flag ready for the next
$mw->repeat( 1000, sub{
for my $n ( 0 .. 3 ) {
if( $flags[ $n ] ) {
lock( @data );
my $data = encode_base64( $data[ $n ] );
$image[ $n ]->delete if $image[ $n ]; ## Addendum:
$image[ $n ] = $mw->Photo( -format=>'jpeg', -data=>$data )
+;
$photos[ $n ]->configure( -image => $image[ $n ] );
$flags[ $n ] = 0;
}
}
} );
MainLoop;
| [reply] [d/l] |
|
Hehe, just when you think you've got it solved a memory leak crops up! And it's a nasty one; gotta find it.
UPDATE:
It's within these two lines
$image[ $n ]->delete if $image[ $n ]; ## Addendum:
$image[ $n ] = $mw->Photo( -format=>'jpeg', -data=>$data )
+;
The first one does not seem to be clearing out the previous image, hence when the second line executes my system has more memory space consumed. I take it this problem is within Tk widget distruction? Any ideas from out there?
Thanks | [reply] [d/l] |
|
Re^2: Tk, threads, and mjpeg stream
by satanklawz (Beadle) on Apr 18, 2006 at 14:29 UTC
|
Excellent suggestion,
the only difference that I have between yours and mine is that I have an actual data stream that is never ending. That's another part of my problem :/ I'll see what I can do with what you've suggested. I'll report back soon,
thanks! | [reply] |
|
|