[21709] in Perl-Users-Digest
Perl-Users Digest, Issue: 3913 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Fri Oct 4 09:06:22 2002
Date: Fri, 4 Oct 2002 06:05:11 -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 Fri, 4 Oct 2002 Volume: 10 Number: 3913
Today's topics:
Avoid zombie and get exit status (Samppa)
Re: Avoid zombie and get exit status <garry@ifr.zvolve.net>
Can't use string () as an ARRAY ref while "strict refs <ReplyToGroup@thanks.com>
Re: Can't use string () as an ARRAY ref while "strict r <Tassilo.Parseval@post.rwth-aachen.de>
Re: Can't use string () as an ARRAY ref while "strict r <Tassilo.Parseval@post.rwth-aachen.de>
Re: Can't use string () as an ARRAY ref while "strict r <johannes.fuernkranz@t-online.de>
Re: case insensitive -f and -d <nospam@nospam.com>
Re: case insensitive -f and -d nobull@mail.com
Re: case insensitive -f and -d <pinyaj@rpi.edu>
How to change unix file access timestamp in perl? <mcduff@its.uq.edu.au>
Re: How to change unix file access timestamp in perl? <ak@freeshell.org.REMOVE>
Re: How to geta list of perl modules <ron@savage.net.au>
how to read the image content. <flying_dragon@china.com>
Re: ignore case in Greek <mgjv@tradingpost.com.au>
Installing Perl Modules: What actually happens? (david rayner)
Re: Installing Perl Modules: What actually happens? <bernard.el-hagin@DODGE_THISlido-tech.net>
ISP based List Server Programme <john.moorhouse@ukonline.co.uk>
Re: miniperl dumps core with Perl 5.8.0 on Solaris 7 64 (Martin Kerharo)
Re: nice comments in linux src <Tassilo.Parseval@post.rwth-aachen.de>
Perl to get DOCUMENT_ROOT on IIS <add@nrcan.gc.ca>
Re: Perl to get DOCUMENT_ROOT on IIS <tk@WINDOZEdigiserv.net>
Re: Perl to get DOCUMENT_ROOT on IIS <add@nrcan.gc.ca>
Re: Script to Change Filename <usenet@tinita.de>
Re: Script to Change Filename <NO_SPAM_pangjoe@rogers.com>
Re: Script to Change Filename <NO_SPAM_pangjoe@rogers.com>
Win32::Console <spikey-wan@bigfoot.com>
Re: Win32::Console <externe.scetbon@francetelecom.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 4 Oct 2002 05:32:14 -0700
From: sami@xenetic.fi (Samppa)
Subject: Avoid zombie and get exit status
Message-Id: <30586a1d.0210040432.278833a4@posting.google.com>
hello,
The signal option $SIG{CHLD} = 'IGNORE'; is obviously
used to avoid zombie processes. If I use this option no zombie will
occur, but I can't receive the child's exit status. If I change the signal
handling to $SIG{CHLD} = 'DEFAULT'; the child's exit status via $? variable
is received fine, but also zombie process will occur.
You can demonstration the zombie effect by using kill -9 command for the
shell process created by this script.
Any ideas how to get both; no zombie and exit status of child ?
(NOTICE: the child is called through the pipe so, that you can read
the child's stdout from parent)
Here is an example code:
-----------------------------------------------------------------
#!/usr/bin/perl
$cmd = "/bin/echo 'Hello';sleep 30";
#$SIG{CHLD} = 'DEFAULT';
$SIG{CHLD} = 'IGNORE';
@answer = qx($cmd);
print ">$_\n" foreach (@answer);
$status = $? >> 8;
if ($status) {
print "Error ... $status.\n";
}
else {
print "ok.\n";
}
-----------------------------------------------------------------
output with option DEFAULT is:
>Hello
ok.
output with option IGNORE is:
>Hello
Error ... 16777215.
regards,
Sami
------------------------------
Date: Fri, 04 Oct 2002 12:53:34 GMT
From: Garry Williams <garry@ifr.zvolve.net>
Subject: Re: Avoid zombie and get exit status
Message-Id: <slrnapr3kk.l96.garry@zfw.zvolve.net>
On 4 Oct 2002 05:32:14 -0700, Samppa <sami@xenetic.fi> wrote:
> The signal option $SIG{CHLD} = 'IGNORE'; is obviously used to avoid
> zombie processes. If I use this option no zombie will occur, but I
> can't receive the child's exit status. If I change the signal
> handling to $SIG{CHLD} = 'DEFAULT'; the child's exit status via $?
> variable is received fine, but also zombie process will occur.
[snip]
> Any ideas how to get both; no zombie and exit status of child ?
This is how the perlipc manual page says to do it:
use POSIX ":sys_wait_h";
$SIG{CHLD} = sub {
my $pid;
while (($pid = waitpid(-1, WNOHANG)) > 0) {
warn "reaped $pid" . ($? ? " with exit $?" : '');
}
};
--
Garry Williams
------------------------------
Date: Fri, 4 Oct 2002 11:02:12 +0100
From: "Simon Harvey" <ReplyToGroup@thanks.com>
Subject: Can't use string () as an ARRAY ref while "strict refs in use. Eh?
Message-Id: <sGdn9.12302$J47.1102593@stones>
Hi Guys,
Does anyone know what the following means. I dont know whys its saying I'm
using "Boxing Club" as a Reference. Boxing club should be what is contained
in the array!
Can't use string ("Boxing Club") as an ARRAY ref while "strict refs" in use
at .....
Any ideas?. I'll put the code at the bottom incase that helps.
if($allClubs[$allClubsCounter][0] == $memberships[$membershipsCounter][2]){
($dynamicString .= <<" EoT");
<tr>
<td><font size="2" face="Arial, Helvetica,
sans-serif">$allClubs[$allClubsCounter][1]</font></td>
<td><div align="center"><input name="chkRegisteredClub$checkboxNo"
type="checkbox" value="1" checked></div></td>
</tr>
EoT
$dynamicString =~ s/^s+//gm;
$checkboxNo++;
}
Thanks to anyone who can help
Kind Regards
Simon
------------------------------
Date: 4 Oct 2002 10:26:05 GMT
From: "Tassilo v. Parseval" <Tassilo.Parseval@post.rwth-aachen.de>
Subject: Re: Can't use string () as an ARRAY ref while "strict refs in use. Eh?
Message-Id: <anjqbt$96d$1@nets3.rz.RWTH-Aachen.DE>
Also sprach Simon Harvey:
> Does anyone know what the following means. I dont know whys its saying I'm
> using "Boxing Club" as a Reference. Boxing club should be what is contained
> in the array!
>
> Can't use string ("Boxing Club") as an ARRAY ref while "strict refs" in use
> at .....
You should have better marked the line to make it easier for us to find
it.
> Any ideas?. I'll put the code at the bottom incase that helps.
>
>
> if($allClubs[$allClubsCounter][0] == $memberships[$membershipsCounter][2]){
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
These two are the suspects. Remember, this is equivalent to:
$allClubs->[$allClubsCounter]->[0];
So, $allClubs must be a reference to an array and so must
$allClubs->[$allClubsCounter]. I suggest you print out the
data-structure to see what's going on:
use Data::Dumper;
print Dumper $allClubs;
If output looks like this:
$VAR1 = [
'BoxingClub'
'...'
];
then something went wrong when populating the array-ref. It should look
like this:
$VAR1 = [
[
'BoxingClub'
],
[
'BoxingClub2'
]
];
[...]
Tassilo
--
$_=q!",}])(tsuJ[{@"tnirp}3..0}_$;//::niam/s~=)]3[))_$-3(rellac(=_$({
pam{rekcahbus;})(rekcah{lrePbus;})(lreP{rehtonabus;})(rehtona{tsuJbus!;
$_=reverse;s/sub/(reverse"bus").chr(32)/xge;tr~\n~~d;eval;
------------------------------
Date: 4 Oct 2002 12:49:48 GMT
From: "Tassilo v. Parseval" <Tassilo.Parseval@post.rwth-aachen.de>
Subject: Re: Can't use string () as an ARRAY ref while "strict refs in use. Eh?
Message-Id: <ank2pc$grk$1@nets3.rz.RWTH-Aachen.DE>
Also sprach Johannes Fürnkranz:
> Tassilo v. Parseval wrote:
>>>
>>>if($allClubs[$allClubsCounter][0] == $memberships[$membershipsCounter][2]){
>>
>> ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
>>
>> These two are the suspects. Remember, this is equivalent to:
>>
>> $allClubs->[$allClubsCounter]->[0];
>
> Is it?
> I thought that $a->[$i][$j] is equivalent to $a->[$i][$j], but
> $a[$i][$j] is equivalent to $a[$i]->[$j]?
Oups, right you are. It's not $allClubs being an array-ref or array-refs
in the OP's code but rather @allClubs holding references to arrays.
Tassilo
--
$_=q!",}])(tsuJ[{@"tnirp}3..0}_$;//::niam/s~=)]3[))_$-3(rellac(=_$({
pam{rekcahbus;})(rekcah{lrePbus;})(lreP{rehtonabus;})(rehtona{tsuJbus!;
$_=reverse;s/sub/(reverse"bus").chr(32)/xge;tr~\n~~d;eval;
------------------------------
Date: Fri, 04 Oct 2002 14:37:01 +0200
From: Johannes Fürnkranz <johannes.fuernkranz@t-online.de>
Subject: Re: Can't use string () as an ARRAY ref while "strict refs in use. Eh?
Message-Id: <ank24m$bqm$01$1@news.t-online.com>
Tassilo v. Parseval wrote:
>>
>>if($allClubs[$allClubsCounter][0] == $memberships[$membershipsCounter][2]){
>
> ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
>
> These two are the suspects. Remember, this is equivalent to:
>
> $allClubs->[$allClubsCounter]->[0];
Is it?
I thought that $a->[$i][$j] is equivalent to $a->[$i][$j], but
$a[$i][$j] is equivalent to $a[$i]->[$j]?
Juffi
------------------------------
Date: Fri, 4 Oct 2002 01:08:37 -0700
From: "Tan Nguyen" <nospam@nospam.com>
Subject: Re: case insensitive -f and -d
Message-Id: <3d9d4bfe$1_1@nopics.sjc>
"Kiyohiro Honda" <kiyo9876@yahoo.co.jp> wrote
> Hi,guys!
> Would you please give me your suggestions?
>
> I want a function that is similar to -f and -d , BUT
> which ignore lower and upper case.
> For example, when I put "/Foo/BAR/Aaa.gif" to the function
> and there exists "/fOO/Bar/aAa.gif", then the fucntion returns true.
>
> please show me some example code.
>
> Tnank you very much in advance.
> #and sorry for my broken English.
>
> K
I'm just curious about what you are trying to accomplish. Filename
case-sensitiveness is entirely dependant on your OS. If you run your code on
Windows, you wouldn't worry about case-sensitiveness of filenames at all.
Perl will report what the OS tells it when checking for the existence of a
file.
On Unices, if two files might completely differenct even though their names
look alike with the exception of case. I don't know what you're trying to
accomplish, but you can always hack it so that it works as you described by
trying all possible combinations of a given filename until there's a match.
Of course, it's extremely slow. Run-time is O(m^n) where n is the length of
your filename minus all dilimeters and m is the number of possible values
for one character in the filename, so don't try it at home.
------------------------------
Date: 4 Oct 2002 05:01:42 -0700
From: nobull@mail.com
Subject: Re: case insensitive -f and -d
Message-Id: <4dafc536.0210040401.db3a594@posting.google.com>
kiyo9876@yahoo.co.jp (Kiyohiro Honda) wrote in message news:<2ca34ccc.0210032255.5f3e9047@posting.google.com>...
> Hi,guys!
> Would you please give me your suggestions?
>
> I want a function that is similar to -f and -d , BUT
> which ignore lower and upper case.
> For example, when I put "/Foo/BAR/Aaa.gif" to the function
> and there exists "/fOO/Bar/aAa.gif", then the fucntion returns true.
The -f and -d are really just special inferfaces to the underlying
OS's stat() function.
Unless the underlying OS supports the concept of case insensative
filenames you'll just have to do it by brute force.
use File::Find;
sub find_files_caseless {
my $sought = lc shift;
my @found;
find sub {
my $name = lc $File::Find::name;
push @found => $File::Find::name if $name eq $sought;
$File::Find::prune = 1 unless index($sought,$name) == 0;
}, '/';
@found;
}
------------------------------
Date: Fri, 4 Oct 2002 08:51:57 -0400
From: Jeff 'japhy' Pinyan <pinyaj@rpi.edu>
To: Kiyohiro Honda <kiyo9876@yahoo.co.jp>
Subject: Re: case insensitive -f and -d
Message-Id: <Pine.A41.3.96.1021004084830.60890A-100000@vcmr-104.server.rpi.edu>
[posted & mailed]
On 3 Oct 2002, Kiyohiro Honda wrote:
>I want a function that is similar to -f and -d , BUT
>which ignore lower and upper case.
>For example, when I put "/Foo/BAR/Aaa.gif" to the function
>and there exists "/fOO/Bar/aAa.gif", then the fucntion returns true.
I think I'd use glob():
my @matches = find_file_ci("/Foo/BAR/Aaa.gif");
sub find_file_ci {
my $f = lc shift;
$f =~ s/([a-z])/[$1\U$1]/g;
return glob $f;
}
--
Jeff "japhy" Pinyan RPI Acacia Brother #734 2002 Acacia Senior Dean
"And I vos head of Gestapo for ten | Michael Palin (as Heinrich Bimmler)
years. Ah! Five years! Nein! No! | in: The North Minehead Bye-Election
Oh. Was NOT head of Gestapo AT ALL!" | (Monty Python's Flying Circus)
------------------------------
Date: Fri, 04 Oct 2002 18:30:28 +1000
From: Rodney McDuff <mcduff@its.uq.edu.au>
Subject: How to change unix file access timestamp in perl?
Message-Id: <3D9D51A4.2040108@its.uq.edu.au>
--
Dr. Rodney McDuff |Ex ignorantia ad sapientiam
Manager, | Ex luce ad tenebras
Software Infrastructure, ITS |
EMAIL: mcduff@its.uq.edu.au |
TELEPHONE: +61 7 3365 8220 |
------------------------------
Date: Fri, 04 Oct 2002 10:10:09 -0000
From: Andreas =?iso-8859-1?Q?K=E4h=E4ri?= <ak@freeshell.org.REMOVE>
Subject: Re: How to change unix file access timestamp in perl?
Message-Id: <slrnapqq7i.aup.ak@otaku.freeshell.org>
Submitted by "Rodney McDuff" to comp.lang.perl.misc:
>
Question was: How to change unix file access timestamp in perl?
Answer it: Open it.
--
Andreas Kähäri @ New Zealand +------ Have a Unix: netbsd.org
-----------------------------+------ This post ends with :wq
------------------------------
Date: Fri, 4 Oct 2002 18:46:57 +1000
From: "Ron Savage" <ron@savage.net.au>
Subject: Re: How to geta list of perl modules
Message-Id: <anjkht$1p8p$1@arachne.labyrinth.net.au>
"Barry Kimelman" <barryk2@delete_me.mts.net> wrote in message news:MPG.1804fb78d306445598972d@east.usenetserver.com...
> How do you get a list of modules that are installed on your system
> (UNIX or windows) ? I know you can use perldoc to get info on a
> specific module, but I need to get a list of ALL the installed modules.
Or go to http://search.cpan.org/search
and search for a script called inside.
--
Cheers
Ron Savage
ron@savage.net.au
http://savage.net.au/index.html
------------------------------
Date: Fri, 04 Oct 2002 10:10:10 GMT
From: "James Q.L" <flying_dragon@china.com>
Subject: how to read the image content.
Message-Id: <6Odn9.177755$8b1.6612@news01.bloor.is.net.cable.rogers.com>
Sometimes i need to automate form submission. but few forms have
confirmation code that is composed into image(gif / png etc) . althought it
doesn't hurt much and i can manually submit or just give it up, I am
wondering if there is a way to do this ( i.e analyse the image and grab the
number out of it ) imagemagick ?
TIA
James
------------------------------
Date: Thu, 03 Oct 2002 22:36:35 GMT
From: Martien Verbruggen <mgjv@tradingpost.com.au>
Subject: Re: ignore case in Greek
Message-Id: <slrnapphm0.1qr.mgjv@verbruggen.comdyn.com.au>
On Wed, 02 Oct 2002 11:50:24 -0400,
Andre <alecler@sympatico.ca> wrote:
> In article <anedhf$af6$1@nic.grnet.gr>, "aragorn"
><aragorn@freemail.gr.gr> wrote:
>
>> I am trying to create a search form and i have problems with the "i"
>> switch in the regular expression statement. The problem is that it
>> doesn't work with Greek, propably will not work with any other
>> language.
> You need to "use locale". For your convenience, the code would look like
> this:
>
> use POSIX 'locale_h';
>
> # set up the Greek CTYPE for when "use locale" is invoked
> setlocale LC_CTYPE, 'gr'; # NOTE: you need to find the right name for the
Note that you should only need to do this if your current locale is
not already correct. Even if your current locale is correct, you still
need to C<use locale>.
See the perllocale documentation for more information.
Martien
--
|
Martien Verbruggen | I took an IQ test and the results were
Trading Post Australia | negative.
|
------------------------------
Date: 4 Oct 2002 03:05:25 -0700
From: david@tvis.co.uk (david rayner)
Subject: Installing Perl Modules: What actually happens?
Message-Id: <f677762.0210040205.7ccec0e6@posting.google.com>
Obviously it's easiest when PPM does a install for you.
Occasionally however you are asked to do the following
>perl makefile.pl
>make
>make test
>make install
On a Windows Machine (XP-P)
What version of Make do you need (I've got Borlands)
What Version of C (also Borland bcc55)
But my real question is what is actually happenning, what is being
compiled/installed etc?
zzapper
------------------------------
Date: Fri, 4 Oct 2002 10:09:12 +0000 (UTC)
From: Bernard El-Hagin <bernard.el-hagin@DODGE_THISlido-tech.net>
Subject: Re: Installing Perl Modules: What actually happens?
Message-Id: <slrnapqq38.142.bernard.el-hagin@gdndev25.lido-tech>
In article <f677762.0210040205.7ccec0e6@posting.google.com>, david rayner wrote:
> Obviously it's easiest when PPM does a install for you.
> Occasionally however you are asked to do the following
>
>>perl makefile.pl
>>make
>>make test
>>make install
>
> On a Windows Machine (XP-P)
> What version of Make do you need (I've got Borlands)
> What Version of C (also Borland bcc55)
>
> But my real question is what is actually happenning, what is being
> compiled/installed etc?
Look in the makefile. It's all in there.
Cheers,
Bernard
--
echo 42|perl -pe '$#="Just another Perl hacker,"'
------------------------------
Date: Fri, 4 Oct 2002 12:25:14 GMT
From: "John Moorhouse" <john.moorhouse@ukonline.co.uk>
Subject: ISP based List Server Programme
Message-Id: <H3GII2.Iot@bath.ac.uk>
I'm looking for a web based perl based list server that will allow me to:-
1. Have a majordomo type list email based list server.
2. Allow me to keep a web based archive of messages sent.
My ISP allows perl cgi scripts etc to run on their server but I doont seem
to be able to find a suitable package (preferably free) which to install.
Can any one make any suggestions
Ta
John
Acorn RiscPC + Windows Laptop.
------------------------------
Date: 4 Oct 2002 05:55:45 -0700
From: rokdun@yahoo.fr (Martin Kerharo)
Subject: Re: miniperl dumps core with Perl 5.8.0 on Solaris 7 64 bits
Message-Id: <96aa24eb.0210040455.3a2c89fe@posting.google.com>
rokdun@yahoo.fr (Martin Kerharo) wrote in message news:<96aa24eb.0209192332.602842ef@posting.google.com>...
> Rafael Garcia-Suarez <rgarciasuarez@free.fr> wrote in message news:<slrnaokan6.qe.rgarciasuarez@rafael.example.com>...
> > Martin Kerharo wrote in comp.lang.perl.misc :
> > >
> > > I try to compile Perl, in 64 bits mode (use64bitall), on a Sun 64 bits
> > > machine running Solaris 7. The compilation first generates "miniperl",
> > > then it tries to use miniperl in the Makefile to do some stuff, but
> > > miniperl dumps core.
> >
> > I think that perl has problems on solaris 7 with -Duse64bitall (as a
> > quick search through the smokers reports has shown.)
>
I retried with a recent version of the Sun C compiler (I downloaded an
evaluation version :-)
The symptoms are *exactly* the same as with the older compiler.
I tried with perl 5.6.1, and it's the *same error* too. Hehe. Perl
definitively cannot be compiled with the Sun compiler in 64 bits mode.
>
> > Did you try to compile with gcc ?
Eventually I was able to try with gcc, and it works much better.
There's a big problem though: the dynamic loading doesn't work! There
are strange issues with relocatable object files, and I ended with a
".so" file which looked good, but at run time the dynamic linker gets
confused and try to "mmap" the file descriptor 0 --- in other words,
the standard input. LOL.
So Perl itself is working, but no extension work.
------------------------------
Date: 4 Oct 2002 07:57:25 GMT
From: "Tassilo v. Parseval" <Tassilo.Parseval@post.rwth-aachen.de>
Subject: Re: nice comments in linux src
Message-Id: <anjhl5$2aq$1@nets3.rz.RWTH-Aachen.DE>
Also sprach Vishal Agarwal:
> Run the following script from /usr/src/linux to see some of the better
> comments in the linux source tree ;)
>
> Any comments/suggestions are welcome! btw, you are free to modify &
> distribute as you like (if you think you've improved it, pls send me a
> copy)
Since this is meant to be a funny piece of code, I am just commenting
about one thing that will make it run much quicker. Yet, one thing
almost got me: the use of symbolic references. It took me a whole to
find out how you actually used the arrays with the patterns that you
defined at the beginning. It's probably better to populate a hash with
array-refs.
> Cheers,
> Vishal Agarwal
>
> P.S. pls ignore if this posting appears twice in perl.misc (my news
> reader isn't working properly it seems)
>======================
>
> #!/usr/bin/perl
> # Author: avishal@vsnl.net
> # Date: 3 Oct 2002 (gandhi's 1 day older, maybe wiser)
> # Version: 0.2 (changed the approach)
> # Usage: program_name (and enter) /* assuming you're in
> /usr/src/linux/ (n linux .c and .h r thr) */
> # Synopsis: print all (nice) comments in .c/.h files underneath
>
>
> # categories
> @hard = ('damn','\b[fsdl]uck','sh[ia]t','[^sS]hello?','piss','fart','\bwtf\b','\barse\b','\bass\b','bitch','moron','stupid','\bsex');
> @mild = ('\b[ht]umou?r(ous|\b)','\bhillarious','\bbeaut','heaven','cow','\bm[ou]m\b','mother\b','bible','love','gods?','myst','fish','thank','please','crazy','mad','fun(ny|\b)','(in)?sane','shame','sick','\bugly','\bdumb','silly','\bhate','die\b','lunatic','horrible','(d|\b)evil','dedicate');
> @really_mild = ('window(s|\$)','micro(s|\$)oft','mess\b','\bh[ae]ck(er|\b)','\bhol(e|y|\b)','dead','prett(y|ie|\b)','weird','blind','hopeless','\bbomb\b');
> @grunts = ('\b(ha){2,}','\b(he){2,}','\bwuff','\b[yh]i[^tg]','\bugh','\bo{2,}ps','\bphew+','\bgrr','\bduh','\bargh','\bwhoo','\bwou','\!\!','\?\?');
You match each comment-line against the above patterns. That means, for
each of these comments, the pattern has to be recompiled. Due to this,
your script is painfully slow, so I suggest the following change:
@hard = map { qr/$_/ }
qw# damn \b[fsdl]uck sh[ia]t [^sS]hello? piss fart
\bwtf\b\barse\b \bass\b bitch moron stupid bsex #;
@mild = map { qr/$_/ }
qw# \b[ht]umou?r(ous|\b) \bhillarious \bbeaut heaven cow
\bm[ou]m\b mother\b bible love gods? myst fish thank
please crazy mad fun(ny|\b) (in)?sane shame sick
\bugly \bdumb silly \bhate die\b lunatic horrible
(d|\b)evil dedicate #;
@really_mild = map { qr/$_/ }
qw# window(s|\$) micro(s|\$)oft mess\b \bh[ae]ck(er|\b)
\bhol(e|y|\b) dead prett(y|ie|\b) weird blind hopeless
\bbomb\b #;
@grunts = map { qr/$_/ }
qw# \b(ha){2,} \b(he){2,} \bwuff \b[yh]i[^tg] \bugh \bo{2,}ps
\bphew+ \bgrr \bduh \bargh \bwhoo \bwou \!\! \?\? #;
This pre-compiles each patterns in the above lists using Perl's qr//
operator. Thus, later the match is done against a compiled pattern. I
did ot benchmark it, but I'd guess it ran at least 5 times faster on my
machine.
> $req = 6; # $points required to pass
>
> &process_dir(".");
> sub process_dir { # cut/pasted+modified from Randal L.
> Schwartz's site
> my $dir = shift;
> opendir DIR, $dir or return;
> my @contents = map "$dir/$_", sort grep !/^\.\.?$/, readdir DIR; #
> read dir contents, except '.' & '..'
> closedir DIR;
>
> foreach (@contents) {
> &print_comments($_) if /\.(c|h)$/;
> &process_dir($_); # go deeper
> }
> }
Also, I'd get rid of all the ampersands you used in the function calls:
foreach (@contents) {
next if -l $_; # I added this to skip symbolic links
print_comments($_) if /\.(c|h)$/;
process_dir($_);
}
[...]
Still, it's a fun piece of script. I wonder whether this also works on
the Perl source tree. Heh, it does. :-)
./pp.c
------
/* Do I look like I trust gcc with long longs here?
Do I hell. */
[...]
Tassilo
--
$_=q!",}])(tsuJ[{@"tnirp}3..0}_$;//::niam/s~=)]3[))_$-3(rellac(=_$({
pam{rekcahbus;})(rekcah{lrePbus;})(lreP{rehtonabus;})(rehtona{tsuJbus!;
$_=reverse;s/sub/(reverse"bus").chr(32)/xge;tr~\n~~d;eval;
------------------------------
Date: Fri, 04 Oct 2002 08:08:56 -0400
From: add <add@nrcan.gc.ca>
Subject: Perl to get DOCUMENT_ROOT on IIS
Message-Id: <3D9D84D8.5E2D7CAD@nrcan.gc.ca>
Hi,
I'm trying to find a way for a Win32 Perl script to get the document
root of a
website (multiple websites hosted on one server) through its IP address
(shown in LOCAL_ADDR) and metabase.
The idea is one script for all websites to display custom error
messages. But I absolutely need to know the document root of the website
where the error occured.
Or maybe there is a better way? I didn't see a DOCUMENT_ROOT environment
variable...
Thanks!
Christian
------------------------------
Date: Fri, 04 Oct 2002 12:35:38 GMT
From: tk <tk@WINDOZEdigiserv.net>
Subject: Re: Perl to get DOCUMENT_ROOT on IIS
Message-Id: <rf2rpucjdpdnvfj9fd19oo5s9l2ieem1fs@4ax.com>
In a fit of excitement on Fri, 04 Oct 2002 08:08:56 -0400, add
<add@nrcan.gc.ca> managed to scribble:
| Hi,
|
| I'm trying to find a way for a Win32 Perl script to get the document
| root of a
| website (multiple websites hosted on one server) through its IP address
| (shown in LOCAL_ADDR) and metabase.
|
| The idea is one script for all websites to display custom error
| messages. But I absolutely need to know the document root of the website
|
| where the error occured.
|
| Or maybe there is a better way? I didn't see a DOCUMENT_ROOT environment
|
| variable...
|
| Thanks!
|
| Christian
my $doc_root = $ENV{'DOCUMENT_ROOT'};
would provide the local path root (ie: c:\apache\htdocs\site1).
my $server_name = $ENV{'SERVER_NAME'};
would return the host (ie: subdomain.domain.com).
my $req_uri = $ENV{'REQUEST_URI'};
would provide the parts after the host (/cgi-bin/file.cgi ofr example)
print 'http://' . $server_name . $req_uri;
would output:
http://subdomain.domain.com/cgi-bin/file.cgi
Hope this helps =)
Regards,
tk
--
+--------------------------+
| digiServ Network |
| Web solutions |
| http://www.digiserv.net/ |
+--------------------------+
Remove WINDOZE to reply
------------------------------
Date: Fri, 04 Oct 2002 08:45:28 -0400
From: add <add@nrcan.gc.ca>
Subject: Re: Perl to get DOCUMENT_ROOT on IIS
Message-Id: <3D9D8D68.C5D4EA@nrcan.gc.ca>
Thanks tk,
but I think you're talking about Apache here (and that I knew how to get it).
IIS doesn't seem to carry DOCUMENT_ROOT (hey, don't forget it's
Microstuff!)...
tk wrote:
> In a fit of excitement on Fri, 04 Oct 2002 08:08:56 -0400, add
> <add@nrcan.gc.ca> managed to scribble:
>
> | Hi,
> |
> | I'm trying to find a way for a Win32 Perl script to get the document
> | root of a
> | website (multiple websites hosted on one server) through its IP address
> | (shown in LOCAL_ADDR) and metabase.
> |
> | The idea is one script for all websites to display custom error
> | messages. But I absolutely need to know the document root of the website
> |
> | where the error occured.
> |
> | Or maybe there is a better way? I didn't see a DOCUMENT_ROOT environment
> |
> | variable...
> |
> | Thanks!
> |
> | Christian
>
> my $doc_root = $ENV{'DOCUMENT_ROOT'};
>
> would provide the local path root (ie: c:\apache\htdocs\site1).
>
> my $server_name = $ENV{'SERVER_NAME'};
>
> would return the host (ie: subdomain.domain.com).
>
> my $req_uri = $ENV{'REQUEST_URI'};
>
> would provide the parts after the host (/cgi-bin/file.cgi ofr example)
>
> print 'http://' . $server_name . $req_uri;
>
> would output:
>
> http://subdomain.domain.com/cgi-bin/file.cgi
>
> Hope this helps =)
>
> Regards,
>
> tk
> --
> +--------------------------+
> | digiServ Network |
> | Web solutions |
> | http://www.digiserv.net/ |
> +--------------------------+
>
> Remove WINDOZE to reply
------------------------------
Date: 4 Oct 2002 09:08:39 GMT
From: Tina Mueller <usenet@tinita.de>
Subject: Re: Script to Change Filename
Message-Id: <anjlqn$eqiqg$1@fu-berlin.de>
JP <NO_SPAM_pangjoe@rogers.com> wrote:
> 1. Select only those filenames with .dat extension
> 2. The sournce filename must be all numeric but ends with a character
> digital, e.g. 12345a.dat, 234567b.dat
opendir DIR, "path";
my @files = grep {m/^\d+[a-z]\.dat$/i} readdir DIR;
> 3. If it meets the above two criteria, rename the file by inserting a dash
> in between the numerals and character, e.g. 12345a.dat --> 12345-a.dat,
> 234567b.dat -->234567-b.dat
for (@files) {
m/^(\d+)([a-z])\.dat$/i and rename $_, "$1-$2.dat";
}
hth, tina
--
http://www.tinita.de/ \ enter__| |__the___ _ _ ___
http://Movies.tinita.de/ \ / _` / _ \/ _ \ '_(_-< of
http://PerlQuotes.tinita.de/ \ \ _,_\ __/\ __/_| /__/ perception
------------------------------
Date: Fri, 04 Oct 2002 12:04:19 GMT
From: "JP" <NO_SPAM_pangjoe@rogers.com>
Subject: Re: Script to Change Filename
Message-Id: <7tfn9.177797$8b1.144811@news01.bloor.is.net.cable.rogers.com>
Bill,
Thanks for your efforts. Unfortunately, I have over 1,000 files which make
it impossible to be defined in an array. I have to pick from a directory
which has other files not to be renamed as well. But I have to choose those
with names in the format "nnnnnx.dat", where
nnnnn is numeric but can 3 to 8 digits
x is an alphabet
.dat is the file extension
Once a file meets the criteria, it should be renamed by inserting a "-"
between the numeric part and the alphabet, i.e. nnnnnx.dat will become
nnnnn-x.dat.
Cheers,
Joe
>
> #!perl -w
> # filedasher_v2.pl- adds dashes into filenames, e.g., 12345a.dat becomes
> 12345-a.dat
> use strict;
> my @filenames = ("12345a.dat", "12345b.dat", "0123456789c.dat",
"a123b.bat",
> "index1.html", "0123d.dat.html");
> foreach (@filenames){
> s/((?:\d)+)([a-zA-Z]\.dat)/${1}-${2}/; #regex from David Britten
> print $_, "\n";
> }
>
> Cheers.
>
> Bill Segraves
>
>
>
------------------------------
Date: Fri, 04 Oct 2002 12:07:48 GMT
From: "JP" <NO_SPAM_pangjoe@rogers.com>
Subject: Re: Script to Change Filename
Message-Id: <owfn9.177800$8b1.69476@news01.bloor.is.net.cable.rogers.com>
Walter,
Sorry for being unclear. Let me rephrase my question:
In a directory with thousands of different files, I have to choose those
with names in the format "nnnnnx.dat", where
nnnnn is numeric (0-9) and can 3 to 8 digits
x is an alphabet (A-Z, a-z)
.dat is the file extension (to be used with DOS/Windows
applications)
Once a file meets the criteria, it should be renamed by inserting a "-"
between the numeric part and the alphabet, i.e. nnnnnx.dat will become
nnnnn-x.dat.
Thanks for your help.
Cheers,
Joe
> I'm not sure what you mean by a 'character digital', unless you perhaps
> mean the standard hex characters a-f ?
>
> Provided that you are already in the right directory...
>
> ($newfilename = $oldfilename) =~ s/(^\d+)([a-f])\.bat/$1-$2.bat/;
> rename $oldfilename, $newfilename if $newfilename ne $oldfilename;
> --
> And the wind keeps blowing the angel / Backwards into the future /
> And this wind, this wind / Is called / Progress.
> -- Laurie Anderson
------------------------------
Date: Fri, 4 Oct 2002 09:59:42 +0100
From: "Richard S Beckett" <spikey-wan@bigfoot.com>
Subject: Win32::Console
Message-Id: <anjlb5$g49$1@newshost.mot.com>
Guys,
I have read the documentation, but I still can't work this module out.
I have:
use Win32::Console;
our $CONSOLE = new Win32::Console STD_INPUT_HANDLE;
at the start of my script, and have successfully used things like:
print "\n\nPress any key to exit.\n";
$CONSOLE->Mode(ENABLE_PROCESSED_INPUT);
my $char = $CONSOLE->InputChar(1);
exit (0);
BUT, when the user clicks on the script, and the dos window opens, I want to
resize it from the default 25 rows, to 50 rows, then change the background
colour from black to blue.
I _really_ can't work out how to do this. I've tried various things from
reading the documentation, but nothing does anything other than generate
errors.
Would someone mind giving me a few pointers, please?
Thanks.
R.
------------------------------
Date: Fri, 04 Oct 2002 13:06:04 +0200
From: Cyril Scetbon <externe.scetbon@francetelecom.com>
Subject: Re: Win32::Console
Message-Id: <3D9D761C.F359A97F@francetelecom.com>
Try this:
use Win32::Console;
$console=3Dnew Win32::Console;
$console->Size(80,50);
$console->Display();
$console->Attr($BG_BLUE|$FG_WHITE);
$console->Write("JUST A TEST\n\nPress <return>");
<>;
$console->Free;
it works for me.
when you call Size function a scroll appears on the right cause height
is updated.
Richard S Beckett a =E9crit :
> =
> Guys,
> =
> I have read the documentation, but I still can't work this module out.
> =
> I have:
> use Win32::Console;
> our $CONSOLE =3D new Win32::Console STD_INPUT_HANDLE;
> =
> at the start of my script, and have successfully used things like:
> =
> print "\n\nPress any key to exit.\n";
> $CONSOLE->Mode(ENABLE_PROCESSED_INPUT);
> my $char =3D $CONSOLE->InputChar(1);
> exit (0);
> =
> BUT, when the user clicks on the script, and the dos window opens, I wa=
nt to
> resize it from the default 25 rows, to 50 rows, then change the backgro=
und
> colour from black to blue.
> I _really_ can't work out how to do this. I've tried various things fro=
m
> reading the documentation, but nothing does anything other than generat=
e
> errors.
> =
> Would someone mind giving me a few pointers, please?
> =
> Thanks.
> =
> R.
-- =
SCETBON Cyril
France T=E9l=E9com OCISI
BAT PRISME
20 avenue Georges Bracques
78000 GUYANCOURT
Email: externe.scetbon@francetelecom.com
Tel: 0155883918
------------------------------
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 3913
***************************************
