in reply to Re^2: Tk, threads, and mjpeg stream
in thread Tk, threads, and mjpeg stream
#!/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;
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^4: Tk, threads, and mjpeg stream
by satanklawz (Beadle) on Apr 18, 2006 at 18:06 UTC | |
by BrowserUk (Patriarch) on Apr 18, 2006 at 21:42 UTC |