Re: long running perl programs & memory untilization

From: Stan Brown (stanb_at_panix.com)
Date: 11/15/03 

Date: Sat, 15 Nov 2003 13:46:03 +0000 (UTC)

In <bp1547$h0a$2@wisteria.csv.warwick.ac.uk> Ben Morrow <usenet@morrow.me.uk> writes:

>Stan Brown <stanb@panix.com> wrote:
>> In <20031113163837.417$N1@newsreader.com> ctcgag@hotmail.com writes:
>>
>> >Stan Brown <stanb@panix.com> wrote:
>> >>
>> >> Thanks. The latest one of these "long running" scripts to exhibit this
>> >> behavior, is really quite simple, in what it does, and has no real
>> >> complex data structures.
>> >>
>> >> I suppose it would be inappropriate to post it here for criticism, right?
>>
>> >As long as the script is short and strict, it wouldn't be at all
>> >inappropriate. Does the script run full-bore for months, or is it some
>> >kind of server-like thing that spends most of it's time waiting?
>>
>> It does setup stuff (a lot of that), and then goes into a loop. In this
>> loop it does a system call

>This is a little confusing... when I first read it, I parsed it as
>'system call' in the sense of something like fcntl(2). It would be
>better to say 'it runs v4lctl with system()' or something :).

>> 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 :-(

>What does it do with the image? Are you sure you aren't keeping them
>all in memory somewhere by mistake?

>Post just the loop for us to have a look at.

Well, since I aparantely ofended all of you by posting it all, as I judge
from zero reolies, here is the cut down version:

#!/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::Dumper;
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::Path;
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
$::Debug=0;

$::OverRide_PID_File = 0;
$::Grab_Use_Internal = 1;

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=>'white',
                            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 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);
}

# 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";

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);

No matter whether this is run with the "internal" graber, or the external
system(0 call to v4lctl it grows rapidly.

What am I doing wrong. 

-- 
"They that would give up essential liberty for temporary safety deserve
neither liberty nor safety."
						-- Benjamin Franklin

Relevant Pages

  • Re: Which Is Better?
    ... The reason they gave was from a DBA perpspective like it was ... MERGE really necessary here - do you do any inserts in that loop, ... statistics for both approaches and compare them to see what could ... Did you capture any other statistics aside from run time ...
    (comp.databases.oracle.misc)
  • filenames with spaces and list in a for loop
    ... Second attempt was to double quote the "`ls -1A $1`", which generates ONE huge argument to the for loop. ... Unfortunately, the list also generates a newline every 80 characters in the $LIST, so once in a while I was left with each_item being set to something like "\nfilename". ... At the first occurrence of $each_item in the function I would get something like <filename> not found. ... what if I have a directory with more than 65000 characters worth? ...
    (comp.unix.shell)
  • Re: PLL and SYNC question
    ... I implemented 1st order passive low pass filter as the loop filter. ... > I've implemented software PLLs up to 80kHz on modern DSP chips. ... > The key is to use a timer for the phase detector. ... > capture input you can capture the timer's phase at the instant that the ...
    (sci.electronics.design)
  • Re: long running perl programs & memory untilization
    ... >loop it does a system call to v4lctl to capture an image, ... sub parse_command_line{ ... # parse config file and sets global variables optionaly set there ... # and combine filename and directory name into a fully qualifed ...
    (comp.lang.perl.misc)
  • Re: DTS query result to file - can I loop it?
    ... How to loop through a global variable Rowset ... How can I change the filename for a text file connection? ... The values for @MyType are stored in a database table so a cursor ... > existing DTS package or will I have to create a new package to handle each ...
    (microsoft.public.sqlserver.dts)