#!/usr/bin/perl -w
##
## What it does:
##
## 1. Everytime this script is invoked, do a scan from the camera. That's
## all there is to it.
##
## Note: This script must run setuid to root, since the qcam binary can
## only be allowed to run as root.
##
## TO DO: - Fix the stagnant picture file clean-up calls.
## - Add camera motion capability. Thanks for the motor, Jeffrey!!
## - Fix the "gotcha". Deleting the JPG file soon after displaying
## the page doesn't give the server enough time to pipe it down.
## Maybe file locking would be the ticket.
## - Add Japanese version.
##
## Wishlist: A method to detect lighting changes so the room can be
## reasonably visible. Probably use the sensor from the
## Global Clock Project (htp://www.flab.mag.keio.ac.jp/GClock)
## or a similar facsimile thereof, or even find a way to
## fetch sunrise/sunset info from remote.
##
## History:
##
## 19970322.3 - fixed greeting and camera control according to daylight.
##
## 19961105.2 - who command screwed up by improper regex.
##
## 19960913.1 - fixed error handling to tolerate non-existant pictures
## due to timeouts from the camera.
##
$version = '19970322.3';
require 'timespan.pl';
## The picture's filename.
$pic = "";
## The binary's full path.
$cam = "/usr/local/bin/qcam";
## The full path to the system's 'w' command.
$wcmd = '/usr/bin/who';
## Place to store our pictures.
$picdir = "/usr/local/etc/httpd/htdocs/pics";
## Picture to display if the camera has wandered off....
$nopic = 'cam-busy.jpg';
## ....and the variable need to flag the error.
$huh = '';
## The arguments to pass to the QuickCam binary for the appropriate lighting
## conditions. Normally these are defined by the qcam.conf file, but are
## over-ridden here for more independent control.
$daytime = " -x 320 -y 240 -B 6 -p 0x378 -c 100 -w 50 -b 100 ";
#$daytime = " -x 320 -y 240 -B 6 -p 0x378 -c 100 -w 100 -b 100 ";
$nighttime = " -x 320 -y 240 -B 6 -p 0x378 -c 51 -w 140 -b 135 ";
#$nighttime = " -x 320 -y 240 -B 6 -p 0x378 -c 51 -w 140 -b 235 ";
## For future use. Once the robotics part of the camera is built, we'll
## need to extract the posted data from the click-able image to properly
## direct the camera.
$request_method = $ENV{'REQUEST_METHOD'};
if ($request_method eq "POST") {
# $pic = &do_cam;
} else {
$pic = &do_cam;
}
## Convert the file to JPEG format, since PNG isn't supported by many browsers
## then get rid of *.pgm files. If the camera failed to send a picture,
## then deal with that too.
if ($huh == 1) {
system("cp $picdir/$nopic $picdir/$pic.jpg");
} else {
system("cjpeg $picdir/$pic.pgm > $picdir/$pic.jpg");
}
unlink( );
## Always 2 \n's, as per the HTTP 1.0 spec.
print "Content-type: text/html\n\n";
print "\n\n";
print "Slick-cam\n";
#print "";
print "\n";
print "\n";
print "The Slick-cam!
\n";
print "\n";
print "![](\"/pics/$pic.jpg\")
\n";
print "";
if ($huh == 1) {
print "Using a cached picture. Seems the camera ";
print "fell asleep. Try reloading again.";
} else {
print "
Current time: ", &date($pic), ". William is currently ";
$is_on = &is_on;
if ( $is_on == 1 ) {
print "logged on.
";
} else {
print "not logged on.";
}
}
print "\n";
print "\n";
print "\n";
print "Welcome to the DSI Lab's ";
print "experimental remote camera! A Connectix Quickcam connected ";
print "to a Linux box supplies ";
print "the pictures, and is controlled via the use of ";
print "Scott Laird's qcam ";
print "program and a home-grown perl ";
print "script, available via my perl page.\n
\n";
print "Soon:\n";
print "
\n";
print "
\n";
print "- Remote Motor support! Yes, that's right. One will be able to";
print " point this camera in certain ";
print "directions.\n";
print "
\n";
print "\n";
print "
\n";
#print "$huh\n";
print "Last modified: ", &lasttime, " ago.\n";
print "\n";
print "";
print "Version: $version.";
print "\n";
print "\n";
## Delete the spent JPEG file.
#unlink( );
##
## Call our program to actually take the picture.
##
## If there is a failure, we should actually reuse an old one. Hmmm....
## Something to watch for, given the above unlink command.
##
sub do_cam {
local( $timestamp ) = time;
$filename = "$picdir/$timestamp.pgm";
if ( defined($isday) ) {
system( "$cam $daytime>$filename" );
$huh = $? / 256;
} else {
system( "$cam $nighttime>$filename" );
$huh = $? / 256;
}
return( $timestamp );
}
##
## Find the last modification time of the file, and get annoying about it!
##
sub lasttime {
my($time) = (stat($0))[9];
foreach $file ('slick-cam.cgi' ) {
$tmp = (stat("$file"))[9];
$time = $tmp if $tmp > $time;
}
$time ? &Time'span($time,$^T,3,1) : "???";
$last_time = &Time'span($time,$^T,3,1);
return($last_time);
}
##
## Date routine. Convert the time from seconds to human-readable format.
##
sub date {
local($time) = @_;
my($name) = " EDT";
my($greeting) = "";
my($m,$h,$date,$M,$wday) = (localtime($time))[1..4,6];
my($ampm);
if ($h == 0) {
$h = 12;
$ampm = "am";
} elsif ($h < 12) {
$ampm = "am";
} else {
$ampm = "pm";
$h -= 12 if $h > 12;
}
if ($ampm eq "am") {
$greeting = " Good Morning!";
if ( $h >= 6 ) {
$isday = 1;
}
} elsif (($ampm eq "pm") && ($h >= 6)) {
$greeting = " Good Evening!";
undef( $isday );
} elsif (($ampm eq "am") && ($h <= 6)) {
$greeting = " Good Night!";
} else {
$greeting = " Good Day!";
$isday = 1;
}
sprintf("%s %s %d%s $h:%02d$ampm$name$greeting",
('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat')[$wday],
('Jan', 'Feb', 'March', 'April', 'May', 'June',
'July', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec')[$M], $date,
($date >= 4 && $date <= 20) || $date >= 24 && $date <= 30 ? 'th' :
('th','st','nd','rd')[$date % 10], $m);
}
##
## Am I logged on?
##
sub is_on {
$wfmloggedin = 0;
open(WCMD, "$wcmd 2>&1 |") || die "Couldn't execute $wcmd because: $!";
while () {
if (/wmaton/) {
$wfmloggedin = 1;
}
}
close(WCMD);
return( $wfmloggedin );
}
__END__