[31693] in Perl-Users-Digest
Perl-Users Digest, Issue: 2956 Volume: 11
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Thu May 20 16:09:22 2010
Date: Thu, 20 May 2010 13:09:06 -0700 (PDT)
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, 20 May 2010 Volume: 11 Number: 2956
Today's topics:
Re: Debugging question: tracing the origin of an error. <r.ted.byers@gmail.com>
Re: Debugging question: tracing the origin of an error. <RedGrittyBrick@spamweary.invalid>
Re: Debugging question: tracing the origin of an error. <r.ted.byers@gmail.com>
Efficiently searching multiple files <awkster@yahoo.com>
Re: Efficiently searching multiple files <uri@StemSystems.com>
Re: Efficiently searching multiple files <glex_no-spam@qwest-spam-no.invalid>
Re: getting results of multiple simultaneous system com <lndresnick@gmail.com>
Re: How to avoid zombies? (Randal L. Schwartz)
Re: How to avoid zombies? <cartercc@gmail.com>
Re: How to avoid zombies? <peter@makholm.net>
Re: Validate $q->param() instead of copying to hash fir <glex_no-spam@qwest-spam-no.invalid>
Re: Validate $q->param() instead of copying to hash fir <abc@def.com>
Re: Validate $q->param() instead of copying to hash fir <glex_no-spam@qwest-spam-no.invalid>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Thu, 20 May 2010 09:29:18 -0700 (PDT)
From: Ted Byers <r.ted.byers@gmail.com>
Subject: Re: Debugging question: tracing the origin of an error.
Message-Id: <865c7f40-b80a-4e42-b626-510b75ba949e@y21g2000vba.googlegroups.com>
On May 20, 10:33=A0am, Ted Byers <r.ted.by...@gmail.com> wrote:
> On May 20, 8:27=A0am, Ben Morrow <b...@morrow.me.uk> wrote:
>
>
>
> > Quoth Ted Byers <r.ted.by...@gmail.com>:
>
> > > On May 19, 6:54=A0pm, Ben Morrow <b...@morrow.me.uk> wrote:
> > > > Quoth Ted Byers <r.ted.by...@gmail.com>:
>
> > > > > Trace:
> > > > > k:/Projects/NewRiskModel/Simple.Risk.Model.pl, (eval), k:/Project=
s/
> > > > > NewRiskModel/Simple.Risk.Model.pl, Win32::TieRegistry::DESTROY, C=
:/
> > > > > Perl/site/lib/Win32/TieRegistry.pm, Line: 1485
> > > > > (eval), C:/Perl/site/lib/Win32/TieRegistry.pm, Line: 1485
>
> > > > > Can't call method "FETCH" on an undefined value at C:/Perl/site/l=
ib/
> > > > > Win32/TieRegistry.pm line 1485, <DATA> line 335 during gl=
obal
> > > > > destruction.
>
> > > > > Compilation finished at Wed May 19 16:41:23
>
> > > > Am I correct that line 1485 of your copy of Win32/TieRegistry.pm is=
the
> > > > last line here?
>
> > > > =A0 =A0 sub DESTROY
> > > > =A0 =A0 {
> > > > =A0 =A0 =A0 =A0 my $self=3D shift(@_);
> > > > =A0 =A0 =A0 =A0 return =A0 if =A0tied(%$self);
> > > > =A0 =A0 =A0 =A0 my $unload;
> > > > =A0 =A0 =A0 =A0 eval { $unload=3D $self->{UNLOADME}; 1 }
>
> > > > If so I can't see how that could be calling tie magic, since the co=
de's
> > > > just checked that it *isn't* tied. In any case, back up your copy o=
f
> > > > Win32/TieRegistry.pm and add
>
> > > > =A0 =A0 use Devel::Peek ();
> > > > =A0 =A0 use Carp ();
> > > > =A0 =A0 Devel::Peek::Dump($self);
> > > > =A0 =A0 Carp::confess("huh?");
>
> > > > just before that line, and post the result.
>
> > > I hadn't noticed that, but I was out of my depth as I have never used
> > > the tie magic, and didn't know which of the packages I used would or
> > > why.
>
> > > In any event, here is the output after adding the four lines you
> > > suggest:
>
> > <snip>
> > > SV =3D RV(0x22c15b0) at 0x22c15a4
> > > =A0 REFCNT =3D 1
> > > =A0 FLAGS =3D (PADMY,ROK)
> > > =A0 RV =3D 0x1c53074
> > > =A0 SV =3D PVHV(0x1e45c4c) at 0x1c53074
> > > =A0 =A0 REFCNT =3D 2
> > > =A0 =A0 FLAGS =3D (OBJECT,SHAREKEYS)
> > > =A0 =A0 STASH =3D 0x1f5b01c =A0 =A0 =A0"Win32::TieRegistry"
> > > =A0 =A0 ARRAY =3D 0x222f58c =A0(0:14, 1:14, 2:4)
> > > =A0 =A0 hash quality =3D 121.5%
> > > =A0 =A0 KEYS =3D 22
> > > =A0 =A0 FILL =3D 18
> > > =A0 =A0 MAX =3D 31
> > > =A0 =A0 RITER =3D -1
> > > =A0 =A0 EITER =3D 0x0
>
> > OK, so the hash definitely isn't tied. (If it had been there would have
> > been a whole MAGIC section, including the line
>
> > =A0 =A0 MG_TYPE =3D PERL_magic_tied(P)
>
> > .)
>
> > Can you confirm that the code does in fact get as far as l1485, and
> > doesn't get any further? (Take out the 'confess', and put a 'warn'
> > before 'eval { $unload=3D...' and another before 'my $debug=3D...'.)
>
> > If it does, then the only remaining option is that $self->{UNLOADME}
> > *is* tied, and that the tied object is getting destroyed before its
> > parent. You can confirm this by changing the Devel::Peek::Dump line you
> > added before to
>
> > =A0 =A0 Devel::Peek::Dump($self->{UNLOADME});
>
> > If that output includes the MAGIC line I mentioned above, post it.
>
> > Ben
>
> Thanks Ben
>
> Yes, it is confirmed that it gets to line 1485 and no further.
>
> And changing the peek line as suggested produces the following:
>
> SV =3D PVLV(0x185b6b4) at 0x22245bc
> =A0 REFCNT =3D 1
> =A0 FLAGS =3D (TEMP,GMG,SMG)
> =A0 IV =3D 0
> =A0 NV =3D 0
> =A0 PV =3D 0
> =A0 MAGIC =3D 0x243554c
> =A0 =A0 MG_VIRTUAL =3D &PL_vtbl_defelem
> =A0 =A0 MG_TYPE =3D PERL_MAGIC_defelem(y)
> =A0 =A0 MG_FLAGS =3D 0x02
> =A0 =A0 =A0 REFCOUNTED
> =A0 =A0 MG_OBJ =3D 0x22245cc
> =A0 =A0 SV =3D PV(0x1fa55d4) at 0x22245cc
> =A0 =A0 =A0 REFCNT =3D 1
> =A0 =A0 =A0 FLAGS =3D (POK,pPOK)
> =A0 =A0 =A0 PV =3D 0x1836474 "UNLOADME"\0
> =A0 =A0 =A0 CUR =3D 8
> =A0 =A0 =A0 LEN =3D 12
> =A0 TYPE =3D y
> =A0 TARGOFF =3D 0
> =A0 TARGLEN =3D 1
> =A0 TARG =3D 0x1bdb234
> =A0 SV =3D PVHV(0x1e45c6c) at 0x1bdb234
> =A0 =A0 REFCNT =3D 3
> =A0 =A0 FLAGS =3D (OBJECT,SHAREKEYS)
> =A0 =A0 STASH =3D 0x1f5b034 =A0 "Win32::TieRegistry"
> =A0 =A0 ARRAY =3D 0x22298cc =A0(0:14, 1:14, 2:4)
> =A0 =A0 hash quality =3D 121.5%
> =A0 =A0 KEYS =3D 22
> =A0 =A0 FILL =3D 18
> =A0 =A0 MAX =3D 31
> =A0 =A0 RITER =3D -1
> =A0 =A0 EITER =3D 0x0
> =A0 =A0 Elt "CntValues" HASH =3D 0x359bb702
> =A0 =A0 SV =3D IV(0x230a7a0) at 0x230a7a4
> =A0 =A0 =A0 REFCNT =3D 1
> =A0 =A0 =A0 FLAGS =3D (IOK,pIOK)
> =A0 =A0 =A0 IV =3D 0
> =A0 =A0 Elt "MaxSubClassLen" HASH =3D 0xb3d551a2
> =A0 =A0 SV =3D IV(0x230a850) at 0x230a854
> =A0 =A0 =A0 REFCNT =3D 1
> =A0 =A0 =A0 FLAGS =3D (IOK,pIOK)
> =A0 =A0 =A0 IV =3D 0
> =A0 =A0 Elt "FLAGS" HASH =3D 0x1773e623
> =A0 =A0 SV =3D IV(0x230a9b0) at 0x230a9b4
> =A0 =A0 =A0 REFCNT =3D 1
> =A0 =A0 =A0 FLAGS =3D (IOK,pIOK)
> =A0 =A0 =A0 IV =3D 136
>
> The "MG_TYPE =3D PERL_magic_tied(P)" isn't there. =A0Instead, I see
> "MG_TYPE =3D PERL_MAGIC_defelem(y)"
>
> What next?
>
> Would this be an issue with DBI, or the MySQL driver?
>
> Is it likely to do any harm? =A0The program runs fine otherwise. =A0I am
> just troubled that this error arises after the code I wrote finishes.
> And seeing the name of the package where the error occurs is
> "TieRegistry", I am concerned this error may introduce, or be a
> consequence of, errors in my registry.
>
> Thanks again
>
> Ted
>
> Thanks again,
>
> Ted
On a different note, any ideas why Google is sending my notes multiple
times to this forum? This is actuall the first time I have seen this
nuisance arise.
If it matters, I am using Firefox to access usenet via google/groups.
I have no other way to access this forum, or any other.
------------------------------
Date: Thu, 20 May 2010 17:51:27 +0100
From: RedGrittyBrick <RedGrittyBrick@spamweary.invalid>
Subject: Re: Debugging question: tracing the origin of an error.
Message-Id: <4bf56893$0$2535$da0feed9@news.zen.co.uk>
On 20/05/2010 17:29, Ted Byers wrote:
>
> On a different note, any ideas why Google is sending my notes multiple
> times to this forum?
Not specifically. Maybe pressing the back button to view a prior page
unaware that browsers resend form data when the previous page was the
result of a form submission? Maybe just the general nastiness of Google
Groups for anything other than searching archives?
> This is actuall[y] the first time I have seen this nuisance arise.
> If it matters, I am using Firefox to access usenet via google/groups.
Firefox isn't the problem.
> I have no other way to access this forum, or any other.
If you have Firefox, you can probably have a NNTP news client like
Thunderbird (or trn or Gravity or ...)
Since you have internet access, an ISP is probably involved. Many ISPs
provide news servers which their subscribers can access using an NNTP
news reader. If not there are "free news servers" which you can find
using Google or other search engines.
ยค0.02
--
RGB
------------------------------
Date: Thu, 20 May 2010 11:37:47 -0700 (PDT)
From: Ted Byers <r.ted.byers@gmail.com>
Subject: Re: Debugging question: tracing the origin of an error.
Message-Id: <11820117-2ac5-48ae-a807-363db6558801@q33g2000vbt.googlegroups.com>
On May 20, 10:33=A0am, Ted Byers <r.ted.by...@gmail.com> wrote:
> On May 20, 8:27=A0am, Ben Morrow <b...@morrow.me.uk> wrote:
>
>
>
> > Quoth Ted Byers <r.ted.by...@gmail.com>:
>
> > > On May 19, 6:54=A0pm, Ben Morrow <b...@morrow.me.uk> wrote:
> > > > Quoth Ted Byers <r.ted.by...@gmail.com>:
>
> > > > >Trace:
> > > > > k:/Projects/NewRiskModel/Simple.Risk.Model.pl, (eval), k:/Project=
s/
> > > > > NewRiskModel/Simple.Risk.Model.pl, Win32::TieRegistry::DESTROY, C=
:/
> > > > > Perl/site/lib/Win32/TieRegistry.pm, Line: 1485
> > > > > (eval), C:/Perl/site/lib/Win32/TieRegistry.pm, Line: 1485
>
> > > > > Can't call method "FETCH" on an undefined value at C:/Perl/site/l=
ib/
> > > > > Win32/TieRegistry.pm line 1485, <DATA> line 335 during gl=
obal
> > > > > destruction.
>
> > > > > Compilation finished at Wed May 19 16:41:23
>
> > > > Am I correct that line 1485 of your copy of Win32/TieRegistry.pm is=
the
> > > > last line here?
>
> > > > =A0 =A0 sub DESTROY
> > > > =A0 =A0 {
> > > > =A0 =A0 =A0 =A0 my $self=3D shift(@_);
> > > > =A0 =A0 =A0 =A0 return =A0 if =A0tied(%$self);
> > > > =A0 =A0 =A0 =A0 my $unload;
> > > > =A0 =A0 =A0 =A0 eval { $unload=3D $self->{UNLOADME}; 1 }
>
> > > > If so I can't see how that could be calling tie magic, since the co=
de's
> > > > just checked that it *isn't* tied. In any case, back up your copy o=
f
> > > > Win32/TieRegistry.pm and add
>
> > > > =A0 =A0 use Devel::Peek ();
> > > > =A0 =A0 use Carp ();
> > > > =A0 =A0 Devel::Peek::Dump($self);
> > > > =A0 =A0 Carp::confess("huh?");
>
> > > > just before that line, and post the result.
>
> > > I hadn't noticed that, but I was out of my depth as I have never used
> > > the tie magic, and didn't know which of the packages I used would or
> > > why.
>
> > > In any event, here is the output after adding the four lines you
> > > suggest:
>
> > <snip>
> > > SV =3D RV(0x22c15b0) at 0x22c15a4
> > > =A0 REFCNT =3D 1
> > > =A0 FLAGS =3D (PADMY,ROK)
> > > =A0 RV =3D 0x1c53074
> > > =A0 SV =3D PVHV(0x1e45c4c) at 0x1c53074
> > > =A0 =A0 REFCNT =3D 2
> > > =A0 =A0 FLAGS =3D (OBJECT,SHAREKEYS)
> > > =A0 =A0 STASH =3D 0x1f5b01c =A0 =A0 =A0"Win32::TieRegistry"
> > > =A0 =A0 ARRAY =3D 0x222f58c =A0(0:14, 1:14, 2:4)
> > > =A0 =A0 hash quality =3D 121.5%
> > > =A0 =A0 KEYS =3D 22
> > > =A0 =A0 FILL =3D 18
> > > =A0 =A0 MAX =3D 31
> > > =A0 =A0 RITER =3D -1
> > > =A0 =A0 EITER =3D 0x0
>
> > OK, so the hash definitely isn't tied. (If it had been there would have
> > been a whole MAGIC section, including the line
>
> > =A0 =A0 MG_TYPE =3D PERL_magic_tied(P)
>
> > .)
>
> > Can you confirm that the code does in fact get as far as l1485, and
> > doesn't get any further? (Take out the 'confess', and put a 'warn'
> > before 'eval { $unload=3D...' and another before 'my $debug=3D...'.)
>
> > If it does, then the only remaining option is that $self->{UNLOADME}
> > *is* tied, and that the tied object is getting destroyed before its
> > parent. You can confirm this by changing the Devel::Peek::Dump line you
> > added before to
>
> > =A0 =A0 Devel::Peek::Dump($self->{UNLOADME});
>
> > If that output includes the MAGIC line I mentioned above, post it.
>
> > Ben
>
> Thanks Ben
>
> Yes, it is confirmed that it gets to line 1485 and no further.
I just made an observation that qualifies this.
As I was watching the output from my script scroll by, I noticed that
this confirmation applies only at the end of the program or when it is
cleaning up when disconnecting from the DB ($dbh->disconnect();).
This same code executes without error when cleaning up a statement
handle ($sth->finish();). I see it every time I call $sth->finish()
in preparation for preparing a new SQL statement: I reuse that
statement handle variable at least half a dozen times. So this
TieRegistry code works OK for $sth->finish but not $dbh->disconnect.
Cheers
Ted
>
> And changing the peek line as suggested produces the following:
>
> SV =3D PVLV(0x185b6b4) at 0x22245bc
> =A0 REFCNT =3D 1
> =A0 FLAGS =3D (TEMP,GMG,SMG)
> =A0 IV =3D 0
> =A0 NV =3D 0
> =A0 PV =3D 0
> =A0 MAGIC =3D 0x243554c
> =A0 =A0 MG_VIRTUAL =3D &PL_vtbl_defelem
> =A0 =A0 MG_TYPE =3D PERL_MAGIC_defelem(y)
> =A0 =A0 MG_FLAGS =3D 0x02
> =A0 =A0 =A0 REFCOUNTED
> =A0 =A0 MG_OBJ =3D 0x22245cc
> =A0 =A0 SV =3D PV(0x1fa55d4) at 0x22245cc
> =A0 =A0 =A0 REFCNT =3D 1
> =A0 =A0 =A0 FLAGS =3D (POK,pPOK)
> =A0 =A0 =A0 PV =3D 0x1836474 "UNLOADME"\0
> =A0 =A0 =A0 CUR =3D 8
> =A0 =A0 =A0 LEN =3D 12
> =A0 TYPE =3D y
> =A0 TARGOFF =3D 0
> =A0 TARGLEN =3D 1
> =A0 TARG =3D 0x1bdb234
> =A0 SV =3D PVHV(0x1e45c6c) at 0x1bdb234
> =A0 =A0 REFCNT =3D 3
> =A0 =A0 FLAGS =3D (OBJECT,SHAREKEYS)
> =A0 =A0 STASH =3D 0x1f5b034 =A0 "Win32::TieRegistry"
> =A0 =A0 ARRAY =3D 0x22298cc =A0(0:14, 1:14, 2:4)
> =A0 =A0 hash quality =3D 121.5%
> =A0 =A0 KEYS =3D 22
> =A0 =A0 FILL =3D 18
> =A0 =A0 MAX =3D 31
> =A0 =A0 RITER =3D -1
> =A0 =A0 EITER =3D 0x0
> =A0 =A0 Elt "CntValues" HASH =3D 0x359bb702
> =A0 =A0 SV =3D IV(0x230a7a0) at 0x230a7a4
> =A0 =A0 =A0 REFCNT =3D 1
> =A0 =A0 =A0 FLAGS =3D (IOK,pIOK)
> =A0 =A0 =A0 IV =3D 0
> =A0 =A0 Elt "MaxSubClassLen" HASH =3D 0xb3d551a2
> =A0 =A0 SV =3D IV(0x230a850) at 0x230a854
> =A0 =A0 =A0 REFCNT =3D 1
> =A0 =A0 =A0 FLAGS =3D (IOK,pIOK)
> =A0 =A0 =A0 IV =3D 0
> =A0 =A0 Elt "FLAGS" HASH =3D 0x1773e623
> =A0 =A0 SV =3D IV(0x230a9b0) at 0x230a9b4
> =A0 =A0 =A0 REFCNT =3D 1
> =A0 =A0 =A0 FLAGS =3D (IOK,pIOK)
> =A0 =A0 =A0 IV =3D 136
>
> The "MG_TYPE =3D PERL_magic_tied(P)" isn't there. =A0Instead, I see
> "MG_TYPE =3D PERL_MAGIC_defelem(y)"
>
> What next?
>
> Would this be an issue withDBI, or the MySQL driver?
>
> Is it likely to do any harm? =A0The program runs fine otherwise. =A0I am
> just troubled that this error arises after the code I wrote finishes.
> And seeing the name of the package where the error occurs is
> "TieRegistry", I am concerned this error may introduce, or be a
> consequence of, errors in my registry.
>
> Thanks again
>
> Ted
>
> Thanks again,
>
> Ted
------------------------------
Date: Thu, 20 May 2010 12:19:58 -0700 (PDT)
From: Jorge <awkster@yahoo.com>
Subject: Efficiently searching multiple files
Message-Id: <6bf31a76-1cd6-48be-8bea-a91b1c6b83b6@y21g2000vba.googlegroups.com>
I have a Linux directory full of shell scripts (~100 scripts with
average
size of ~60 lines) with many of them calling other scripts as
depencencies.
Not being the author of the scripts and with the immediate need to
become familiar with
the overall scope of this script directory, I needed to create a cross-
reference chart
that shows what script depends on what other script.
My Perl script (below) works in terms of doing what I need, however,
IMO, it appears to run a bit slow. I timed it at ~3.5 sec. Possibly
that is it's max performance but something tells me (from other Perl
script experiences) this one just isn't up to speed.
I would appreciate any ideas or comments.
Thanks, Jorge
#!/usr/bin/perl -l
use strict;
use warnings;
&scripts_dir('/some/dir/that/holds/scripts');
sub scripts_dir {
# set some vars
my $dir = shift;
my(@paths, $paths, @scripts, $scripts, $string);
my($lines, $leaf, $header, $header2);
local($_);
# check dir can be opened for read
unless (opendir(DIR, $dir)) {
die "can't open $dir $!\n";
closedir(DIR);
return;
}
#
# read dir, skip over system files and bak files
# build array of script names
# build array of full-path script names
#
foreach (readdir(DIR)) {
next if $_ eq '.' || $_ eq '..' || $_ =~ /\.bak$/;
push(@scripts, $_);
$paths = $dir."/".$_;
push(@paths, $paths);
}
closedir(DIR);
# open ouput file, format and print headers
open OUT, ">output" or die "cannot open output for writing $! ...
\n";
$header = sprintf("%-25s%-25s%s", "SCRIPT NAME", "FOUND IN",
"USAGE");
$header2 = sprintf("%-25s%-25s%s", "===========", "========",
"=====");
print OUT $header;
print OUT $header2;
# loop through each script name
foreach $scripts(@scripts){
# loop through each script in directory
foreach my $paths(@paths){
# get last leaf of script being searched --
# if it matches itself; skip
$leaf = get_leaf($paths);
if($scripts eq $leaf) { next;}
# open each script for searching
open F, "$paths" or die "cannot open $paths for reading
$! ...\n";
while(my $lines = <F>) {
# -l switch in place
chomp($lines);
# search for matches to the commonly-used command
syntax
if($lines =~ /\$\($scripts / || $lines =~ /\`
$scripts /){
# format to line up with headers
$string = sprintf("%-25s%-25s%s", $scripts, $leaf,
$lines);
# print to file
print OUT $string;
}
}
}
}
# close I/O streams
close(F);
close(OUT);
}
#======================
# subroutine get_leaf
#======================
sub get_leaf
{
# get arg(s)
my($pathname) = @_;
# split on leafs
my @split_pathname = split( /[\\\/]/, $pathname);
# grab last leaf
my $leaf = pop( @split_pathname );
# return bare script name (leaf)
return( $leaf );
}
__END__
------------------------------
Date: Thu, 20 May 2010 15:47:27 -0400
From: "Uri Guttman" <uri@StemSystems.com>
Subject: Re: Efficiently searching multiple files
Message-Id: <87iq6ifj8w.fsf@quad.sysarch.com>
>>>>> "J" == Jorge <awkster@yahoo.com> writes:
J> #!/usr/bin/perl -l
J> use strict;
J> use warnings;
good
J> &scripts_dir('/some/dir/that/holds/scripts');
don't call subs with & as it isn't needed with () and it is perl4
style. there are other subtle issues that can bite you.
J> sub scripts_dir {
J> # set some vars
J> my $dir = shift;
J> my(@paths, $paths, @scripts, $scripts, $string);
J> my($lines, $leaf, $header, $header2);
don't declare vars before you need them. in many cases you can declare
then when first used.
J> local($_);
why? actually i recommend against using $_ as much as possible (it does
have its places) so you can used named vars which are easier to read and
make the code better
J> # check dir can be opened for read
J> unless (opendir(DIR, $dir)) {
use a lexical handle
unless (opendir(my $dirh, $dir)) {
J> die "can't open $dir $!\n";
J> closedir(DIR);
why close the handle if it never opened?
J> return;
you can just exit here instead.
J> }
better yet, use File::Slurp's read_dir.
J> #
J> # read dir, skip over system files and bak files
J> # build array of script names
J> # build array of full-path script names
J> #
J> foreach (readdir(DIR)) {
J> next if $_ eq '.' || $_ eq '..' || $_ =~ /\.bak$/;
read_dir skips . and .. for you.
J> push(@scripts, $_);
J> $paths = $dir."/".$_;
J> push(@paths, $paths);
J> }
J> closedir(DIR);
that can all be done so much simpler like this (untested):
my @paths = map "$dir/$_", grep !/\.bak$/, read_dir $dir ;
J> # open ouput file, format and print headers
J> open OUT, ">output" or die "cannot open output for writing $!
J> ...
ditto for lexical handles
J> \n";
J> $header = sprintf("%-25s%-25s%s", "SCRIPT NAME", "FOUND IN",
J> "USAGE");
J> $header2 = sprintf("%-25s%-25s%s", "===========", "========",
J> "=====");
you use the same sprintf format three times. put that into a variable
above so you can change it in one place.
J> print OUT $header;
J> print OUT $header2;
no need for two print calls.
print OUT $header, $header2 ;
J> # loop through each script name
J> foreach $scripts(@scripts){
foreach my $scripts (@scripts) {
that is how you can declare vars locally. and use more horizontal
whitespace. others need to read your code so think about them when you
write it. and YOU are an other too! :)
i noticed this below but the point is true here. don't use plural names
for singular things. $scripts has a single script name
J> # loop through each script in directory
J> foreach my $paths(@paths){
you used my there. why not in the previous loop?
J> # get last leaf of script being searched --
J> # if it matches itself; skip
J> $leaf = get_leaf($paths);
J> if($scripts eq $leaf) { next;}
slightly faster as you don't need a block entry on next. also a better
style for simple flow control like this.
next if $scripts eq $leaf ;
J> # open each script for searching
J> open F, "$paths" or die "cannot open $paths for reading
don't quote scalar vars as it can lead to subtle bugs. it is not needed here.
J> $! ...\n";
J> while(my $lines = <F>) {
$lines is a single line so make that singular. using a plural name
implies an array or array ref
J> # -l switch in place
that only affects one liners using -p or -n. no effect on regular code
J> chomp($lines);
J> # search for matches to the commonly-used command
J> syntax
J> if($lines =~ /\$\($scripts / || $lines =~ /\`
J> $scripts /){
this doesn't make sense. are you checking if the current script refers
to itself??
J> # format to line up with headers
J> $string = sprintf("%-25s%-25s%s", $scripts, $leaf,
J> $lines);
J> # print to file
J> print OUT $string;
since you just print the string, you can use printf directly.
J> }
J> }
J> }
J> }
J> # close I/O streams
J> close(F);
J> close(OUT);
J> }
J> #======================
J> # subroutine get_leaf
J> #======================
J> sub get_leaf
J> {
J> # get arg(s)
J> my($pathname) = @_;
J> # split on leafs
J> my @split_pathname = split( /[\\\/]/, $pathname);
gack!!
File::Basename does this for you and simpler.
J> # grab last leaf
J> my $leaf = pop( @split_pathname );
you could just return the popped value directly. hell, you can do that
in the split line too:
return( (split( /[\\\/]/, $pathname)[-1] );
as for speedups, i can't help much since i don't have your input
data. nothing seems oddly slow looking but your core loops are deep and
can be done better. slurping in the entire file (File::Slurp) and
scanning for those lines in one regex would be noticeably faster. and
your core logic is suspect as it doesn't seem to check for calling other
scripts from a given one.
uri
--
Uri Guttman ------ uri@stemsystems.com -------- http://www.sysarch.com --
----- Perl Code Review , Architecture, Development, Training, Support ------
--------- Gourmet Hot Cocoa Mix ---- http://bestfriendscocoa.com ---------
------------------------------
Date: Thu, 20 May 2010 15:02:21 -0500
From: "J. Gleixner" <glex_no-spam@qwest-spam-no.invalid>
Subject: Re: Efficiently searching multiple files
Message-Id: <4bf5954e$0$87075$815e3792@news.qwest.net>
Jorge wrote:
> I have a Linux directory full of shell scripts (~100 scripts with
> average
> size of ~60 lines) with many of them calling other scripts as
> depencencies.
>
> Not being the author of the scripts and with the immediate need to
> become familiar with
> the overall scope of this script directory, I needed to create a cross-
> reference chart
> that shows what script depends on what other script.
>
> My Perl script (below) works in terms of doing what I need, however,
> IMO, it appears to run a bit slow. I timed it at ~3.5 sec. Possibly
> that is it's max performance but something tells me (from other Perl
> script experiences) this one just isn't up to speed.
3 seconds isn't fast enough??.. just write it, run it, and move on..
sheesh..
>
> I would appreciate any ideas or comments.
>
> Thanks, Jorge
>
> #!/usr/bin/perl -l
>
> use strict;
> use warnings;
>
> &scripts_dir('/some/dir/that/holds/scripts');
Remove the '&' there.
>
> sub scripts_dir {
>
> # set some vars
> my $dir = shift;
> my(@paths, $paths, @scripts, $scripts, $string);
> my($lines, $leaf, $header, $header2);
> local($_);
Declare your vars in the smallest possible scope.
>
> # check dir can be opened for read
> unless (opendir(DIR, $dir)) {
> die "can't open $dir $!\n";
After die is called, nothing after this point is called..
> closedir(DIR);
> return;
> }
>
> #
> # read dir, skip over system files and bak files
> # build array of script names
> # build array of full-path script names
> #
> foreach (readdir(DIR)) {
> next if $_ eq '.' || $_ eq '..' || $_ =~ /\.bak$/;
> push(@scripts, $_);
> $paths = $dir."/".$_;
> push(@paths, $paths);
> }
> closedir(DIR);
>
> # open ouput file, format and print headers
> open OUT, ">output" or die "cannot open output for writing $! ...
> \n";
use 3 argument open.
open( my $out, '>', 'output' ) || die "can't open output: $!";
> $header = sprintf("%-25s%-25s%s", "SCRIPT NAME", "FOUND IN",
> "USAGE");
> $header2 = sprintf("%-25s%-25s%s", "===========", "========",
> "=====");
> print OUT $header;
> print OUT $header2;
Just use printf.
printf OUT "%-25s%-25s%s\n", "SCRIPT NAME", "FOUND IN", "USAGE";
or printf $out...
>
> # loop through each script name
> foreach $scripts(@scripts){
for my $script( @scripts )
>
> # loop through each script in directory
> foreach my $paths(@paths){
$path seems better than $paths
>
> # get last leaf of script being searched --
> # if it matches itself; skip
> $leaf = get_leaf($paths);
my $leaf = ( split( /\//, $paths ) )[-1];
> if($scripts eq $leaf) { next;}
next if $scripts eq $leaf;
>
> # open each script for searching
> open F, "$paths" or die "cannot open $paths for reading
> $! ...\n";
open( my $file, '<', $path ) || die "can't open $path: $!;
>
> while(my $lines = <F>) {
my $line instead of my $lines.
>
> # -l switch in place
> chomp($lines);
>
> # search for matches to the commonly-used command
> syntax
> if($lines =~ /\$\($scripts / || $lines =~ /\`
> $scripts /){
>
> # format to line up with headers
> $string = sprintf("%-25s%-25s%s", $scripts, $leaf,
> $lines);
>
> # print to file
> print OUT $string;
again printf
> }
> }
Should close F or $file here.
> }
> }
> # close I/O streams
> close(F);
^^^ should be just after the end of the while.. above.
> close(OUT);
> }
>
> #======================
> # subroutine get_leaf
> #======================
> sub get_leaf
> {
> # get arg(s)
> my($pathname) = @_;
>
> # split on leafs
> my @split_pathname = split( /[\\\/]/, $pathname);
>
> # grab last leaf
> my $leaf = pop( @split_pathname );
>
> # return bare script name (leaf)
> return( $leaf );
> }
>
> __END__
>
>
------------------------------
Date: Thu, 20 May 2010 11:14:06 -0700 (PDT)
From: David Resnick <lndresnick@gmail.com>
Subject: Re: getting results of multiple simultaneous system commands
Message-Id: <bb891e74-fb85-4257-becd-9ad834b8d2ff@e28g2000vbd.googlegroups.com>
On May 20, 10:00=A0am, "Dr.Ruud" <rvtol+use...@xs4all.nl> wrote:
> David Resnick wrote:
> > I need to execute multiple simultaneous system() statements.
>
> push @exit, system("$_ &") for @command;
>
> > [...] =A0Unfortunately, I
> > discovered that the perl I need to use on some of our systems was
> > built without threads and replacing it isn't an option.
>
> Consider it a blessing. Just fork and wait.
>
> --
> Ruud
Forking twice and waiting for both to exit (and checking $?, which was
the thing I forgot about) seems to work nicely. Thanks very much for
your help.
------------------------------
Date: Thu, 20 May 2010 08:12:40 -0700
From: merlyn@stonehenge.com (Randal L. Schwartz)
Subject: Re: How to avoid zombies?
Message-Id: <86eih6k3o7.fsf@red.stonehenge.com>
>>>>> "christoph" == christoph rabel@gmail com <christoph.rabel@gmail.com> writes:
christoph> Thx. I just inherited the app, I have nothing to do with perl
christoph> otherwise, I didn't even know that "perldoc" exists.
Then you should either read a tutorial on Perl, or delegate the task to
someone who knows Perl. Learning about Perl one fact at a time via a
newsgroup is neither effective nor a good use of your time or ours.
--
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<merlyn@stonehenge.com> <URL:http://www.stonehenge.com/merlyn/>
Smalltalk/Perl/Unix consulting, Technical writing, Comedy, etc. etc.
See http://methodsandmessages.vox.com/ for Smalltalk and Seaside discussion
------------------------------
Date: Thu, 20 May 2010 09:05:04 -0700 (PDT)
From: ccc31807 <cartercc@gmail.com>
Subject: Re: How to avoid zombies?
Message-Id: <501ff760-6f49-49ce-a221-595845c78642@r9g2000vbk.googlegroups.com>
On May 20, 10:34=A0am, "christoph.ra...@gmail.com"
<christoph.ra...@gmail.com>
> Thx. I just inherited the app, I have nothing to do with perl
> otherwise, I didn't even know that "perldoc" exists.
This is just a question, no malice or insult intended or implied.
I can understand 'inheriting' stuff that you don't want or need or
that you don't have anything to do with. I have been in that position,
and my children will also probably be in that position with my stuff
that they care nothing for.
However, 'inheriting' an app carries with it at least a tacit
understanding that you have the responsibility for running it and
maintaining it, and if the app isn't related to a technology you know,
you either migrate it to a technology you do know (e.g., rewrite it in
COBOL, Basic, Lisp, or your particular poison) or learn the
technology.
Question: Will you migrate the app to another technology, learn Perl,
or kill the app? I don't think that running it without the ability to
maintain it is an option.
CC.
------------------------------
Date: Thu, 20 May 2010 15:28:03 +0200
From: Peter Makholm <peter@makholm.net>
Subject: Re: How to avoid zombies?
Message-Id: <87d3wq1z4s.fsf@vps1.hacking.dk>
"christoph.rabel@gmail.com" <christoph.rabel@gmail.com> writes:
> Essentially we spawn a new thread for each client. communicate "talks"
> a while with it and closes the connection afterwards. As it seems, the
> spawned processes end up as zombies. Can I avoid this behavior easily?
As the spawn() function you're using isn't a standard function it is
hard to say how you would reap dead processes correctly. But basically
you have to call the wait() or waitpid() function somewhere. A good
place might be in a SIGCHILD signal handler.
//Makholm
------------------------------
Date: Thu, 20 May 2010 11:34:59 -0500
From: "J. Gleixner" <glex_no-spam@qwest-spam-no.invalid>
Subject: Re: Validate $q->param() instead of copying to hash first?
Message-Id: <4bf564b3$0$89867$815e3792@news.qwest.net>
zaphod wrote:
> Although I'm using CGI::Application this also relates to the use of CGI.pm
>
> I would like to know if there is any benefit in validating the
> $q->param() hash in place before copying it to a lexical hash. In other
> words, is it better to:
>
> <do something> if $q->param(foo) !~ /<some regexp>/;
>
> ..... rather than:
>
> $form_fields{$_} = $q->param($_) for $q->param();
Why do that when there's Vars()?
> <do something> if $form_fields{foo} !~ /<some regexp>/;
>
> Is there a difference in security?
Best practice would be to validate/untaint the data before
assigning/using it.
------------------------------
Date: Thu, 20 May 2010 19:06:22 +0100
From: zaphod <abc@def.com>
Subject: Re: Validate $q->param() instead of copying to hash first?
Message-Id: <s9Cdndfon9yD52jWnZ2dnUVZ8qCdnZ2d@brightview.co.uk>
On 20/05/2010 17:34, J. Gleixner wrote:
> zaphod wrote:
>> Although I'm using CGI::Application this also relates to the use of
>> CGI.pm
>>
>> I would like to know if there is any benefit in validating the
>> $q->param() hash in place before copying it to a lexical hash. In
>> other words, is it better to:
>>
>> <do something> if $q->param(foo) !~ /<some regexp>/;
>>
>> ..... rather than:
>>
>> $form_fields{$_} = $q->param($_) for $q->param();
>
> Why do that when there's Vars()?
>
>> <do something> if $form_fields{foo} !~ /<some regexp>/;
>>
>> Is there a difference in security?
>
> Best practice would be to validate/untaint the data before
> assigning/using it.
>
Vars() ?
zaphod
------------------------------
Date: Thu, 20 May 2010 13:45:31 -0500
From: "J. Gleixner" <glex_no-spam@qwest-spam-no.invalid>
Subject: Re: Validate $q->param() instead of copying to hash first?
Message-Id: <4bf5834b$0$48215$815e3792@news.qwest.net>
zaphod wrote:
> On 20/05/2010 17:34, J. Gleixner wrote:
>> zaphod wrote:
>>> Although I'm using CGI::Application this also relates to the use of
>>> CGI.pm
>>>
>>> I would like to know if there is any benefit in validating the
>>> $q->param() hash in place before copying it to a lexical hash. In
>>> other words, is it better to:
>>>
>>> <do something> if $q->param(foo) !~ /<some regexp>/;
>>>
>>> ..... rather than:
>>>
>>> $form_fields{$_} = $q->param($_) for $q->param();
>>
>> Why do that when there's Vars()?
>>
>
> Vars() ?
See the documentation for CGI.
------------------------------
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:
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
Back issues are available via anonymous ftp from
ftp://cil-www.oce.orst.edu/pub/perl/old-digests.
#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 V11 Issue 2956
***************************************
