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

Hello fellow monks, I've looked at this thread http://www.perlmonks.org/?node_id=420430 and have tried taking some advice from it regarding how to get threading and Tk to work nicely. However, I'm just hitting a mental block. What my desired end result would be is to have 4 MJPEG streams displayed in one window. I've started with another fellow's code who has streaming MJPEG's working just fine; but only one source. Any idea's would be appreciated; I've emailed the origional author but haven't gotten a response yet. 
#!/usr/bin/perl

# 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 support for multiple "monitors"... still in progress


use Tk;
use Tk::X11Font;
use Tk::JPEG;
use LWP::UserAgent;
use MIME::Base64;
use IO::Socket;
use threads;

my $host = "someipaddress";

my $url1 = "/cgi-bin/nph-zms?mode=jpeg&monitor=1&scale=100&maxfps=5&us
+er=web&pass=webuser";
my $url2 = "/cgi-bin/nph-zms?mode=jpeg&monitor=2&scale=100&maxfps=5&us
+er=web&pass=webuser";
my $url3 = "/cgi-bin/nph-zms?mode=jpeg&monitor=3&scale=100&maxfps=5&us
+er=web&pass=webuser";
my $url4 = "/cgi-bin/nph-zms?mode=jpeg&monitor=4&scale=100&maxfps=5&us
+er=web&pass=webuser";

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');

my $photo1 = $top->Label()->pack(-side => 'left');
my $photo2 = $top->Label()->pack(-side => 'right');
my $photo3 = $bottom->Label()->pack(-side => 'left');
my $photo4 = $bottom->Label()->pack(-side => 'right');

$mw->Button(-text=>"Stop",-command => sub { $stop=1; })->pack();
$thr1 = threads->new(\&getdata($url1,"1"));
$thr1->detach;
$thr2 = threads->new(\&getdata($url2,"2"));
$thr2->detach;
$thr3 = threads->new(\&getdata($url3,"3"));
$thr3->detach;
$thr4 = threads->new(\&getdata($url4,"4"));
$thr4->detach;

MainLoop;

sub getdata {
   my $url = shift;
   my $id = shift;
   return unless ($stop == 0);
   my $sock = IO::Socket::INET->new(PeerAddr=>$host,Proto=>'tcp',PeerP
+ort=>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);
           undef $jpeg;
           eval {
               $image = $mw->Photo(-format=>"jpeg",-data=>$data);
           };
           undef $data;
           eval {
               print "Zone $id\n";
               if ($id == 1) {
                 $photo1->configure(-image=>$image);
               } elsif ($id == 2 ) {
                 $photo2->configure(-image=>$image);
               } elsif ($id == 3 ) {
                 $photo3->configure(-image=>$image);
               } elsif ($id == 4 ) {
                 $photo4->configure(-image=>$image);
               }
           };
           $lastimage->delete if ($lastimage); #essential as Photo lea
+ks!
           $lastimage = $image;
       }
       $jpeg .= $1 if ($grab =~ s/(.*)(?=\n)//s);
       last if $stop;
       $mw->update;
   }
   $stop = 0;
}

[download]
I believe my problem is because of the while loop in getdata, and how the image has it's participation with the rest of the program. If I can separate the image output, and have another thread for displaying the image (within a Tk thread), I think I might be able to get this to work. But I just dont think this is right for some reason. Thanks!

Replies are listed 'Best First'.
Re: Tk, threads, and mjpeg stream
by BrowserUk (Patriarch) on Apr 18, 2006 at 10:51 UTC

    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;

    [download]
    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.
[reply]
[d/l]
      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;

      [download]
      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)

      [download]
      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

      [download]
      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;

        [download]
[reply]
[d/l]
      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]
Re: Tk, threads, and mjpeg stream
by satanklawz (Beadle) on Apr 18, 2006 at 02:19 UTC
    So, yes, I'm replying to my own post :) I forgot about good 'ol Parallel::ForkManager. When I dont use the resources for Tk to draw everything, I see the threads starting and pushing data. However, when I ask them to output their contense to the screen, I now only get just one image and the following errors. 
    ./cams-split.pl 
Start Loop 
Start Loop 
Start Loop 
Start Loop 
Zone 1
Zone 2
X Error of failed request:  BadIDChoice (invalid resource ID chosen fo
+r this connection)
  Major opcode of failed request:  55 (X_CreateGC)
  Resource id in failed request:  0x1e00009
  Serial number of failed request:  171
  Current serial number in output stream:  44
X Error of failed request:  BadIDChoice (invalid resource ID chosen fo
+r this connection)
  Major opcode of failed request:  55 (X_CreateGC)
  Resource id in failed request:  0x1e00009
  Serial number of failed request:  177
  Current serial number in output stream:  44
Zone 1
X Error of failed request:  BadIDChoice (invalid resource ID chosen fo
+r this connection)
  Major opcode of failed request:  55 (X_CreateGC)
  Resource id in failed request:  0x1e00009
  Serial number of failed request:  387
  Current serial number in output stream:  44
Zone 1
Zone 1
Zone 1
Zone 1

    [download]
    I have the debug code in so everyone can tell what is happening better. Here is the current codebase: 
    #!/usr/bin/perl

# 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 support for multiple "monitors"... still in progress


use Tk;
use Tk::X11Font;
use Tk::JPEG;
use LWP::UserAgent;
use MIME::Base64;
use IO::Socket;
use Parallel::ForkManager;

my $fm = new Parallel::ForkManager(4);

my $host = "someipaddress";
@links=(
  ["/cgi-bin/nph-zms?mode=jpeg&monitor=1&scale=100&maxfps=5&user=web&p
+ass=webuser","1"],
  ["/cgi-bin/nph-zms?mode=jpeg&monitor=2&scale=100&maxfps=5&user=web&p
+ass=webuser","2"],
  ["/cgi-bin/nph-zms?mode=jpeg&monitor=3&scale=100&maxfps=5&user=web&p
+ass=webuser","3"],
  ["/cgi-bin/nph-zms?mode=jpeg&monitor=4&scale=100&maxfps=5&user=web&p
+ass=webuser","4"]
);

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');

my $photo1 = $top->Label()->pack(-side => 'left');
my $photo2 = $top->Label()->pack(-side => 'right');
my $photo3 = $bottom->Label()->pack(-side => 'left');
my $photo4 = $bottom->Label()->pack(-side => 'right');

$mw->Button(-text=>"Stop",-command => sub { $stop=1; })->pack();

foreach my $itemarray (@links) {
   $fm->start and next;
   print "Start Loop \n";
   my ($url,$zone) = @$itemarray;
   getdata($url,$zone);
   $fm->finish;
}
$fm->wait_all_children; 
 

MainLoop;

sub getdata {
    my $url = shift;
    my $id = shift;
    return unless ($stop == 0);
    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);
            undef $jpeg;
            eval {
                $image = $mw->Photo(-format=>"jpeg",-data=>$data);
            };
            undef $data;
            eval {
                print "Zone $id\n";
                if ($id == 1) {
                  $photo1->configure(-image=>$image);
                } elsif ($id == 2 ) {
                  $photo2->configure(-image=>$image);
                } elsif ($id == 3 ) {
                  $photo3->configure(-image=>$image);
                } elsif ($id == 4 ) {
                  $photo4->configure(-image=>$image);
                }
            };
            $lastimage->delete if ($lastimage); #essential as Photo le
+aks!
            $lastimage = $image;
        }
        $jpeg .= $1 if ($grab =~ s/(.*)(?=\n)//s);
        last if $stop;
        $mw->update;
    }
    $stop = 0;
}

    [download]
[reply]
[d/l]
[select]
Re: Tk, threads, and mjpeg stream
by zentara (Cardinal) on Apr 18, 2006 at 12:09 UTC
    Well BrowserUK pointed out the limitations of using threads with Tk. The threads must be created before any Tk statements are made, to prevent copies of the Tk widgets getting into the threads, and causing confusion. That is why they say, that "Tk is not thread-safe". It can be used with threads, but not without precautions.

    I will point out, that the Gtk2 thread model will allow you to do what you want, with it's "thread-safe" mode. You need a recent version of Gtk2, and look at it's thread_usage.pl in the examples directory.

    I'm not really a human, but I play one on earth. flash japh
[reply]

Back to Seekers of Perl Wisdom