mark :: blog

17 Apr 2006: Displaying a moving image with Perl/Tk

My home automation tablets use Perl/Tk as their user interface which makes coding and prototyping really quick and easy and works on both Linux and Windows platforms. I use ZoneMinder for looking after the security cameras around the house and had set up the tablets to be able to display a static image from any camera on demand. But what I really wanted to do was to let the tablets display a streaming image from the cameras.

ZoneMinder is able to stream to browsers by making use of the Netscape server push functionality. In response to a HTTP request, ZoneMinder will send out a multipart replace header, then the current captured frame as a jpeg image, followed by a boundary string, followed by the next frame, and so on until you close the connection. It's perhaps not as efficient as streaming via mpeg or some other streaming format, but it's simple and lets you stream images to browsers without requiring plugins.

So I wrote the quick Perl/Tk program below to test streaming from ZoneMinder. It does make some horrible assumptions about the format of the response, so if you want to use this with anything other than ZoneMinder you'll need to edit it a bit. It also assumes that your network is quite good between the client and ZoneMinder; the GUI will become unresponsive if the network read blocks.

My first attempt ran out of memory after an hour -- I traced the memory leak to Tk::Photo and it seems that you have to use the undocumented 'delete' method on a Tk::Photo object otherwise you get a large memory leak. The final version below seems to work okay though.

# 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

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

my $host = "10.0.0.180";
my $url = "/cgi-bin/zms?mode=jpeg&monitor=1&scale=50&maxfps=2";

my $stop = 0;
my $mw = MainWindow->new(title=>"test"); 
my $photo = $mw->Label()->pack();
$mw->Button(-text=>"Start",-command => sub { getdata(); })->pack();
$mw->Button(-text=>"Stop",-command => sub { $stop=1; })->pack();
MainLoop;

sub getdata {
    return unless ($stop == 0);
    my $sock = IO::Socket::INET->new(PeerAddr=>$host,Proto=>'tcp',PeerPort=>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 {
                $photo->configure(-image=>$image);
            };
            $lastimage->delete if ($lastimage); #essential as Photo leaks!
            $lastimage = $image;
        }
        $jpeg .= $1 if ($grab =~ s/(.*)(?=\n)//s);
        last if $stop;
        $mw->update;
    }
    $stop = 0;
}

Russell Handorf used threads to support more than one camera at a time (although I would probably do this in a loop or with select instead of threads)

Created: 17 Apr 2006
Tagged as: ha