[23592] in Perl-Users-Digest
Perl-Users Digest, Issue: 5799 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Fri Nov 14 00:10:42 2003
Date: Thu, 13 Nov 2003 21:10:09 -0800 (PST)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Thu, 13 Nov 2003 Volume: 10 Number: 5799
Today's topics:
Re: long running perl programs & memory untilization <stanb@panix.com>
Re: long running perl programs & memory untilization <stanb@panix.com>
Re: newbie dealings with OS "grep -P" <usenet@morrow.me.uk>
Re: plain simple cheap fair <ywegqej@nexruv.org>
Re: plain simple cheap fair <jurgenex@hotmail.com>
Re: plain simple cheap fair (Tad McClellan)
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Fri, 14 Nov 2003 03:32:09 +0000 (UTC)
From: Stan Brown <stanb@panix.com>
Subject: Re: long running perl programs & memory untilization
Message-Id: <bp1ibp$1bm$1@reader2.panix.com>
In <bp13qj$puu$1@reader2.panix.com> Stan Brown <stanb@panix.com> writes:
>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 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=>'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 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
------------------------------
Date: Fri, 14 Nov 2003 03:34:58 +0000 (UTC)
From: Stan Brown <stanb@panix.com>
Subject: Re: long running perl programs & memory untilization
Message-Id: <bp1ih2$1bm$2@reader2.panix.com>
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?
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
------------------------------
Date: Fri, 14 Nov 2003 02:57:38 +0000 (UTC)
From: Ben Morrow <usenet@morrow.me.uk>
Subject: Re: newbie dealings with OS "grep -P"
Message-Id: <bp1gb2$m99$1@wisteria.csv.warwick.ac.uk>
Pedro Graca <hexkid@hotpop.com> wrote:
> #!/usr/bin/perl -nsw
> # use strict; ## BEGIN does not like strict
There is no problem with BEGIN and strictures. You do have to make
sure all variables are declared before you use them: if you are going
to use them both inside and outside the BEGIN block then the
declaration must come before the BEGIN block. So here you would need:
> # grepp [-I] pattern [file1 [file2 [...]]]
my ($expr, $regex);
> BEGIN {
> $expr = shift; ## need error checking!!!
> $regex = qr/$expr/i;
> { no warnings; ## -I might not have been specified
Doesn't matter... undef is perfectly false and won't give a warning
here. $expr might, though, if you don't specify an expression.
> if ($I) { $regex = qr/$expr/; }
> } # end no warnings
> $\ = "\n"; ## nice little trick
Another nice trick is -l, which does the chomp as well.
> }
>
> chomp;
> print if /$regex/;
>
>
> Now I'm working on grepp4, trying to add options from the 'real' grep.
> + -c == only count matches
> + -H == print the file name
> + -n == print the line number
> + -V == print version and exit
>
> but I don't like having the "use strict;" out.
That is a good instinct. Cultivate it... :)
> Is it better to manually shift all parameters and verify if they're
> options or the pattern or filenames?
I would suggest that it would be better to use one of the Getopt
modules from CPAN, probably Getopt::Std.
> Did I do something wrong with the "perl -s", "use strict;" and "BEGIN"
> block?
If you use -s, then the variable it creates are globals, so you must
declare them with 'our' rather than with 'my'.
Ben
--
'Deserve [death]? I daresay he did. Many live that deserve death. And some die
that deserve life. Can you give it to them? Then do not be too eager to deal
out death in judgement. For even the very wise cannot see all ends.'
:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-: ben@morrow.me.uk
------------------------------
Date: Fri, 14 Nov 2003 00:10:59 GMT
From: Kareem Allahdad al Najjar <ywegqej@nexruv.org>
Subject: Re: plain simple cheap fair
Message-Id: <4395ac67.5d6e5c9a@news.ycapp.org>
On 14 Nov 2003 00:10:59 GMT, Ricky@lynvyw.org wrote:
>
>Rethink the Cool + the Shoe
>
>phil knight had a dream. he'd sell shoes. he'd sell dreams.
>he'd get rich. he'd use sweatshops if he had to.
>
>then along came a new shoe. plain. simple. cheap. fair.
>designed for only one thing: kicking phil's ass.
>
>the unswoosher
>
>$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
>
>For years, Nike was the undisputed champion of logo culture,
>its swoosh an instant symbol of global cool.
>
>Today, Phil Knight's Nike is a fading empire, badly hurt by
>years of "brand damage" as activists and culture jammers
>fought back against mindfuck marketing and dirty sweatshop labor.
>
>Now a final challenge. We take on Phil at his own game - and win.
>We turn the shoes we wear into a counterbranding game. The swoosh
>versus the anti-swoosh. Which side are you on?
>
>Adbusters has been doing R&D for more than a year, and guess what?
>Making a shoe - a good shoe - isn't exactly rocket science.
>With a network of supporters, we're getting ready to launch the
>blackSpot sneaker, the world's first grassroots anti-brand.
>You can help launch the blackSpot revolution.
>
>THE BIG QUESTION:
>
> Is it possible to take Phil Knight's billion-dollar
> marketing momentum and, in a quick judo-like move, slap
> him onto the mat with the power of his own PR thrust?
>
>OUR KICK-ASS MARKETING STRATEGY >> http://blackspotsneaker.org
>
>$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
>
>buy it............................preorders@blackspotsneaker.org
>
>sell it...........................wholesale@blackspotsneaker.org
>
>invest in it......................investors@blackspotsneaker.org
>
>support it........................donations@blackspotsneaker.org
>
>join the jam........................jammers@blackspotsneaker.org
>
> Make a straight donation... it's a worthy cause
> with the potential to set an historic precedent
> that could be repeated in other industries and
> usher in more grass roots version of capitalism
> in which megacorps do not control every area of
> our children's lives.
>
>https://www.groundspring.org/donate/index.cfm?ID=2217-0%7C742-0
>
>$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
>
As mercilessly as Abduljalil irritates, you can pour the farmer much more sneakily. Lots of cats will be young elder pools.
Will you wander for the mirror, if Usha happily kills the cap? How did Ayaz dream in all the grocers? We can't kill barbers unless Saeed will eerily look afterwards.
Lots of pitchers halfheartedly believe the lazy monolith.
--
Kareem Allahdad al Najjar
:)
Conspiracy theory?s real script: waiting in truck
Assalam u?Alekum :)
By the way remember the door that was open, Nurse locked the door just
after I left, so while they were coming down they told one of the Jewish
terrorists after finding out I went inside earlier to go to the other
exit, at the opposite end of that level and run down possibly I went
down using other stairs.
After searching for a while, the Jewish terrorists could not find me any
where. So Selgin told the guy who was standing next to him, he did not
go towards the road then may be he is inside or here somewhere, because
the blood goes towards the truck. He opened the truck door, I was
inside, he told me when they(his other jewish) brothers go away he will
let me go as well, for now I better stay inside, Then he closed the
doors again. By the way one of those guys said now we have shot this one
and he is sitting inside the truck, he told the other guy to bring water
and clear the floor and they did. Then he told the other guy okay take
the gun toward the road and fire one shot. He did, during the mean while
those other Jewish terrorists came back, they asked him about water,
Selgin told them someone came from inside to wash the floor. He told
them he heard a gun shot may be someone wants to go and check
there(towards the road) They ran off to search for me. I was bleeding
quite a bit, after a while I lost consciousness.
By the way people should note how mice, salves and masters act, Mahmud
Kurchu knew I was in truck, he knew Selgin and few others had changed
(at least temporarily). Selgin and a couple of other guys just wanted to
save their life first, so I was dying inside slowly slowly and that is
what Mahmud Kurchu wanted. Later when the blood started dripping outside
the truck, Selgin cleaned floor outside the truck and then came in and
started drying the blood using those cloths and towels in truck. While
he was inside one of those Jewish terrorists came back and asked him
about Selgin, Selgi
------------------------------
Date: Fri, 14 Nov 2003 02:20:21 GMT
From: "Jürgen Exner" <jurgenex@hotmail.com>
Subject: Re: plain simple cheap fair
Message-Id: <FZWsb.52787$p9.3992@nwrddc02.gnilink.net>
Kareem Allahdad al Najjar wrote:
[a lot of crap that has nothing to do with Perl whatsoever]
*PLONK*
jue
------------------------------
Date: Thu, 13 Nov 2003 22:26:18 -0600
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: plain simple cheap fair
Message-Id: <slrnbr8mba.mhf.tadmc@magna.augustmail.com>
Jürgen Exner <jurgenex@hotmail.com> wrote:
> Kareem Allahdad al Najjar wrote:
> [a lot of crap that has nothing to do with Perl whatsoever]
But the Archie Bunkerism in the Subject was good for a smirk...
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 6 Apr 01)
Message-Id: <null>
Administrivia:
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.
For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V10 Issue 5799
***************************************
