Greetings, fellow monks:

For a whole couple of days I've been thinking of ways in which I could get access to a user's webcam using Perl. Specifically my short-term goal was to be able to display a Perl/Tk window displaying a live video preview from the user's webcam.

The approach I took was to bang on ffmpeg for a while until it gives me what I want (as ffmpeg has also been ported to Win32, this might also mean my code would be reasonable portable to Windows as well). After stumbling on a few different examples of ffmpeg sorcery (such as streaming the webcam over SSH into mplayer on another system), I finally figured a way to grab images out of it from within Perl.

I eventually pieced together the following ffmpeg command which activates the user's camera and streams the output as a motion jpeg (which seems to really be just a bunch of jpegs concatenated together, each one beginning with the jpeg magic number \xFF\xD8):

With this I was able to open it as a filehandle and read all the jpegs out of it... and once I got a script put together that would write said jpegs into individual files, I started putting together my Tk webcam viewer! The code follows:

#!/usr/bin/perl -w

# Perl/Tk Webcam Streamer and Snapshot Taker
# Proof of Concept
# Author: Casey Kirsle, http://www.cuvou.com/

use Tk;
use Tk::JPEG;
use MIME::Base64 "encode_base64";

# Some things that might need to be configured.
my $device = shift(@ARGV) || "/dev/video0";
if ($device =~ /^\// && !-e $device) {
    die "Can't see video device: $device";
}

# Tk MainWindow
my $mw = MainWindow->new (
    -title => 'Tk Stream',
);
$mw->protocol (WM_DELETE_WINDOW => \&onExit);

# A label to display the photos.
my $photo = $mw->Label ()->pack();

# A button to capture a photo
my $capture = $mw->Button (
    -text => "Take Picture",
    -command => \&snapshot,
)->pack();

$mw->update();

my $cmd = "ffmpeg -b 100K -an -f video4linux2 -s 320x240 -r 10 -i $dev
+ice -b 100K -f image2pipe -vcodec mjpeg - "
    . "| perl -pi -e 's/\\xFF\\xD8/KIRSLESEP\\xFF\\xD8/ig'";
open (PIPE, "$cmd |");

my ($image,$lastimage);

my $i = 0;
my $jpgBuffer = ""; # last complete jpg image
my $buffer = ""; # bytes read
my $lastFrame = ""; # last complete jpg (kept until another full frame
+ was read; for capturing to disk)
while (read(PIPE, $buffer, 2048)) {
    my (@images) = split(/KIRSLESEP/, $buffer);
    shift(@images) if length $images[0] == 0;
    if (scalar(@images) == 1) {
        # Still the old image.
        my $len = length $images[0];
        $jpgBuffer .= $images[0];
    }
    elsif (scalar(@images) == 2) {
        # We've completed the old image.
        $jpgBuffer .= shift(@images);
        my $len = length $images[0];
        next if length $jpgBuffer == 0;

        # Put this into the last frame received, in case the user
        # wants to save this snapshot to disk.
        $lastFrame = $jpgBuffer;

        # Create a new Photo object to hold the jpeg
        eval {
            $image = $mw->Photo (
                -data => encode_base64($jpgBuffer),
                -format => 'JPEG',
            );
        };
        # Update the label to display the snapshot
        eval {
            $photo->configure (-image => $image);
        };
        # Delete the last image to free up memory leaks,
        # then copy the new image to it.
        $lastimage->delete if ($lastimage);
        $lastimage = $image;

        # Refresh the GUI
        $mw->update();

        # Start reading the next image.
        $jpgBuffer = shift(@images);
    }
    else {
        print "Weird error: 3 items in array!\n";
        exit(1);
    }
}

sub snapshot {
    # Make up a capture filename.
    my $i = 0;
    my $fname = "capture" . (sprintf("%04d",$i)) . ".jpg";
    while (-f $fname) {
        $fname = "capture" . (sprintf("%04d",++$i)) . ".jpg";
    }

    # Save it.
    open (WRITE, ">$fname");
    binmode WRITE;
    print WRITE $lastFrame;
    close (WRITE);
    print "Frame capture saved as $fname\n";
}

sub onExit {
    # Close ffmpeg.
    print "Exiting!\n";
    close (PIPE);
}
[download]

I tacked onto the end of that ffmpeg command a pipe that ran it through Perl to substitute each JPEG magic number so that they each have "KIRSLESEP" before them. This made the task of splitting the jpegs much easier, as I'm not quite up to snuff on my regexp skills and don't recall the syntax for how to split while keeping the split delimiter as part of the output.

So, I'm submitting this to Perlmonks for your review. When I thought about starting this project I came here first to have a search around and haven't seen that anyone had done this (though I did see one node where the vidcat app was used, but vidcat is a dinosaur and doesn't run on my Fedora 11 system).

When I run this script on my Dell Mini 9 with built-in webcam, I get a Tk window that shows myself, in a live video stream. The framerate seems to be on par with every other video app I've ever used, with maybe a half-second delay or less.

However, over time the app starts to slow down, because Perl/Tk doesn't seem to be freeing up memory after each image is destroyed (I've tried manually destroying each photo object before creating the new one, but it didn't help).

Please post any comments or suggestions on this. :)

Update (Sep 2 09) I've fixed the memory leak using a delete() method that I found here. I played with it before but it was terribly slow (resulting in a 5 to 10 second lag in video), but I found out it's because it actually is working and just takes a while to delete a 640x480 pixel image. Lowering the resolution to 320x240 and the video stream is fast and snappy again, and no more memory leaks!

I've updated the code with my final proof-of-concept version.