[10430] in Perl-Users-Digest
Perl-Users Digest, Issue: 4023 Volume: 8
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Tue Oct 20 16:03:22 1998
Date: Tue, 20 Oct 98 13:00:20 -0700
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Tue, 20 Oct 1998 Volume: 8 Number: 4023
Today's topics:
Advice on style <Ian_Lowe@fanniemae.com>
Re: Boston.pm will be Quiz Kings [was] Randal's Big Day <eashton@bbnplanet.com>
Can't do "use lib" <luutran@geocities_.com>
Re: Chat server? <rootbeer@teleport.com>
Re: comma formatting numbers <barnett@houston.Geco-Prakla.slb.com>
Re: comma formatting numbers (Gene Johannsen)
Communicating with an external program <showie@uoguelph.ca>
curly quick question <arranp@datamail.co.nz>
Re: curly quick question (Larry Rosler)
Re: Example Threads <snif.nospamplease@xs4all.nl>
Handling cookies in Perl for IE <chris@krisberg-haines.com>
Re: help shorten one-liner jkane@my-dejanews.com
Re: help: hash <d-edwards@nospam.uchicago.edu>
Re: how do you search subdirectories for a file? (Daniel Beckham)
LWP documentation (root)
Re: New Module: File::Finder -- OO version of File::Fin <jdporter@min.net>
Re: New Module: File::Finder -- OO version of File::Fin <jdporter@min.net>
Re: PERL and a DATABASE.. (Alexander Trump)
PerlCtrl.pl & VBSCRIPT <Pierre.Laplante@intellia.com>
Re: Raleigh.pm (Raleigh, NC, USA perl mongers) has regi (Adam Turoff)
Re: Randal's Big Day in Big D (Brand Hilton)
Re: Randal's Big Day in Big D <merlyn@stonehenge.com>
Re: Strict and Global Variables <aqumsieh@matrox.com>
Re: The space deletion woes... (Alexander Trump)
Re: waitpid / crontab problem <rootbeer@teleport.com>
Special: Digest Administrivia (Last modified: 12 Mar 98 (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Tue, 20 Oct 1998 15:05:25 -0400
From: Ian Lowe <Ian_Lowe@fanniemae.com>
Subject: Advice on style
Message-Id: <362CDEF5.F085F86C@fanniemae.com>
I am fairly certain that I have taken TMTOWTDI to new messy heights with
the following script. Any suggestions on how it might be more succintly
constructed would be greatly appreciated. Essentially I am trying to
construct a filesystem monitor that interfaces with Tivoli. We have a
very large Unix environment and our filesystems range from 300 MB to
over 20 GB. For this reason, an out of the box filesystem monitor
doesn't really do the trick. For instance, 90% capacity is of far
greater concern to us on the 300 MB filesystem than on the 20 GB one.
There must be a more efficient way to do this, than what I have here,
but I'm fairly new to perl. It does work, though :)
A final question: How could you go about building a table-driven
ruleset for filesystem monitoring? As you will see from the script, I
am just keying on percentage capacity but it would be much more granular
if I could correlate between filesystem size and space remaining. For
instance:
FS Size WARNING CRITICAL
300-600MB 80% (60-120MB remaining) 90% (30-60MB remaining)
600MB-5GB 90% (60-500MB remaining) 95% (30-250MB remaining)
5GB-10GB 95% (250-500MB remaining) 97% (150-300MB remaining)
Thanks for any advice you might have.
#!/export/Tivoli/efmperl/bin/perl -w
use strict;
use Sys::Hostname;
my $efm = "/export/Tivoli/efmbin/efmlog";
my $host = hostname();
my $fs;
my %size = ();
my %capacity = ();
open(DF,"/usr/ucb/df -Fufs | grep -v Filesystem |");
while (<DF>) {
chomp;
my ($kbytes,$capacity,$fs) = (split(/\s+/))[1,4,5];
$kbytes = $kbytes / 1024;
$capacity =~ s/%$//;
$size{$fs} = $kbytes;
$capacity{$fs} = $capacity;
}
my (@a,@b,@c,@d);
foreach $fs (keys (%size)) {
if ($size{$fs} >= 0 and $size{$fs} <= 300) {
push (@a,$fs);
}
elsif ($size{$fs} > 300 and $size{$fs} <= 600) {
push (@b,$fs);
}
elsif ($size{$fs} > 600 and $size{$fs} <= 1200) {
push (@c,$fs);
}
elsif ($size{$fs} > 1200) {
push (@d,$fs);
}
}
foreach $fs (@a) {
if ($capacity{$fs} >= 70 and $capacity{$fs} < 80) {
system("$efm WARNING FILESYSTEM_FULL $host $host '\"$fs is
$capacity{$fs}% full on $host\"'");
}
elsif ($capacity{$fs} >= 80 and $capacity{$fs} < 100) {
system("$efm CRITICAL FILESYSTEM_FULL $host $host '\"$fs is
$capacity{$fs}% full on $host\"'");
}
}
foreach $fs (@b) {
if ($capacity{$fs} >= 80 and $capacity{$fs} < 90) {
system("$efm WARNING FILESYSTEM_FULL $host $host '\"$fs is
$capacity{$fs}% full on $host\"'");
}
elsif ($capacity{$fs} >= 90 and $capacity{$fs} < 100) {
system("$efm CRITICAL FILESYSTEM_FULL $host $host '\"$fs is
$capacity{$fs}% full on $host\"'");
}
}
foreach $fs (@c) {
if ($capacity{$fs} >= 90 and $capacity{$fs} < 95) {
system("$efm WARNING FILESYSTEM_FULL $host $host '\"$fs is
$capacity{$fs}% full on $host\"'");
}
elsif ($capacity{$fs} >= 96 and $capacity{$fs} < 100) {
system("$efm CRITICAL FILESYSTEM_FULL $host $host '\"$fs is
$capacity{$fs}% full on $host\"'");
}
}
foreach $fs (@d) {
if ($capacity{$fs} >= 95 and $capacity{$fs} < 97) {
system("$efm WARNING FILESYSTEM_FULL $host $host '\"$fs is
$capacity{$fs}% full on $host\"'");
}
elsif ($capacity{$fs} >= 98 and $capacity{$fs} < 100) {
system("$efm CRITICAL FILESYSTEM_FULL $host $host '\"$fs is
$capacity{$fs}% full on $host\"'");
}
}
*******************************************************
Ian A. Lowe email: Ian_Lowe@fanniemae.com
Systems Administrator voice: (202) 343-3914
*******************************************************
------------------------------
Date: Tue, 20 Oct 1998 19:38:33 GMT
From: Elaine -HappyFunBall- Ashton <eashton@bbnplanet.com>
Subject: Re: Boston.pm will be Quiz Kings [was] Randal's Big Day in Big D
Message-Id: <362CE433.E47AB1D4@bbnplanet.com>
Brand Hilton wrote:
> Speaking of which, there was a little discussion of next year's Perl
> Quiz Show on the DFW.pm mailing list. I was predicting that you and
> Chris Nandor and a ringer to be named later would be a team next year.
Boston.pm will field a team next year that will crush all competition.
:) Uri did great for having two greenhorns on his team. Boston is really
the center of the universe despite popular belief.
e.
After all, the cultivated person's first duty is to
always be prepared to rewrite the encyclopedia. - U. Eco -
------------------------------
Date: 20 Oct 1998 19:45:06 GMT
From: "Luu Tran" <luutran@geocities_.com>
Subject: Can't do "use lib"
Message-Id: <8CF8.51172394CEluutrangeocitiescom@news.mindspring.com>
Hi
My admin won't install perl5 so I grabbed a bindist and put it in my
directory (I couldn't build it.) It's working fine except I can't use any
module. (this is on freebsd-i386.)
I have this:
use lib '/usr/home/mdonline/perl/lib/perl5/i386-freebsd/5.00502';
use lib '/usr/home/mdonline/perl/lib/perl5/5.00502';
use lib '/usr/home/mdonline/perl/lib/perl5/site_perl';
use lib '/usr/home/mdonline/perl/lib/perl5';
use Net:SMTP;
perl complains that it can't find lib.pm so I change the shebang line
#!/usr/home/mdonline/bin/perl -I/usr/home/mdonline/lib
but it still doesn't find it so I get explicit
#!/usr/home/mdonline/bin/perl -I/usr/home/mdonline/lib/perl5/5.00502
which is where lib.pm is.
Now it doesn't say it can't find lib.pm but it complains
use: command not found
use: command not found
use: command not found
use: command not found
print: command not found
(I have a print statement right after the uses.) Looks like a total
failure to communicate.
I've looked at -I and use lib in the man pages but can't figure out what
the problem is. I'm tearing my hair out. Any help is appreciated.
--
luu
Please remove the underscore _ in my address when replying by email
------------------------------
Date: Tue, 20 Oct 1998 19:48:43 GMT
From: Tom Phoenix <rootbeer@teleport.com>
Subject: Re: Chat server?
Message-Id: <Pine.GSO.4.02A.9810201248270.5534-100000@user2.teleport.com>
On Sat, 17 Oct 1998, Shanx wrote:
> I would really appreciate if someone in this newsgroup could recomment
> me some FREE chat server
If you're wishing merely to _find_ (as opposed to write) programs,
this newsgroup may not be the best resource for you. There are many
freeware and shareware archives which you can find by searching Yahoo
or a similar service. Hope this helps!
--
Tom Phoenix Perl Training and Hacking Esperanto
Randal Schwartz Case: http://www.rahul.net/jeffrey/ovs/
------------------------------
Date: Tue, 20 Oct 1998 13:48:00 -0500
From: Dave Barnett <barnett@houston.Geco-Prakla.slb.com>
Subject: Re: comma formatting numbers
Message-Id: <362CDAE0.567E85E0@houston.Geco-Prakla.slb.com>
William Smith wrote:
>
> I wonder if anyone out there has a one line perl routine to format a number
> with comma's. EX: 1234567 --> 1,234,567
> For lack of anything better, I wrote this quick and dirty comma function.
>
> $num = 1234567;
> print comma($num); # prints 1,234,567
>
> Thanks for any perls of wisdom.
perldoc perlfaq5
"How can I output my numbers with commas added?"
Dave
--
Dave Barnett Software Support Engineer (281) 596-1434
If you ate pasta, and antipasta, would you still be hungry?
------------------------------
Date: 20 Oct 1998 19:51:18 GMT
From: gej@spamalot.mfg.sgi.com (Gene Johannsen)
Subject: Re: comma formatting numbers
Message-Id: <70ipjm$lgk$1@murrow.corp.sgi.com>
"William Smith" <smith.will@epa.gov> writes:
| I wonder if anyone out there has a one line perl routine to format a number
| with comma's. EX: 1234567 --> 1,234,567
| For lack of anything better, I wrote this quick and dirty comma function.
|
| $num = 1234567;
| print comma($num); # prints 1,234,567
|
| Thanks for any perls of wisdom.
|
|
| sub comma
| {
| local($x) = pop @_;
| local($a,$n,$i);
| $n = length($x);
| for ($i=0; $i < $n; $i++) {
| $a = ',' . $a if ($i && ($i % 3 == 0));
| $a = substr($x,$n-$i-1,1) . $a;
| }
| return $a;
| }
|
From the 1st Edition of the Camel book, page 237:
sub commas {
local($_) = shift;
1 while s/(.*\d)(\d\d\d)/$1,$2/;
$_;
}
It's a little shorter than yours.
If you want a one liner, use:
1 while $num =~ s/(.*\d)(\d\d\d)/$1,$2/;
gene
------------------------------
Date: 20 Oct 1998 19:06:10 GMT
From: Steve Howie <showie@uoguelph.ca>
Subject: Communicating with an external program
Message-Id: <70imv2$an0$1@testinfo.uoguelph.ca>
Many thanks to those who responded to my question regarding carrying out
a dialogue with an external program. I have tried a number of proposed
solutions and they all work fine. But I'm going to make use of the
Expect.pm module since it makes it really easy to check a number of
different error message texts returned by the called program.
Scotty
--
Steve Howie root@127.0.0.1
Netnews and Listserv Admin 519 824-4120 x2556
University of Guelph
"If it's not Scottish it's CRRRRAAAAAAAPPPPPP!"
------------------------------
Date: Wed, 21 Oct 1998 08:24:28 +1300
From: Arran Price <arranp@datamail.co.nz>
Subject: curly quick question
Message-Id: <362CE36C.6B78@datamail.co.nz>
Take the following script:
#!/usr/local/bin/perl
print "doing something";
system("find /usr/* -name foo");
Why does the print happen after the system call has finished?
if I change it so theres a \n in the print call then it does do it first
eg
#!/usr/local/bin/perl
print "doing something\n";
system("find /usr/* -name foo");
Unfortunately what I wanted to do was say what it was doing and then add
either
-Successful or -Failed on the same line once it had finished the
operation.
eg output would be
Doing find (does the operation) - Successful (on the same line)
Any help appreciated.(even if its just pointing to where in the docs
this may be mentioned as I havent been able to find it)
Arran
My opinions are my own and do not reflect those of my employer.
------------------------------
Date: Tue, 20 Oct 1998 12:44:28 -0700
From: lr@hpl.hp.com (Larry Rosler)
Subject: Re: curly quick question
Message-Id: <MPG.109687f3afb0bf6798982a@nntp.hpl.hp.com>
[Posted to comp.lang.perl.misc and a copy mailed.]
In article <362CE36C.6B78@datamail.co.nz> on Wed, 21 Oct 1998 08:24:28
+1300, Arran Price <arranp@datamail.co.nz> says...
> Take the following script:
>
> #!/usr/local/bin/perl
>
> print "doing something";
> system("find /usr/* -name foo");
>
> Why does the print happen after the system call has finished?
perlfaq5: "How do I flush/unbuffer a filehandle? Why must I do this?"
--
(Just Another Larry) Rosler
Hewlett-Packard Laboratories
http://www.hpl.hp.com/personal/Larry_Rosler/
lr@hpl.hp.com
------------------------------
Date: Tue, 20 Oct 1998 21:54:39 +0100
From: "Jonkers" <snif.nospamplease@xs4all.nl>
Subject: Re: Example Threads
Message-Id: <70ipln$pd9$1@news2.xs4all.nl>
Steve Wells wrote in message <362CBE49.EF62C1C1@cedarnet.org>...
>If anyone would be so kind as to point me to an
>example program using threads in PERL I'd really
>appreciate it. I have never programmed using
>threads and would very much like to try my hand
>at them...
Have a look at the most The Perl Journal, order via www.tpj.com
>
>TIA,
>STEVE
------------------------------
Date: Tue, 20 Oct 1998 14:38:17 -0500
From: Chris Haines <chris@krisberg-haines.com>
Subject: Handling cookies in Perl for IE
Message-Id: <362CE6A9.407FBC5F@krisberg-haines.com>
I am having problems being able to manipulate cookies for IE 4
browsers. Has anyone else had this problem or have any ideas of what to
do?
------------------------------
Date: Tue, 20 Oct 1998 19:29:39 GMT
From: jkane@my-dejanews.com
Subject: Re: help shorten one-liner
Message-Id: <70iob3$5tm$1@nnrp1.dejanews.com>
In article <70ibq0$qqk@hpcvsnz.cv.hp.com>,
"John P. Scrimsher" <john_scrimsher@ex.cv.hp.com> wrote:
> #!/usr/local/bin/perl
>
> $filename = shift(@ARGV);
> open (FILE, "<$filename")
> while(<FILE>)
> {
> $_ =~ s/\s//g;
> $a += if(!(/\#/) && $_)
This line does not work!
I get :syntax error in file 1 at line 7, next 2 tokens "= if"
(after adding the missing semicolons :)
> }
> print "Lines in $filename: $a\n"
>
> This should do everything that you are asking... It takes a filename as a
> command line arg, opens the file and checks each line. First it converts
> all spaces to nothing, creating one long string of characters or a nothing
> string. If the line is blank after this or has a # anywhere in it, it is not
> counted.
First, this is not a one-line piece of code. I want this to replace grep|wc
on a command line.
Second, I was looking for comments that are appended to code lines. By
getting rid of all #'s these are eliminated. As are any lines using the
$#ARGV variable.
I find the '$a += if ...' line to be interesting. I just couldn't get it to
work!
>
> John Scrimsher
> john_scrimsher@hp.com
>
> jkane@my-dejanews.com wrote in message <70i2pp$g3r$1@nnrp1.dejanews.com>...
> >I am new to perl, and am trying to learn it. As a learning tool I am
> counting
> >things in a perl script.
> >
> >I am trying to count the number of lines that have code and comments in
> them.
>
> >While NOT counting the lines that are ONLY comments, blank, or have a # as
> >part of the text in the code. (I am helping myself by putting spaces after
> >all #'s that are comments.) i.e.
> >
> > # Number of args left, plus the current one, give the remainder divided by
> 2.
> > # If there are not an even number of arguments, it MUST be wrong.
> >
> > if (($#ARGV+1)%2) {
> >
> >Those four lines should NOT match at all!
-----------== Posted via Deja News, The Discussion Network ==----------
http://www.dejanews.com/ Search, Read, Discuss, or Start Your Own
------------------------------
Date: Tue, 20 Oct 1998 19:29:27 GMT
From: Darrin Edwards <d-edwards@nospam.uchicago.edu>
Subject: Re: help: hash
Message-Id: <tg3e8jyqug.fsf@noise.bsd.uchicago.edu>
"Rolf Rettinger" <rolf.rettinger@desy.de> writes:
> I have a list @groups, where the administrative groups of an user are given
> and I have a list @users or better $users[$i], where the members of each
> group in @groups are given. My problem is how to write that information in a
> %hash that I can correlate each group and the corresponding users from the
> web by a select statement or a scroll menue?
>
> Thank's Rolf
Sounds like a hash of arrays (really array references) might be
useful. Your hash %Members would have keys, like $This_group, where
$Members{$This_group} gives a (reference to an) array containing
the users in that group. You might need a similar ("inverted")
structure if a given user can be in more than one group, otherwise
you can just have a regular hash for that.
This is described in detail in perldsc under the heading
"HASHES OF LISTS." perlref will also be of great help if
you aren't yet familiar with perl's reference syntax.
(Not sure at all about the "web" part; if this wasn't really
a question about the perl side of things, my apologies.)
Best wishes,
Darrin
------------------------------
Date: Tue, 20 Oct 1998 15:01:30 -0400
From: danbeck@eudoramail.com (Daniel Beckham)
Subject: Re: how do you search subdirectories for a file?
Message-Id: <MPG.1096a81139228edd989695@news.supernews.com>
Holy cow. I never new about File::Find. I'm sitting here writing a
recursive function to search html files for a string to replace and I
nearly finished it when I stumbled across this thread.
Thanks a billion!
Daniel Beckham
In article <362C6DF6.517F7810@technologist.com>, perlguy@technologist.com
says...
> Try using File::Find.
>
> Also, just because you opendir a directory, it doesn't "magically" read
> it for you. Look up the "readdir" function if you want to read the
> contents.
>
> HTH,
> Brent
>
------------------------------
Date: 20 Oct 1998 19:17:51 GMT
From: root@ernie.sesamstraat (root)
Subject: LWP documentation
Message-Id: <slrn72podi.qt.root@ernie.sesamstraat>
Am I correct that URI::Escape is not mentioned anywhere in the LWP
docs?
I stumbled across it by accident in my latest Dejanews dig by accident.
But it was exactly what I was looking for.
I never knew I could 'man URI::Escape'...
--
Koos
kp@multiweb.nl
------------------------------
Date: Tue, 20 Oct 1998 15:32:15 -0400
From: John Porter <jdporter@min.net>
Subject: Re: New Module: File::Finder -- OO version of File::Find
Message-Id: <362CE53F.6DF5A81E@min.net>
Randal Schwartz wrote:
>
> >>>>> "John" == John Porter <jdporter@min.net> writes:
>
> John> Global variables in the interface? Ugh.
>
> File::Find uses chdir, as does your File::Finder. Therefore, you
> cannot have two instances of a "File::Finder" object alive
Yah, good point. WIHTOT! (Wish I had though of that)
> without completely rehacking the code to remove chdir(),
You exaggerate the radicalness of that change.
I did it in about ten minutes. (Ain't perl great.)
> and therefore making
> it significantly slower since you must continually use full paths
> in stat calls.
I'm sorry, but my benchmarks contradict your claim.
As a test, I ran my first cut and my new chdir-less version
against /usr on my Sparc Solaris:
Old way, with chdir and stat(.):
52 secs (32.69 usr 3.41 sys + 0.01 cusr 0.11 csys = 36.22 cpu)
New way, w/o chdir and stat(fullpath):
40 secs (33.01 usr 2.43 sys + 0.04 cusr 0.07 csys = 35.55 cpu)
> So, if you can have only a sole instance, global variables make sense.
I don't see anywhere in the description of Singleton any words
to the effect, "Forget everything you ever learned from OOD -- and
from structured programming too."
> The right design for the right job.
I actually am not saying the interface of File::Find is horrible.
I like passing the subref in. I just don't like the global vars.
The implementation of File::Find is grody. First, it duplicates
99% of its code in two pairs of functions, one pair for the
depth-first and one for the other way. My first File::Finder
repaired that oozing scab. Secondly, the fact that File::Find does
chdir's is horrendous. It forces it to be a Singleton, regardless
of whether that's appropriate for the app or not. You call
that a "right design"? OO-phobes are warned from viewing my new
version of File::Finder (posted elsewhere in this thread) which
takes care of that little nasty as well.
> I agree with tchrist...
Now I can die happy.
> in response to your first posting, I almost had to look at
> the calendar to make sure it wasn't April 1st.
Fart.
--
John "Gashlycrumb" Porter
"The suicide, as she is falling
illuminated by the moon,
Regrets her act, and finds appalling
The fact that she'll be dead so soon." -- EG
------------------------------
Date: Tue, 20 Oct 1998 15:48:01 -0400
From: John Porter <jdporter@min.net>
Subject: Re: New Module: File::Finder -- OO version of File::Find
Message-Id: <362CE8F1.77939D78@min.net>
New version of File::Finder.
In response to overwhelming user demand, I have added a
minor feature.
Ilya Zakharevich wrote:
>
> You cannot have several of them running simultaneously. You cannot
> start one inside another one.
Fixed.
> find( { wanted => \&wanted, bydepth => 1,
> _ => \$shortname, name => \$longname, dir => $dir },
> "." )
See how File::Finder::find and File::Finder::finddepth work now.
> Hmm, maybe also a sub to call when going up the directory tree,
> updir => \&updir,
Done.
John Porter
package File::Finder;
require 5.000;
use Config;
require Cwd;
require File::Basename;
=head1 NAME
File::Finder->find - traverse a directory tree
File::Finder->finddepth - traverse a directory tree depth-first
=head1 SYNOPSIS
use File::Finder;
@MyFileFinder::ISA = qw(File::Finder);
sub MyFileFinder::callback {
my $self = shift;
my $filename = shift;
print $self->name, "\n";
}
sub MyFileFinder::up_dir {
my $self = shift;
my $filename = shift;
print "<", $self->name, "\n";
}
MyFileFinder->find( '/usr' );
MyFileFinder->finddepth( '/usr' );
=head1 DESCRIPTION
File::Finder is an object-oriented adaptation of the routines
found in File::Find. Rather than passing a sub ref to the find()
function, you derive a class which overrides the callback() method.
For each directory entry encountered during the traversal, the
callback is called. The callback is passed one additional argument:
the name of the file in the current directory; also, you are chdir'd
to that directory whenever the callback is called.
Within the callback, you can obtain other information about
the directory entry by calling the following methods of the object:
$self->dir returns the current directory name;
$self->name returns the full path name of the directory entry;
To prune the search tree at the current directory, the callback
should call $self->prune(1).
C<finddepth> is just like C<find>, except that it does a depth-first
search.
These two methods are actually just simple wrappers which set the
value of the depth_first field (by calling the depth_first() method)
before calling the traverse_tree method. You can do all that yourself
if you're so inclined.
C<up_dir> is called whenever the traversal moves up a level in the
directory tree. $self->name gives the name of the directory being
left. The default action for this event is null.
=head2 Note
You do not have to override the default callback to get useful
behavior. If you just want the full path name printed to stdout
for each node encountered, you can use File::Finder directly:
File::Finder->find( '/usr' );
=head1 BUGS
There is currently no way to make find or finddepth follow symlinks.
=head1 AUTHOR
1998-10-16 John Porter jdporter@min.net
=cut
package File::Finder;
require 5.000;
use Config;
require File::Basename;
use strict;
my( $Is_VMS, $Is_NT, $dont_use_nlink );
# not meant to be called by the general public.
sub new {
my $p = shift;
bless {
topdirs => [ @_ ],
frames => [],
prune => 0,
depth_first => 0,
}, $p;
}
sub dir {
my $self = shift;
$self->{'frames'}[0][0]
}
sub fixed_dir {
my $self = shift;
$self->{'frames'}[0][1]
}
sub name {
my $self = shift;
$self->{'frames'}[0][2]
}
sub nlink {
my $self = shift;
$self->{'frames'}[0][3]
}
sub Push {
my $self = shift;
unshift @{ $self->{frames} }, [ @_ ];
}
sub Pop {
my $self = shift;
shift @{ $self->{frames} };
}
sub prune {
my( $self, $val ) = @_;
defined $val and $self->{prune} = $val;
$self->{prune}
}
sub depth_first {
my( $self, $val ) = @_;
defined $val and $self->{depth_first} = $val;
$self->{depth_first}
}
sub indent {
my $self = shift;
' ' x @{ $self->{'frames'} };
}
#
# the default callback prints the full name.
#
sub callback {
my $self = shift;
my $file = shift;
# print(
# " prune : ", $self->prune, "\n",
# " dir : ", $self->dir, "\n",
# " fixdir: ", $self->fixed_dir, "\n",
# " name : ", $self->name, "\n",
# " file : $file\n",
# );
print $self->indent, $self->name, "\n";
}
sub down_dir {
my $self = shift;
# print $self->indent, ">", $self->dir, "\n";
}
sub up_dir {
my $self = shift;
# print $self->indent, "<", $self->dir, "\n";
}
sub find {
my $pkg = shift;
my $self = $pkg->new( @_ );
$self->depth_first( 0 );
$self->traverse_tree;
}
sub finddepth {
my $pkg = shift;
my $self = $pkg->new( @_ );
$self->depth_first( 1 );
$self->traverse_tree;
}
#
# this sub is not recursive.
#
sub traverse_tree {
my $self = shift;
my $cwd = Cwd::cwd();
for my $topdir ( @{ $self->{topdirs} } ) {
my( $topdev, $topino, $topmode, $topnlink ) =
$Is_VMS
? stat($topdir)
: lstat($topdir)
;
unless ( defined $topnlink ) {
warn "Can't stat $topdir: $!\n";
next;
}
if ( -d _ ) {
my $fixtopdir = $topdir;
$fixtopdir =~ s,/$,, ;
$fixtopdir =~ s/\.dir$// if $Is_VMS;
$fixtopdir =~ s/\\dir$// if $Is_NT;
# dir: fixed_dir: name: nlinks:
$self->Push( $topdir, $fixtopdir, $topdir, $topnlink );
$self->down_dir;
$self->prune( 0 );
$self->depth_first or $self->callback( '.' );
$self->prune or $self->_find_R;
$self->depth_first and $self->callback( '.' );
$self->up_dir;
$self->Pop;
}
else {
my($f,$d);
unless (($f,$d) = File::Basename::fileparse($topdir)) {
($f,$d) = ($topdir, '.');
}
# dir: fixed_dir: name: nlinks:
$self->Push( $d, $d, $topdir, $topnlink );
$self->down_dir;
$self->callback( $f );
$self->up_dir;
$self->Pop;
}
}
}
sub _find_R {
my $self = shift;
# Get the list of files in the current directory.
opendir DIR, $self->dir
or do { warn "Can't open ".$self->dir.": $!\n"; return };
my @filenames = readdir DIR;
closedir DIR;
if ($self->nlink == 2 && !$dont_use_nlink) {
# This dir has no subdirectories.
for (@filenames) {
next if $_ eq '.' || $_ eq '..';
$self->Push(
$self->dir,
$self->fixed_dir,
$self->dir . "/$_",
0
);
$self->callback( $_ );
$self->Pop;
}
}
else {
# This dir has subdirectories.
my $subcount = $self->nlink - 2;
for (@filenames) {
next if $_ eq '.' || $_ eq '..';
my $dr = join '/', $self->dir, $_;
$self->Push(
$self->dir,
$self->fixed_dir,
$dr,
0
);
$self->prune( 0 );
$self->depth_first or $self->callback( $_ );
if ($subcount > 0 || $dont_use_nlink) { # Seen all subdirs?
# Get link count and check for directoriness.
my($dev,$ino,$mode,$nlink) =
$Is_VMS
? stat($dr)
: lstat($dr)
;
if ( -d _ ) {
# It really is a directory, so do it recursively.
if ( !$self->prune ) {
my $d = $self->name;
$d =~ s/\.dir$// if $Is_VMS;
$d =~ s/\\dir$// if $Is_NT;
$self->Push(
$d,
$self->fixed_dir,
$d,
$nlink
);
$self->down_dir;
$self->_find_R;
$self->up_dir;
$self->Pop;
}
--$subcount;
}
}
$self->depth_first and $self->callback( $_ );
$self->Pop;
}
}
}
#
# Set dont_use_nlink in your hint file if your system's stat doesn't
# report the number of links in a directory as an indication
# of the number of files.
# See, e.g. hints/machten.sh for MachTen 2.2.
#
$dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'});
# These are hard-coded for now, but may move to hint files.
if ( $^O eq 'VMS' ) {
$Is_VMS = 1;
$dont_use_nlink = 1;
}
if ( $^O =~ /^mswin32/i ) {
$Is_NT = 1;
$dont_use_nlink = 1;
}
if ( $^O eq 'os2' || $^O eq 'msdos' || $^O eq 'amigaos' ) {
$dont_use_nlink = 1
}
1;
__END__
------------------------------
Date: Tue, 20 Oct 1998 23:29:59 +0500
From: assa@assa.tlt.ru (Alexander Trump)
Subject: Re: PERL and a DATABASE..
Message-Id: <7rki07.6g2.ln@assa61.assa.tlt.ru>
DPortal Webmaster (webmaster_NO*SPUDS*@dportal.co.uk) wrote:
: I would like to query a database using PERL (and something like SQL), but I
: can only seem to be able to do this on NT, does anyone know of any
: UNIX/LINUIX database's that I can query using PERL. (If there FREE then even
: better ;-) ).
You can find the following SQL servers at Linux free: Ingres, Sybase, Oracle
(very alpha), Postgres, Informix (coming soon), mSQL, mySQL...
Choose the appropriate.
--
Sincerely, Alexander
------------------------------
Date: Tue, 20 Oct 1998 18:59:50 GMT
From: Pierre Laplante <Pierre.Laplante@intellia.com>
Subject: PerlCtrl.pl & VBSCRIPT
Message-Id: <362CDCF8.6F71662A@intellia.com>
This is a multi-part message in MIME format.
--------------C9863DC149A34E645F775ACB
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
I am trying to write a COM object that will be used from a VBSCRIPT
program.
My COM object has an attributes with the following definition :
$attr = [ [1, 2, 3], [4, 5, 6], [7, 8, 9]] ;
How can I access this kind of attribute from a VBSCRIPT program?
Does anybody know the definition of the VT_ type of thing?
Thanks, (I'll resume the answer)
--------------C9863DC149A34E645F775ACB
Content-Type: text/x-vcard; charset=us-ascii;
name="Pierre.Laplante.vcf"
Content-Transfer-Encoding: 7bit
Content-Description: Card for Pierre Laplante
Content-Disposition: attachment;
filename="Pierre.Laplante.vcf"
begin:vcard
n:Laplante;Pierre
x-mozilla-html:TRUE
org:Intellia Inc.
adr:;;;Montreal;Quibec;H3C 1X6;Canada
version:2.1
email;internet:pierre.laplante@intellia.com
title:Conseiller principal
tel;fax:514.392.0911
tel;work:514.392.1292
note:Pierre.Laplante@altavista.net
x-mozilla-cpt:;0
fn:Pierre Laplante
end:vcard
--------------C9863DC149A34E645F775ACB--
------------------------------
Date: 20 Oct 1998 15:57:37 -0400
From: ziggy@panix.com (Adam Turoff)
Subject: Re: Raleigh.pm (Raleigh, NC, USA perl mongers) has registered
Message-Id: <70ipvh$odu@panix.com>
John Porter <jdporter@min.net> wrote:
>Adam Turoff wrote:
>>
>> I'm not sure of the name, but it's the canonical example of legal
>> scotch
>> that's not blended in Scotland. The purveyor is a French blender who
>> buys barrels after they've aged the minimum 3 (?) years on Scotland.
>
>Now that's just too strange. The scotch makers prefer (IIRC)
>to use used American bourbon casks.
This is still the case. I believe the legal definition of Scotch in
Scotland (and by convention, in the EC and worldwide?) is a malt beverage
brewed, and distilled in Scotland, and aged there for no less than 3 years.
After spending its childhood in Scotland, the merry little droplets of
nectar can legally be smuggled into another country and still called Scotch.
It looses the ability to be called a single malt, but 'Blended Scotch Whiskey'
and 'Product of France' are still kosher. Go figure.
One of these days I gots to get me a bottle of this stuff. It makes about
as much sense as the best belgian white beer being brewed in Austin, and
the best belgian cherry beer being brewed in Wisconsin.
What will they think of next? French wines from California?
>It seems that the second|later
>batch of whiskey out of barrel is better than the previous.
>Unless you're a bourbon fan. :-)
Again, I don't know what kind of 2-ary or 3-ary aging they do at this
blender. Port, Sherry and Maderia casks make for a nice finish. Might be
using something like that...
Z.
------------------------------
Date: 20 Oct 1998 19:20:23 GMT
From: bhilton@tsg.adc.com (Brand Hilton)
Subject: Re: Randal's Big Day in Big D
Message-Id: <70inpn$gov2@mercury.adc.com>
In article <saraf2rnk0j.fsf@camel.fastserv.com>,
Uri Guttman <uri@camel.fastserv.com> wrote:
>>>>>> "BH" == Brand Hilton <bhilton@tsg.adc.com> writes:
>
> BH> give the same talk. I think we can get even more people now that
> BH> I kind of know what I'm doing. Keep your ears open.
>
>i kinda suspected you didn't know what you are doing at the perl quiz!
You only suspected? I thought it was obvious! ;-)
>:-)
>
>just another sore second place perl quiz hacker,
Speaking of which, there was a little discussion of next year's Perl
Quiz Show on the DFW.pm mailing list. I was predicting that you and
Chris Nandor and a ringer to be named later would be a team next year.
I was wondering... are Stonehenge Consulting and/or the Christiansen
Consultancy going to field teams?
And as long as I'm on the subject, I'd like to point out that, despite
my repeated nagging, Jon STILL doesn't have the contest up on the TPJ
web site. C'mon, Jon! Get on the ball! Sleep is for wimps!
--
_____
|/// | Brand Hilton bhilton@adc.com
| ADC| ADC Telecommunications, ATM Transport Division
|_____| Richardson, Texas
------------------------------
Date: Tue, 20 Oct 1998 19:43:54 GMT
From: Randal Schwartz <merlyn@stonehenge.com>
Subject: Re: Randal's Big Day in Big D
Message-Id: <8cpvbnuih6.fsf@gadget.cscaper.com>
>>>>> "Brand" == Brand Hilton <bhilton@tsg.adc.com> writes:
Brand> Anyway, as many of you already know, Randal came to Dallas on October
Brand> 3rd to give his Just Another Convicted Perl Hacker talk. If you're a
Brand> Perl Mongers leader, you REALLY need to take Randal up on his offer to
Brand> give this talk. The talk itself is very informative and entertaining,
Brand> and Randal is tons-o-fun to hang around with.
Brand> About 150 people packed into a conference room at the Doubletree Hotel
Brand> at Lincoln Center to hear the talk, and 25 or so hung around to buy
Brand> Randal beer at The Flying Saucer in Addison.
Thank you very much!
If you wanna see my digital pix of this event (including the
post-event partying), jump on over to
<URL:http://www.stonehenge.com/merlyn/Pictures/98-09-NYC-DFW/>.
Brand> The event was co-hosted by the DFW Unix User Group. DFWUUG really
Brand> saved my bacon by getting a room for us and paying for it out of their
Brand> own pockets. They were then generous enough to offer Stonehenge
Brand> Consulting a free space for a year on their sponsors page.
Very much appreciated.
Brand> Fun, fun, fun. I'm hoping we can get Randal back out next year to
Brand> give the same talk. I think we can get even more people now that I
Brand> kind of know what I'm doing. Keep your ears open.
I'd be honored if you'd invite me again.
And if you're following along to this point, I'd be happy to try to
arrange my JACPH talk in *any* location in the US. Sorry, can't leave
the country for a while yet. <sigh> Just write me and we can work out
the details.
--
Name: Randal L. Schwartz / Stonehenge Consulting Services (503)777-0095
Keywords: Perl training, UNIX[tm] consulting, video production, skiing, flying
Email: <merlyn@stonehenge.com> Snail: (Call) PGP-Key: (finger merlyn@teleport.com)
Web: <A HREF="http://www.stonehenge.com/merlyn/">My Home Page!</A>
Quote: "I'm telling you, if I could have five lines in my .sig, I would!" -- me
------------------------------
Date: Tue, 20 Oct 1998 14:54:28 -0400
From: Ala Qumsieh <aqumsieh@matrox.com>
Subject: Re: Strict and Global Variables
Message-Id: <Pine.SUN.3.96.981020145009.1815A-100000@tigre.matrox.com>
On 20 Oct 1998, Uri Guttman wrote:
> AQ> Declaring your variables as lexical variables (using my()) will
> AQ> localize them to your enclosing block. Thus, declaring my()
> AQ> variables at the "outermost level of code" will make these
> AQ> variables visible from everything within your program;
> ^^^^^^^
> AQ> effectively, these variables becomes global to your program.
> ^^^^^^^
>
> these my variables are global to the file, not the program. if you
> included other perl code via use or require, that code would not see
> these my vars.
>
> your comment is only true if the program is a single file of perl code
> with no outside code read in.
That is correct .. I know that and I guess I should've been clearer with
my reply. When I said "your program" I meant "your file" .. although, as
you said, that is not generally true.
Shall I slap myself again?
--
Ala Qumsieh email: aqumsieh@matrox.com
ASIC Design Engineer phone: (514) 822-6000 x7581
Matrox Graphics Inc. (old) webpage :
Montreal, Quebec http://www.cim.mcgill.ca/~qumsieh
------------------------------
Date: Tue, 20 Oct 1998 23:15:32 +0500
From: assa@assa.tlt.ru (Alexander Trump)
Subject: Re: The space deletion woes...
Message-Id: <40ki07.6g2.ln@assa61.assa.tlt.ru>
Mark D. (mark@doddx.com) wrote:
[...]
: Here goes nothing one space now
: becomes
: Heregoes nothing one space now
: My code is this:
: $cgi_client{'upfile'} =~ s/^\s+//;
: $cgi_client{'upfile'} =~ s/\s+$//;
: $cgi_client{'upfile'} =~ s/\s+/ /g;;
Looks good, but what the "$cgi_client{'upfile'}" is?
Are you sure it contains the string mentioned above?
--
Sincerely, Alexander
------------------------------
Date: Tue, 20 Oct 1998 18:31:03 GMT
From: Tom Phoenix <rootbeer@teleport.com>
Subject: Re: waitpid / crontab problem
Message-Id: <Pine.GSO.4.02A.9810201127060.5534-100000@user2.teleport.com>
On Fri, 16 Oct 1998, Jo Holvoet wrote:
> The waitpid call should return the pid of the child but when run from
> the crontab it always returns -1.
Probably the cron daemon is buggy, starting your program in an environment
where the signal from the child is being ignored. Try putting this line
near the start of your program, as a work-around. But complain to the
vendor, too.
$SIG{CHLD} = 'DEFAULT';
You may also be able to examine that signal status by, for example,
printing $SIG{CHLD}, to see that it's really set to be ignored, or
whatever.
Hope this helps!
--
Tom Phoenix Perl Training and Hacking Esperanto
Randal Schwartz Case: http://www.rahul.net/jeffrey/ovs/
------------------------------
Date: 12 Jul 98 21:33:47 GMT (Last modified)
From: Perl-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Special: Digest Administrivia (Last modified: 12 Mar 98)
Message-Id: <null>
Administrivia:
Special notice: in a few days, the new group comp.lang.perl.moderated
should be formed. I would rather not support two different groups, and I
know of no other plans to create a digested moderated group. This leaves
me with two options: 1) keep on with this group 2) change to the
moderated one.
If you have opinions on this, send them to
perl-users-request@ruby.oce.orst.edu.
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.misc (and this Digest), send your
article to perl-users@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.
The Meta-FAQ, an article containing information about the FAQ, is
available by requesting "send perl-users meta-faq". The real FAQ, as it
appeared last in the newsgroup, can be retrieved with the request "send
perl-users FAQ". Due to their sizes, neither the Meta-FAQ nor the FAQ
are included in the digest.
The "mini-FAQ", which is an updated version of the Meta-FAQ, is
available by requesting "send perl-users mini-faq". It appears twice
weekly in the group, but is not distributed in the digest.
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 V8 Issue 4023
**************************************
