long running perl programs & memory untilization

Discussion in 'Perl Misc' started by Stan Brown, Nov 13, 2003.

  1. Stan Brown

    Stan Brown Guest

    I find myself in the position of writing long running (months) perl scripts
    under FreeBSD, and Linux.

    I seem to be having a lot of problems with memory leaks.

    I was wondering if anyone had some words of wisdom as to how toadress these
    issues? I'm interested in tips for avoiding them, as well as techniqies for
    diagnsing existing problems.

    If it helps my 'Native: language is C, and I just can't see anyway thet
    these scripts should be leaking memory, based upon that experience.

    I tend to use a lot of "local" variablse in subroutines, and allmost no
    "global" variables at all. if that impacts this discussion.

    Thanks for any wisdom that the comunity might be willing to share, and of
    course, as always, pointers to docs are appreciated.

    --
    "They that would give up essential liberty for temporary safety deserve
    neither liberty nor safety."
    -- Benjamin Franklin
     
    Stan Brown, Nov 13, 2003
    #1
    1. Advertising

  2. Stan Brown

    Helgi Briem Guest

    On Thu, 13 Nov 2003 13:19:30 +0000 (UTC), Stan Brown <>
    wrote:

    >If it helps my 'Native: language is C, and I just can't see anyway thet
    >these scripts should be leaking memory, based upon that experience.
    >
    >I tend to use a lot of "local" variablse in subroutines, and allmost no
    >"global" variables at all. if that impacts this discussion.


    Well, that probably explains most of it. 'local' in Perl is
    nothing like 'local' in C, but more like the opposite. It is
    used to change the value of a global variable for use locally.

    In Perl you should use 'my' to localise variables.
     
    Helgi Briem, Nov 13, 2003
    #2
    1. Advertising

  3. Stan Brown

    Ben Morrow Guest

    Helgi Briem <> wrote:
    > On Thu, 13 Nov 2003 13:19:30 +0000 (UTC), Stan Brown <>
    > wrote:
    >
    > >If it helps my 'Native: language is C, and I just can't see anyway thet
    > >these scripts should be leaking memory, based upon that experience.
    > >
    > >I tend to use a lot of "local" variablse in subroutines, and allmost no
    > >"global" variables at all. if that impacts this discussion.

    >
    > Well, that probably explains most of it. 'local' in Perl is
    > nothing like 'local' in C, but more like the opposite. It is
    > used to change the value of a global variable for use locally.
    >
    > In Perl you should use 'my' to localise variables.


    While this is true, it shouldn't lead to memory leaks.

    The usual reason for memory leaks is that you have data structures
    with circular references---the simplest case is '$x = \$x'---which can
    therefore never be garbage collected. You need to break these
    references when you don't need them, either by undefing the variables
    concerned or by using WeakRef from CPAN.

    Ben

    --
    Every twenty-four hours about 34k children die from the effects of poverty.
    Meanwhile, the latest estimate is that 2800 people died on 9/11, so it's like
    that image, that ghastly, grey-billowing, double-barrelled fall, repeated
    twelve times every day. Full of children. [Iain Banks]
     
    Ben Morrow, Nov 13, 2003
    #3
  4. Stan Brown

    Stan Brown Guest

    In <> Helgi Briem <> writes:

    >On Thu, 13 Nov 2003 13:19:30 +0000 (UTC), Stan Brown <>
    >wrote:


    >>If it helps my 'Native: language is C, and I just can't see anyway thet
    >>these scripts should be leaking memory, based upon that experience.
    >>
    >>I tend to use a lot of "local" variablse in subroutines, and allmost no
    >>"global" variables at all. if that impacts this discussion.


    >Well, that probably explains most of it. 'local' in Perl is
    >nothing like 'local' in C, but more like the opposite. It is
    >used to change the value of a global variable for use locally.


    >In Perl you should use 'my' to localise variables.


    Sorry if I was not clear here. I am of course, using my $var; to
    declare these "local" variables, in each subroutine. I was not even
    aware of the "local" keyword in perl, untill now.


    --
    "They that would give up essential liberty for temporary safety deserve
    neither liberty nor safety."
    -- Benjamin Franklin
     
    Stan Brown, Nov 13, 2003
    #4
  5. Stan Brown

    Stan Brown Guest

    In <bp08gv$46v$> Ben Morrow <> writes:


    >Helgi Briem <> wrote:
    >> On Thu, 13 Nov 2003 13:19:30 +0000 (UTC), Stan Brown <>
    >> wrote:
    >>
    >> >If it helps my 'Native: language is C, and I just can't see anyway thet
    >> >these scripts should be leaking memory, based upon that experience.
    >> >
    >> >I tend to use a lot of "local" variablse in subroutines, and allmost no
    >> >"global" variables at all. if that impacts this discussion.

    >>
    >> Well, that probably explains most of it. 'local' in Perl is
    >> nothing like 'local' in C, but more like the opposite. It is
    >> used to change the value of a global variable for use locally.
    >>
    >> In Perl you should use 'my' to localise variables.


    >While this is true, it shouldn't lead to memory leaks.


    >The usual reason for memory leaks is that you have data structures
    >with circular references---the simplest case is '$x = \$x'---which can
    >therefore never be garbage collected. You need to break these
    >references when you don't need them, either by undefing the variables
    >concerned or by using WeakRef from CPAN.


    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?

    --
    "They that would give up essential liberty for temporary safety deserve
    neither liberty nor safety."
    -- Benjamin Franklin
     
    Stan Brown, Nov 13, 2003
    #5
  6. Stan Brown

    Ben Morrow Guest

    Stan Brown <> wrote:
    > In <bp08gv$46v$> Ben Morrow
    > <> writes:
    > >The usual reason for memory leaks is that you have data structures
    > >with circular references---the simplest case is '$x = \$x'---which can
    > >therefore never be garbage collected. You need to break these
    > >references when you don't need them, either by undefing the variables
    > >concerned or by using WeakRef from CPAN.

    >
    > 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?


    Well, if either it's pretty short or you can cut it down to something
    as short as possible that still leaks (guess which is better :), then
    I'm sure noone would mind...

    Ben

    --
    Musica Dei donum optimi, trahit homines, trahit deos. |
    Musica truces molit animos, tristesque mentes erigit. |
    Musica vel ipsas arbores et horridas movet feras. |
     
    Ben Morrow, Nov 13, 2003
    #6
  7. Stan Brown

    Guest

    Stan Brown <> 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?

    Xho

    --
    -------------------- http://NewsReader.Com/ --------------------
    Usenet Newsgroup Service New Rate! $9.95/Month 50GB
     
    , Nov 13, 2003
    #7
  8. Stan Brown

    Stan Brown Guest

    In <20031113163837.417$> writes:

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

    --
    "They that would give up essential liberty for temporary safety deserve
    neither liberty nor safety."
    -- Benjamin Franklin
     
    Stan Brown, Nov 13, 2003
    #8
  9. Stan Brown

    Ben Morrow Guest

    Stan Brown <> wrote:
    > In <20031113163837.417$> writes:
    >
    > >Stan Brown <> 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.

    Ben

    --
    Like all men in Babylon I have been a proconsul; like all, a slave ... During
    one lunar year, I have been declared invisible; I shrieked and was not heard,
    I stole my bread and was not decapitated.
    ~ ~ Jorge Luis Borges, 'The Babylon Lottery'
     
    Ben Morrow, Nov 13, 2003
    #9
  10. Stan Brown

    Stan Brown Guest

    In <bp13qj$puu$> Stan Brown <> writes:

    >In <20031113163837.417$> writes:


    >>Stan Brown <> 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 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::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 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'))
    {
    $::Debug = 1;
    if($value > 1)
    {
    $::Debug = $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 ($::Debug >= 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 ($::Debug >= $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);
    --
    "They that would give up essential liberty for temporary safety deserve
    neither liberty nor safety."
    -- Benjamin Franklin
     
    Stan Brown, Nov 14, 2003
    #10
  11. Stan Brown

    Stan Brown Guest

    In <bp1547$h0a$> Ben Morrow <> writes:


    >Stan Brown <> wrote:
    >> In <20031113163837.417$> writes:
    >>
    >> >Stan Brown <> 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?


    Well, I don't think so, it's writen to a file, and the actual capture is
    done in a subrotuine, so all of it's variable should go out of scope upon
    retrun from that subrotuine, right?

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


    Oops!

    Sorry, I should have read this _before_ posting the whole thing :-(

    I'll avoid the temptation to post just the loop, again :)

    --
    "They that would give up essential liberty for temporary safety deserve
    neither liberty nor safety."
    -- Benjamin Franklin
     
    Stan Brown, Nov 14, 2003
    #11
  12. > 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 :-(
    >


    Hi Everyone,

    I am no Perl guru and not at all familiar with memory management under Linux
    or Unix. But I have experience with images.

    Have you considered that the problem may be memory fragmentation rather than
    a memory leak? Images typically require large CONTIGUOUS blocks of memory
    so, if the memory manager des not occasional compact free memory, that kind
    of situation can easily occur. I have seen this with older versions of
    Windows, such as Windows 95 and Windows 98.

    If your images are all of the same size, fragmentation is less likely, but
    otherwise...

    If fragmentation is impossible, I will be glad to know this. Otherwise, you
    might have to write your own memory manager for your images.

    My two bits,

    Michèle Ouellet
    Stelvio Inc.
     
    Michele Ouellet, Nov 14, 2003
    #12
  13. Stan Brown

    Stan Brown Guest

    In <qu4tb.9323$> "Michele Ouellet" <> writes:

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


    >Hi Everyone,


    >I am no Perl guru and not at all familiar with memory management under Linux
    >or Unix. But I have experience with images.


    >Have you considered that the problem may be memory fragmentation rather than
    >a memory leak? Images typically require large CONTIGUOUS blocks of memory
    >so, if the memory manager des not occasional compact free memory, that kind
    >of situation can easily occur. I have seen this with older versions of
    >Windows, such as Windows 95 and Windows 98.


    I can't see how that would cause the size of teh perl script process to
    grow.

    Or perhaps I'm missing something here?
    --
    "They that would give up essential liberty for temporary safety deserve
    neither liberty nor safety."
    -- Benjamin Franklin
     
    Stan Brown, Nov 14, 2003
    #13
  14. Stan Brown

    Ben Morrow Guest

    Stan Brown <> wrote:
    > In <qu4tb.9323$> "Michele Ouellet"
    > <> writes:
    > >Have you considered that the problem may be memory fragmentation rather than
    > >a memory leak? Images typically require large CONTIGUOUS blocks of memory
    > >so, if the memory manager des not occasional compact free memory, that kind
    > >of situation can easily occur. I have seen this with older versions of
    > >Windows, such as Windows 95 and Windows 98.

    >
    > I can't see how that would cause the size of teh perl script process to
    > grow.
    >
    > Or perhaps I'm missing something here?


    If you have a braindead memory manager like Win9x's which never
    compacts, then what can happen is this:

    1. Perl requests a 10Mb (say) block for an image. The process's
    address space is increased by 10Mb.

    2. Perl frees the image. The 10Mb goes back into the process's free
    space pool (note that it does not go back to the OS: in general,
    a process's address space never shrinks).

    3. Perl requests some more small allocations, which get made out of
    the now free 10Mb block.

    4. Perl requests the next 10Mb block. There is now no continuous block
    of memory that large in the process's free space pool, as the one
    we released last time now has some small allocations somewhere in
    the middle. So we increase the process size by another 10Mb.

    5. Goto 2.

    This shouldn't happen under any decent OS, as the malloc
    implementation should detect that fragmentation is occurring and
    compact the free space pool.

    --
    don't get my sympathy hanging out the 15th floor. you've changed the locks 3
    times, he still comes reeling though the door, and soon he'll get to you, teach
    you how to get to purest hell. you do it to yourself and that's what really
    hurts is you do it to yourself just you, you and noone else *
     
    Ben Morrow, Nov 14, 2003
    #14
  15. Stan Brown

    Stan Brown Guest

    In <bp1547$h0a$> Ben Morrow <> writes:


    >Stan Brown <> wrote:
    >> In <20031113163837.417$> writes:
    >>
    >> >Stan Brown <> 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
     
    Stan Brown, Nov 15, 2003
    #15
  16. Stan Brown

    Ben Morrow Guest

    Stan Brown <> wrote:
    > In <bp1547$h0a$> Ben Morrow
    > <> writes:
    > >Stan Brown <> wrote:
    > >> In <20031113163837.417$> writes:
    > >>
    > >> >Stan Brown <> 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:


    Well, speaking for myself, I was hardly offended :). I just couldn't
    see anything obvious, and didn't really feel like trying to understand
    all that code.

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


    Part of providing a minimal example is removing all modules that can
    be removed while still leaking. IMHO (and not really having much
    justification for this beyond instinct), the only modules likely to
    cause leaks here are Image::Magick, Imager and V::C::V4l. As you say
    below that it still leaks if you use system() to run v4lctl, I reckon
    your problem may be with Image::Magick. What happens if you just run
    your addtime() routine in a loop?

    If that doesn't leak, then try again, cutting out *absolutely*
    *everything* you can that doesn't stop the leak.

    > $::cfg_file = "/opt/local/lib/webcam.conf";


    On an unrelated subject, doing this rather defeats the point of
    strictures. You shoould write

    our $cfg_file = "/opt/local/lib/webcam.conf";

    and then refer to $cfg_file thereafter.

    Ben

    --
    Like all men in Babylon I have been a proconsul; like all, a slave ... During
    one lunar year, I have been declared invisible; I shrieked and was not heard,
    I stole my bread and was not decapitated.
    ~ ~ Jorge Luis Borges, 'The Babylon Lottery'
     
    Ben Morrow, Nov 15, 2003
    #16
  17. Stan Brown

    Stan Brown Guest

    In <bp5gho$e4a$> Ben Morrow <> writes:


    >Stan Brown <> wrote:
    >> In <bp1547$h0a$> Ben Morrow
    >> <> writes:
    >> >Stan Brown <> wrote:
    >> >> In <20031113163837.417$> writes:
    >> >>
    >> >> >Stan Brown <> 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:



    >On an unrelated subject, doing this rather defeats the point of
    >strictures. You shoould write


    > our $cfg_file = "/opt/local/lib/webcam.conf";


    >and then refer to $cfg_file thereafter.


    Thanks, that ugliness had been bothering me for years, but I didn't
    understand how to clean it up.

    Tha tip is very much appreciated!
    --
    "They that would give up essential liberty for temporary safety deserve
    neither liberty nor safety."
    -- Benjamin Franklin
     
    Stan Brown, Nov 15, 2003
    #17
  18. Stan Brown

    Stan Brown Guest

    In <bp5gho$e4a$> Ben Morrow <> writes:


    >Stan Brown <> wrote:
    >> In <bp1547$h0a$> Ben Morrow
    >> <> writes:
    >> >Stan Brown <> wrote:
    >> >> In <20031113163837.417$> writes:
    >> >>
    >> >> >Stan Brown <> wrote:
    >> >> >>


    >Part of providing a minimal example is removing all modules that can
    >be removed while still leaking. IMHO (and not really having much
    >justification for this beyond instinct), the only modules likely to
    >cause leaks here are Image::Magick, Imager and V::C::V4l. As you say
    >below that it still leaks if you use system() to run v4lctl, I reckon
    >your problem may be with Image::Magick. What happens if you just run
    >your addtime() routine in a loop?


    Good catch, I replaced the addtiem subroutine with a simple rename call,
    which does aeverything that the original subroutine does _except_ adding
    the timestamp to the image, and that appears to ahve stoped teh memory
    leak.

    I grabed the majority of the code for that loop from a perl script that I
    found on one of my debian machines. Unfortunately teh comments were in
    French, which I don't speak, so perhaps I munged up the use of it.

    I'm enclosing a copyt of just thta subroutine, in the hope that someone can
    point out how I'm miss using it. Or sugest an alternative way of doing the
    same thing.

    Thanks for everyone's patienace with thie!



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

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

    The call to this subroutine is followed (in main() imediately by:


    unlink($tmpfile);

    Anyone see anything wrong with this?
    --
    "They that would give up essential liberty for temporary safety deserve
    neither liberty nor safety."
    -- Benjamin Franklin
     
    Stan Brown, Nov 17, 2003
    #18
    1. Advertising

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. George Marsaglia

    Assigning unsigned long to unsigned long long

    George Marsaglia, Jul 8, 2003, in forum: C Programming
    Replies:
    1
    Views:
    749
    Eric Sosman
    Jul 8, 2003
  2. Daniel Rudy

    unsigned long long int to long double

    Daniel Rudy, Sep 19, 2005, in forum: C Programming
    Replies:
    5
    Views:
    1,247
    Peter Shaggy Haywood
    Sep 20, 2005
  3. Mathieu Dutour

    long long and long

    Mathieu Dutour, Jul 17, 2007, in forum: C Programming
    Replies:
    4
    Views:
    517
    santosh
    Jul 24, 2007
  4. Bart C

    Use of Long and Long Long

    Bart C, Jan 9, 2008, in forum: C Programming
    Replies:
    27
    Views:
    853
    Peter Nilsson
    Jan 15, 2008
  5. Casey Hawthorne
    Replies:
    14
    Views:
    467
Loading...

Share This Page