Webcam

This script checks the age of an image on the Internet by using libwww to issue a HEAD request to it and then checking the last-modified response header. If the image is older than a specified number of seconds then it redirects to a different image. In this case the image is my webcam and it redirects to a testcard if it hasn't been updated for a while (as happens when my workstation is turned off). It's a little overkill since the images and the script are all on the same server, but it's a good practical demonstration of a similar script I hacked together in response to a thread on LWD.

Source Code

#!/usr/bin/perl

use strict;
use CGI;
use LWP::UserAgent;
use HTTP::Date; # for the date string to time function

my $on_url  = 'http://www.matbooth.co.uk/misc/webcam/webcam-on.jpg';
my $off_url = 'http://www.matbooth.co.uk/misc/webcam/webcam-off.jpg';
my $age_seconds = 86400;

my $q = new CGI;
if(defined $q->param('age')) {
	$age_seconds = $q->param('age')
}

send_req($on_url, $off_url, $age_seconds);

# send the request
sub send_req {
	my ($on, $off, $age) = @_;

	# create request and get response
	my $ua = LWP::UserAgent->new;
	my $req = HTTP::Request->new(HEAD => $on);
	my $res = $ua->request($req);

	# check the outcome
	if ($res->is_success) {
		if (str2time($res->header('Last-Modified')) > time - $age) {
			print "Location: $on\n\n";
		}
		else {
			print "Location: $off\n\n";
		}
	}
}