It does setup stuff (a lot of that), and then goes into a loop. In this
loop it does a system call to v4lctl to capture an image, then goes bacl to
sleep and waits. Curently it's one image every 10 seconds. Running since
moday, it had grown to a size of 1/2 a gig :-(
At the risk of being flamed :-(, but because I can't really see anyway to
provide a useful example without showing all the code here it is:
_____
#!/usr/bin/perl -w
# "@(#)webcam.pl
#
# "%W% %E% %U%"; /* SCCS what string */
#
# webcam.pl
#
# 10-30-2003 SDB XXXXXXXXXXXXXXX
#
# Captures video images
use strict;
use AppConfig::File;
use IO::Handle;
use Getopt::Mixed "nextOption" ;
use Time::HiRes qw( gettimeofday tv_interval);
use Data:
umper;
use Term::ANSIColor qw
constants);
use Date::Calc qw( Today Day_of_Week );
use Time::Local;
use Time::CTime;
use Time::HiRes qw(gettimeofday);
use Image::Magick;
use File:
ath;
use File::lockf;
use Term::ANSIColor qw
constants);
use Video::Capture::V4l;
use Imager;
use Devel::Leak;
# Config file name goes here
# May be modifed with -f <filename> at runtime
$::cfg_file = "/opt/local/lib/webcam.conf";
# Can be turned on at runtime with a -d
$:
ebug=0;
$::OverRide_PID_File = 0;
$::Grab_Use_Internal = 1;
sub print_ussage() {
##################################################################
#
# Pritns a short summary of caommand line options
#
# NOTE: this should _only_ be called by Getop::Mixed, as we use
# arguments passed to us by it
#
###################################################################
print "$0 Called with an invalid option: $_[1]\n\n";
print "Valid options:\n";
print " [-f config file]\n";
print " [-d debug level]\n";
print " [-i] force use of internal video graber code\n";
print " [-e] force use of external v4lctl program to capture images\n";
print " [-F] Run even if PID file exists\n";
# Can't call clean_house() here, as we have not yet parsed command line
# arguments _or_ config file, and we don't know where our logfile is
exit;
}
sub parse_command_line() {
##################################################################
#
# parse command line arguments and sets global variables
# optionaly set there
#
###################################################################
# Ok, let's do the config thing
# Parse the command line arguments
my ($option, $value, $pretty);
my $function_name = (caller(0))[3];
my $argtmp = join ', ', map "Arg$_ " .
( defined $_[$_] ? "->$_[$_]<-" :
'*UNDEF*'), 0 .. $#_;
print_debug(2,"Entering $function_name()\n",0,0);
Getopt::Mixed::init('F i e f=s d:i debug:i configfile=s');
$Getopt::Mixed::badOption = \&print_ussage;
while (($option, $value, $pretty) = nextOption()) {
if(( $option eq 'f') || ( $option eq 'configfile' ))
{
$::cfg_file = $value;
}
if(( $option eq 'd') || ( $option eq 'debug'))
{
$:
ebug = 1;
if($value > 1)
{
$:
ebug = $value;
}
}
if ($option eq 'F')
{
$::OverRide_PID_File = 1;
}
if ($option eq 'i')
{
$::Grab_Use_Internal = 1;
}
if ($option eq 'e')
{
$::Grab_Use_Internal = 0;
}
if ($:
ebug >= 4)
{
print("option = $option\n");
print("value = $value\n");
print("pretty = $pretty\n");
}
}
Getopt::Mixed::cleanup();
print_debug(3,"Returning from $function_name()\n",0,0);
}
sub parse_config_file() {
##################################################################
#
# parse config file and sets global variables optionaly set there
#
#
###################################################################
# Ok, let's do the config thing
my $function_name = (caller(0))[3];
my $argtmp = join ', ', map "Arg$_ " .
( defined $_[$_] ? "->$_[$_]<-" :
'*UNDEF*'), 0 .. $#_;
print_debug(2,"Entering $function_name()\n",0,0);
my $tmp;
my $state = AppConfig::State->new(
{
CASE => 1,
PEDANTIC => 0,
GLOBAL => {
DEFAULT => '<undef>',
ARGCOUNT => 1,
EXPAND_UID => 1,
EXPAND_ENV => 1,
},
}
);
$state->define("webcam_pid_file",
{
DEFAULT => "webcam.pid",
});
$state->define("webcam_pid_directory",
{
DEFAULT => "/opt/local/run/",
});
$state->define("webcam_log_file",
{
DEFAULT => "/opt/local/log/webcam.log",
});
$state->define("dest_dir",
{
DEFAULT => "/usr/images",
});
$state->define("movie_maker_script",
{
DEFAULT => "/home/stan/make_movie.pl",
});
$state->define("camera_ID",
{
DEFAULT => "camera1",
});
$state->define("im_lbl_color",
{
DEFAULT => "blue",
});
$state->define("dest_file_template",
{
DEFAULT => "%H_%M_%S",
# DEFAULT => "%M_%S",
});
$state->define("dest_directory_template",
{
DEFAULT => "%B_%d_%Y",
# DEFAULT => "%Y_%B_%d_%H",
});
$state->define("video_dev",
{
DEFAULT => "/dev/video0",
});
$state->define("interval_time",
{
DEFAULT => 10,
});
$state->define("label_font_size",
{
DEFAULT => 14,
});
$state->define("video_type",
{
# DEFAULT => "Composite1",
DEFAULT => "Television",
});
$state->define("loglevel",
{
DEFAULT => 3,
});
if ( ! -r $::cfg_file)
{
print("I can't read the config file that you have specifed: $::cfg_file\n");
print("I have a set of hardcoded configuration defaults that I am using\n");
}
else
{
my $cfgfile = AppConfig::File->new($state, $::cfg_file);
}
# Now load all of these vaules into a hash for use
# by the rest of the code
$::config{im_lbl_color} = $state->get("im_lbl_color");
$::config{webcam_pid_file} = $state->get("webcam_pid_file");
$::config{webcam_pid_directory} = $state->get("webcam_pid_directory");
$::config{webcam_log_file} = $state->get("webcam_log_file");
$::config{dest_dir} = $state->get("dest_dir");
$::config{video_dev} = $state->get("video_dev");
$::config{video_type} = $state->get("video_type");
$::config{interval_time} = $state->get("interval_time");
$::config{loglevel} = $state->get("loglevel");
$::config{dest_file_template} = $state->get("dest_file_template");
$::config{dest_directory_template} = $state->get("dest_directory_template");
$::config{camera_ID} = $state->get("camera_ID");
$::config{movie_maker_script} = $state->get("movie_maker_script");
$::config{label_font_size} = $state->get("label_font_size");
# Build PID file that's specific to my camera ID
# and combine filename and directory name into a fully qualifed
# path name for later use
if ( $::config{webcam_pid_directory} =~ m'/$' )
{
# add trailing slash if necessary
$::config{webcam_pid_directordirectory} = join '' , $::config{webcam_pid_directory} , '/';
}
$tmp = join '' , $::config{webcam_pid_directory} , '/' , $::config{camera_ID} , '.' , $::config{webcam_pid_file};
$::config{webcam_pid_file} = $tmp;
# Check to see if supplied dirctory name has a trailing slash and add if it
# not
if ( ! ( $::config{dest_dir} =~ m'/$' ))
{
# add trailing slash if necessary
$::config{dest_dir} = join '' , $::config{dest_dir} , '/';
}
$::config{dest_dir} = join '' , $::config{dest_dir} , $::config{camera_ID} , '/';
print_debug(3,"Returning from $function_name()\n",0,0);
}
sub logit($$$) {
##################################################################
#
# Log Status/Warning/Error messages
# Opens and closes the file each time, in case someone
# has selected the same logfile for both tasks
#
# Argument 1 is the class
# 1 = ERROR
# 2 = WARNING
# 3 = STATUS
#
# Argument 2 is the logfile name as a string
#
# Argument 3 is the message
#
# Note that the camera ID is added to the message
#
##################################################################
my $status = $_[0];
my $filename = $_[1];
my $msg = $_[2];
my $dayetime;
my $mstat;
my $datetime;
my $lock;
my $lck_status;
my $function_name = (caller(0))[3];
my $argtmp = join ', ', map "Arg$_ " .
( defined $_[$_] ? "->$_[$_]<-" :
'*UNDEF*'), 0 .. $#_;
print_debug(2,"Entering $function_name()\n",0,0);
print_debug(3,"$argtmp\n",0,0);
open FH, ">/tmp/webcam.log.lck";
$lock = new File::lockf(\*FH);
# Try to get a lock for writing
#
# Tries 3 times, waiting 1 second between each atempt
# If the lock atempt fails it comes back with
# a Non-Zero status.
$lck_status = $lock->slock(3, 1, 0);
if($lck_status ne 0)
{
#failure
print "Failed to obtain lock on logfile!!!!\n";
close FH;
unlink("/tmp/webcam.log.lck");
return ();
}
else
{
# got the lock
open( LOGFILE , ">>$filename");
LOGFILE->autoflush(1);
if($status == 1)
{
$mstat = "ERROR";
}
if($status == 2)
{
$mstat = "WARNING";
}
if($status == 3)
{
$mstat = "STATUS";
}
if($status > 3)
{
$mstat = "INFO";
}
if($::config{loglevel} >= $status)
{
$datetime = localtime();
print LOGFILE ("$0 PID $$ ID $::config{camera_ID} $datetime $mstat: $msg\n");
}
close LOGFILE;
print_debug(3,"Returning from $function_name()\n",0,0);
}
File::lockf::ulock FH;
close FH;
unlink("/tmp/webcam.log.lck");
}
sub clean_house($) {
##################################################################
#
# Dose end of program file closing and gnereal cleanup
#
###################################################################
my $remove_run_file = $_[0];
my $function_name = (caller(0))[3];
print_debug(2,"Entering $function_name()\n",0,0);
logit(1,
$::config{webcam_log_file},
"Exiting");
if ($remove_run_file == 1)
{
unlink($::config{webcam_pid_file});
}
exit;
}
sub addtime($$$$$) {
##################################################################
#
# reads in temporary capture file adds timestamp, and writes
# it to the permanent location
#
# Argument 1 is filename that the labled image should be stored as
#
# Argument 2 is the label to apply
#
# Argument 3 is the filename that the image is curently in
#
# Argument 4 is the color to label the image with
#
# Argument 5 is the font size to use for the label
#
###################################################################
my $final_filename = $_[0];
my $l_tstamp = $_[1];
my $l_tmpfile = $_[2];
my $l_lbl_color = $_[3];
my $l_lbl_size = $_[4];
my $image = Image::Magick->new(magick=>'GIF',font=>'clean');
my $function_name = (caller(0))[3];
my $argtmp = join ', ', map "Arg$_ " .
( defined $_[$_] ? "->$_[$_]<-" :
'*UNDEF*'), 0 .. $#_;
print_debug(2,"Entering $function_name()\n",0,0);
print_debug(3,"$argtmp\n",0,0);
$image->Read($l_tmpfile);
#On ajoute le text
$image->Annotate(fill=>'whie',
pointsize=>$l_lbl_size,
text=>$l_tstamp,
gravity=>'SouthWest',
stroke=>$l_lbl_color,
fill=>'black',
y=>(int($l_lbl_size * 1.4)));
#On écrit le fichier
$image->Write($final_filename);
print_debug(3,"Returning from $function_name()\n",0,0);
}
sub print_debug($$$$) {
##################################################################
#
# Print debug message to STDERR with appropriate number
# of leading "-"s to show level of debuging required
# to invoke this message
#
# Argument 1 is the debuging level required to get this mesage
# Argument 2 is the message
# Argument 3 is a flag to get a datestamp
# Argument 4 is a flag to get PID printed
#
##################################################################
my ($level, $msg, $need_date, $pid_flag) = @_;
my $leader = '';
my $datetime = '';
my $i = 0;
STDERR->autoflush(1);
if ($:
ebug >= $level)
{
if($pid_flag == 1)
{
$leader = " PID->$$: "
}
for ($i = 1; $i <= $level; $i++) {
$leader = "$leader-";
}
$leader = "$leader ";
$msg = "$leader$msg";
if ($need_date == 1)
{
$datetime = localtime();
# Yes, the leading space is on purpose
# It helps to sort out these from the other
# noise the program may be putting ot
# If I asked for a datestamp, then I'm probably
# be scaning through the noise, looking for timeing
# rleationships
print STDERR (" $0: $datetime: $msg");
}
else
{
print STDERR ("$0: $msg");
}
}
}
sub grab_one($$) {
##################################################################
#
# grab_one
#
# Grabs one frame from video capture card
#
# Argument 1 is the name of the file to save to
#
# Argument 2 is the video object
#
# Retruns 1 if capture succceded, 0 otherwise
#
##################################################################
my $l_tmpfile = $_[0];
my $grab = $_[1];
my $function_name = (caller(0))[3];
my $argtmp = join ', ', map "Arg$_ " .
( defined $_[$_] ? "->$_[$_]<-" :
'*UNDEF*'), 0 .. $#_;
print_debug(2,"Entering $function_name()\n",0,0);
print_debug(3,"$argtmp\n",0,0);
my $fr;
my $temp = '';
$| = 1;
my $frame = 0;
my $count = 0;
$fr = $grab->capture( $frame, 844 , 576 );
for ( 0 .. 1 ) {
my $nfr = $grab->capture( 1 - $frame, 844, 576 );
if ( ! $grab->sync($frame))
{
logit(1,
$::config{webcam_log_file},
"Can't synch this frame");
return(0);
}
unless ( $count == 0 ) {
# save $fr now, as it contains the raw BGR data
$temp = '';
if( ! open( JP, '>', \$temp ))
{
logit(1,
$::config{webcam_log_file},
"Can't Open temporary file $temp");
return(0);
}
print JP "P6\n840 576\n255\n"; #header
$nfr = reverse $nfr;
print JP $nfr;
close JP;
my $img = Imager->new();
if ( ! $img->read( data => $temp, type => 'pnm' ))
{
logit(1,
$::config{webcam_log_file},
"$img->errstr()");
}
$img->flip( dir => "hv" );
if ( ! $img->write( data => \$temp, type => 'jpeg' ))
{
logit(1,
$::config{webcam_log_file},
"$img->errstr()");
}
}
$count++;
$frame = 1 - $frame;
$fr = $nfr;
} # endfor
# Save it
if( ! open( JP, "> $l_tmpfile" ))
{
logit(1,
$::config{webcam_log_file},
"Can't Open temporary file $l_tmpfile");
return(0);
}
print JP $temp;
close JP;
print_debug(3,"Returning from $function_name()\n",0,0);
return(1);
}
sub init_video($) {
##################################################################
#
# init_video
#
# set up capture card initialy
#
# Argument 1 is the ID of the card
#
##################################################################
my $l_video_dev = $_[0];
my $function_name = (caller(0))[3];
my $argtmp = join ', ', map "Arg$_ " .
( defined $_[$_] ? "->$_[$_]<-" :
'*UNDEF*'), 0 .. $#_;
print_debug(2,"Entering $function_name()\n",0,0);
print_debug(3,"$argtmp\n",0,0);
my $grab = new Video::Capture::V4l($l_video_dev)
or die "Unable to open Videodevice: $!";
# the following initializes the camera for NTSC
my $channel = $grab->channel(0);
my $tuner = $grab->tuner(0);
$tuner->mode(1);
$channel->norm(1);
$tuner->set;
$channel->set;
print_debug(3,"Returning from $function_name()\n",0,0);
return($grab);
}
# main()
my @t;
my @fields;
my $tt;
my $incd;
my $my_pid;
my $handle;
my $filename;
my $last_field;
my $grab;
my $good_frame;
my $sleep_time;
my ($last_trigger_time, $grab_time);
my ($movie_dirname , $movie_filename);
my ($tmp , $tmp2);
my ($dcount, $ndcount);
my $timestamp;
my $dirname = '';
my $prev_dirname = '';
my $tmpfile = "/tmp/webcam$$.jpeg";
parse_command_line();
parse_config_file();
if($::OverRide_PID_File != 1)
{
if( -r $::config{webcam_pid_file})
{
# add log event here.
logit(3,
$::config{webcam_log_file},
"Can'r run because $::config{webcam_pid_file} exists, and th -F flag was not specifed");
print "I see a PID file for my camera ID exists already\n";
print "So, it appears thta there is already a copy of me running\n";
print "If this is incorrect, you can either remove $::config{webcam_pid_file}\n";
print "Or use the -F argument on the command line, when you start me\n";
clean_house(0);
}
}
# Create the run file, also used for signaling me to shutdown
# Removal of this file by an external
# entity (task, person) is the prefered way of cleanly terminating
# this program
$my_pid = $$;
# Write my PID to the run status file
open( PIDFILE , ">$::config{webcam_pid_file}");
print PIDFILE "$my_pid\n";
close PIDFILE;
logit(3,
$::config{webcam_log_file},
"Started");
# FIXME
if ($::Grab_Use_Internal != 1)
{
system("/usr/bin/v4lctl -c $::config{video_dev} setinput $::config{video_type}");
}
else
{
$grab = init_video($::config{video_dev});
}
$dcount = Devel::Leak::NoteSV($handle);
while (1) # Forever
{
# This program inherently will run forever
# To cause it to stop, remove it's pid file
if( ! (-r $::config{webcam_pid_file}))
{
last;
}
$last_trigger_time = gettimeofday;
logit(6,
$::config{webcam_log_file},
"Start of loop, elapsed time in this capture 0 seconds");
# if $dirname contains a / then it must have already been set up
# so we need to save a copy that will be used later
# # to check to se if it has been changed
# we use this to trigger directory completion processing
if ( $dirname =~ m'[^/]' )
{
$prev_dirname = $dirname;
}
# Build directory name
@t = localtime(time);
$dirname = strftime $::config{dest_directory_template} , @t;
$dirname = join '' , $::config{dest_dir} , $dirname , '/';
# build filename
$filename = strftime $::config{dest_file_template} , @t;
$filename = join '' , $filename , '.jpeg';
# Does the destination directory exist?
if( ! (-r $dirname))
{
# No, need to create it
# This is also the place to add any processing that
# may be required at directory creation time
logit(3,
$::config{webcam_log_file},
"Need to create new directory $dirname");
eval { mkpath($dirname) };
if ($@)
{
logit(1,
$::config{webcam_log_file},
"Failed to create new directory $dirname");
print "Failed to creat directory $dirname\n";
clean_house(1);
}
# Ok we've created the new directory
# Were we using one before? Or is this initial
# startup ?
if ( $prev_dirname =~ m'/$' )
{
if(-r $prev_dirname)
{
# Post directory fill processing goes hee
# Trigger mpeg creation here
# Build directory name
$movie_dirname = $::config{dest_dir};
# Does the destination directory exist?
if( ! (-r $movie_dirname))
{
# No, need to create it
logit(3,
$::config{webcam_log_file},
"Need to create new directory $movie_dirname");
eval { mkpath($movie_dirname) };
if ($@)
{
logit(1,
$::config{webcam_log_file},
"Failed to create new directory $movie_dirname");
print "Failed to create directory $dirname\n";
clean_house(1);
}
}
@fields = split "/", $prev_dirname;
$last_field = $fields[(scalar(@fields) - 1)];
$movie_filename = join '' , $last_field , ".mpeg";
logit(3,
$::config{webcam_log_file},
"Creating new movie file from the contents of directory $prev_dirname it's filename will be $movie_filename. It will be placed in $movie_dirname");
system("$::config{movie_maker_script} -s $prev_dirname -p $movie_dirname -c $movie_filename &");
}
}
}
# trigger capture here
$tt = gettimeofday-$last_trigger_time;
logit(6,
$::config{webcam_log_file},
"Elapsed time just before capture is called $tt");
if ($::Grab_Use_Internal != 1)
{
system("/usr/bin/v4lctl -c $::config{video_dev} snap jpeg 844x576 $tmpfile");
$good_frame = 1;
}
else
{
$good_frame = grab_one($tmpfile,$grab);
}
$tt = gettimeofday-$last_trigger_time;
logit(6,
$::config{webcam_log_file},
"Elapsed time just after capture is called $tt");
if( $good_frame == 1)
{
# Create string to label image with
$timestamp = scalar(localtime(time));
$tmp = join '' , $dirname, $filename;
$tmp2 = join '' , ' ' ,$::config{camera_ID} , ' - ' , $timestamp;
addtime($tmp,
$tmp2,
$tmpfile,
$::config{im_lbl_color},
$::config{label_font_size});
}
unlink($tmpfile);
$tt = gettimeofday-$last_trigger_time;
logit(6,
$::config{webcam_log_file},
"Elapsed time just after timestamping $tt");
$grab_time = gettimeofday-$last_trigger_time;
$sleep_time = $::config{interval_time} - $grab_time;
$grab_time = sprintf "%0.9f" , $grab_time;
$sleep_time = sprintf "%0.9f" , $sleep_time;
if ($sleep_time < (0.5 * $::config{interval_time})) # < 50%
{
print BOLD RED ON_WHITE "Grab time = $grab_time Sleep time = $sleep_time";
}
else
{
if ($sleep_time < (0.7 * $::config{interval_time})) # > 50% < 70%
{
print BOLD RED ON_BLACK "Grab time = $grab_time Sleep time = $sleep_time";
}
else # > 70%
{
print BOLD BLUE ON_BLACK "Grab time = $grab_time Sleep time = $sleep_time";
}
}
print "\n";
logit(3,
$::config{webcam_log_file},
"Total time to capture and procees this image $grab_time seconds");
logit(4,
$::config{webcam_log_file},
"Need to sleep for $sleep_time seconds");
if($sleep_time < 1)
{
logit(1,
$::config{webcam_log_file},
"You're pushing it buster, I almost didn't get back to grab a frame");
}
if($sleep_time <= 0)
{
logit(1,
$::config{webcam_log_file},
"Frame missed due to system load!");
}
# The standard high resolution timer, sleeps for the value in the last
# argument in seconds.
select undef, undef, undef, $sleep_time;
$ndcount = Devel::Leak::CheckSV($handle);
if($dcount != $ndcount)
{
$incd = $ndcount - $dcount;
print "------> $incd more objects found\n";
}
$dcount = Devel::Leak::NoteSV($handle);
}
logit(3,
$::config{webcam_log_file},
"Normal exit");
clean_house(1);