[24255] in Perl-Users-Digest
Perl-Users Digest, Issue: 6446 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Thu Apr 22 18:10:44 2004
Date: Thu, 22 Apr 2004 15:10:13 -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, 22 Apr 2004 Volume: 10 Number: 6446
Today's topics:
Re: Finding all open filehandles and closing them befor <vilmos@vilmos.org>
Re: Finding all open filehandles and closing them befor (Anno Siegel)
Re: free source guestbook (finished) <robin @ infusedlight.net>
Re: free source guestbook (finished) <robin @ infusedlight.net>
Re: free source guestbook (finished) <spamtrap@dot-app.org>
Re: free source guestbook (finished) <spamtrap@dot-app.org>
Re: free source guestbook (finished) <tassilo.parseval@rwth-aachen.de>
Help with TCP_NODELAY and socket.ph <kevin_ireland@adaptec.com>
Huffman coding and Parse::RecDescent <Jon.Ericson@jpl.nasa.gov>
Re: mod_perl, apache <perl@my-header.org>
Re: mod_perl, apache <noreply@gunnar.cc>
Re: Moving Directory using win32api::File <b.gaber@pwgsc.gc.ca>
Re: Operator overloading <kalinaubears@iinet.net.au>
Re: Operator overloading (Anno Siegel)
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 22 Apr 2004 08:34:00 -0700
From: Vilmos Soti <vilmos@vilmos.org>
Subject: Re: Finding all open filehandles and closing them before exiting
Message-Id: <87d6606n87.fsf@localhost.localdomain>
anno4000@lublin.zrz.tu-berlin.de (Anno Siegel) writes:
>> I have a signal handler which tries to unmount the disk in
>> the case of a sigint, but it will fail if copy from File::Copy
>> has an open filehandle on the mounted disk.
>
> I can see a few possible solutions. Searching stashes for filehandles
> is probably the last thing I'd try :)
Thanks for your help. I also feel this is not the most elegant/best
solution, but this is what I managed to come up with. :-)
> For one, the signal handler could just set a flag instead of unmounting.
> The main loop would check that flag after each copy and umount/exit
> if it is set. That way no filehandles from File::Copy are open when
> the unmount occurs.
Yes, this is one possibility. But it will need a hefty rewrite
on my part. Here is a code snipplet (written from head, not the
actual code) how I handle the exiting from the program.
#################### Code snipplet starts ####################
sub bye ($) {
print "$_[0]\n";
if ($bye{dbconnect}) {
$bye{dbconnect} = 0;
$dbh->disconnect ();
}
if ($bye{mount}) {
$bye{mount} = 0;
system ("umount ...");
}
...
exit
}
$SIG{INT} = \&bye;
$dbh = DBI->connect ... or bye ("DBI connect failed: $!");
$bye{dbconnect} = 1;
...
system ("mount ...") or bye ("mounting failed: $!");
$bye{mount} = 1;
#################### Code snipplet ends ####################
So in this case, the %bye hash keeps track what needs to be
cleaned up at exit, and in the course of the program if
anything goes wrong, &bye will do the right thing.
I can rewrite the whole exiting procedure, but I just hope that
I can stuck the solution into &bye. :-)
> Another possibility (under Unix) is to run "exec umount" instead
> of "system umount". Since normal files are closed on exec, that
> should do it too.
Hmmm, I didn't think of that. Thanks for the idea. However, this
is not the best solution. This program basically reads a removable
disk, and is going to be used by people who are not really
computer experts, and I wouldn't even call them knowledgable users.
So I want to handle everything in my program. If at the end I
exec umount, then it will be already outside the program, and if
it fails, I cannot handle it. And they will be confused if the
cd/mod doesn't eject. However, this might be the least bad solution.
> Finally, you could bite the bullet and use filehandles with File::Copy
> and keep track of them. I don't think there are any disadvantages
> under Unix.
My main problem with this route is that it will complicate
my code. Not that this few lines would cause me a headache,
but I would prefer to keep my code as simple as possible
and easy to maintain by others. Starting to reimplement
parts of the core module is not the route I really want to
do. This is what I did before, or at least before I started
to read this newsgroup... I learned. :-)
I think I will stick with the exec umount solution. I can live
with the unlikely event that the program is interrupted by
hand and it doesn't exit truly gracefully at the price of
keeping my code small and simple. Thanks for the idea.
Vilmos
------------------------------
Date: 22 Apr 2004 21:06:49 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: Finding all open filehandles and closing them before exiting
Message-Id: <c69c59$o8d$1@mamenchi.zrz.TU-Berlin.DE>
Vilmos Soti <vilmos@vilmos.org> wrote in comp.lang.perl.misc:
> anno4000@lublin.zrz.tu-berlin.de (Anno Siegel) writes:
>
> >> I have a signal handler which tries to unmount the disk in
> >> the case of a sigint, but it will fail if copy from File::Copy
> >> has an open filehandle on the mounted disk.
> >
> > I can see a few possible solutions. Searching stashes for filehandles
> > is probably the last thing I'd try :)
>
> Thanks for your help. I also feel this is not the most elegant/best
> solution, but this is what I managed to come up with. :-)
>
> > For one, the signal handler could just set a flag instead of unmounting.
> > The main loop would check that flag after each copy and umount/exit
> > if it is set. That way no filehandles from File::Copy are open when
> > the unmount occurs.
>
> Yes, this is one possibility. But it will need a hefty rewrite
> on my part. Here is a code snipplet (written from head, not the
> actual code) how I handle the exiting from the program.
>
> #################### Code snipplet starts ####################
>
> sub bye ($) {
> print "$_[0]\n";
> if ($bye{dbconnect}) {
> $bye{dbconnect} = 0;
> $dbh->disconnect ();
> }
> if ($bye{mount}) {
> $bye{mount} = 0;
> system ("umount ...");
> }
> ...
> exit
> }
>
> $SIG{INT} = \&bye;
>
> $dbh = DBI->connect ... or bye ("DBI connect failed: $!");
> $bye{dbconnect} = 1;
> ...
> system ("mount ...") or bye ("mounting failed: $!");
> $bye{mount} = 1;
>
> #################### Code snipplet ends ####################
>
> So in this case, the %bye hash keeps track what needs to be
> cleaned up at exit, and in the course of the program if
> anything goes wrong, &bye will do the right thing.
>
> I can rewrite the whole exiting procedure, but I just hope that
> I can stuck the solution into &bye. :-)
Quite apart from the unmount problem, this looks like something that
should go into an END block.
> > Another possibility (under Unix) is to run "exec umount" instead
> > of "system umount". Since normal files are closed on exec, that
> > should do it too.
>
> Hmmm, I didn't think of that. Thanks for the idea. However, this
> is not the best solution. This program basically reads a removable
> disk, and is going to be used by people who are not really
> computer experts, and I wouldn't even call them knowledgable users.
> So I want to handle everything in my program. If at the end I
[snip some discussion]
> I think I will stick with the exec umount solution. I can live
> with the unlikely event that the program is interrupted by
> hand and it doesn't exit truly gracefully at the price of
> keeping my code small and simple. Thanks for the idea.
You don't have to exec a bare umount, you can exec another Perl
process (which may be the same script, called with some special
parameter), to do the umount and all the handling involved. You
still have your original stdout and stdin to interact with the user,
but all normal files are closed. None of this is tested, obviously...
Anno
------------------------------
Date: Thu, 22 Apr 2004 11:33:23 -0700
From: "Robin" <robin @ infusedlight.net>
Subject: Re: free source guestbook (finished)
Message-Id: <c694co$d6i$1@reader2.nmix.net>
"Tassilo v. Parseval" <tassilo.parseval@rwth-aachen.de> wrote in message
news:c67qpm$8f0fh$1@ID-231055.news.uni-berlin.de...
> Also sprach Robin:
>
> Only some essential comments and leaving other issues (like the
> idiosyncractic indenting aside):
>
> > if (! -e $bookfile)
> > {
> > if (open (BOOKFILE, ">$bookfile"))
> > {
> > flock (BOOKFILE, LOCK_EX);
> > print BOOKFILE '';
> > flock (BOOKFILE, LOCK_UN);
> > close (BOOKFILE);
> > }
>
> Code like this is almost always wrong. It contains a subtle
> race-condition. In theory it's possible that the file does not exist by
> the time of the -e check but is created by some other visitor of your
> gustbook in between the -e and the open(). Sounds contrived, but it's
> possible.
>
> The code above apparently only creates the file if it does not yet
> exist. You can drop this checking and creating altogether. You are later
> using '>>' for opening. This will create the file for you if it isn't
> already there and append otherwise.
>
> > sub dosign
> > {
> > if (checkforcookie() eq "true")
>
> You made a rather bad choice for checkforcookie()'s return value. "true"
> or (in case you use that as well; haven't yet checked) are misleading as
> they are both true to perl. Have a function return 1 when you mean true
> and 0 (or undef) when you mean false. And then do the check like that:
>
> if (checkforcookie()) {
>
> > {
> > print header;
> > print (@head);
> > print ("<center>You have already signed the guestbook once today.
> > Please sign it again tommorow.<hr></center>");
> > print (@foot);
> > exit;
> > }
> > my $name = param ('name');
> > my $email = param ('email');
> > my $website = param ('webname') . $string2 . param ('url');
> > my $message = param ('message');
> > if (param ('url') !~ /<.*>/ and param ('webname') !~ /<.*>/ and
param
> > ('url') !~ /^\s*$/s and param ('webname') !~ /$string2|$string/ and
param
> > ('url') !~ /$string2|$string/)
>
> I hate long lines such as these especially when they are formatted
> badly. Line the various conditions up properly:
>
> if (param('url') !~ /<.*>/ and
> param('webname') !~ /<.*>/ and
> ...) {
>
> Also, the /s in '/^\s*$/s' does nothing, so drop that.
>
> > if ($name !~ /^\s*$/g and $email !~ /^\s*$/g and $message !~ /^\s*$/g
and
> > $email !~ /<.*>/s and param ('webname') !~ /<.*>/g and param ('url') !~
> > /<.*>/g and $name !~ /<.*>/s and $name !~ /$string/g and $message !~
> > /$string/g and $website !~ /$string/g and $email !~ /$string/g and $name
!~
> > /$string2/g and $message !~ /$string2/g and $email !~ /$string2/g and
param
> > ('webname') !~ /$string2/g and param ('url') !~ /$string2/g)
>
> Uggh. Maybe it's time to create a function that does the above check for
> you. And again, watch your regex modifiers. What is /g supposed to do in
> the above matches?
>
> > {
> > open (BOOKFILE, ">>$bookfile") or print header and print "An error
occured
> > during this operation: <b>$!</b>. Please press the back button on your
> > browser and try again.<hr>" and exit;
> > flock (BOOKFILE, LOCK_EX);
>
> Note how this will create $bookfile if it doesn't exist. This is the
> behaviour you want and why cou should drop the preliminary check for its
> existance further above.
>
> > flock (BOOKFILE, LOCK_UN);
> > close (BOOKFILE);
>
> An explicit unlock is not necessary as closing the file will unlock it
> for you. On older perls this can even be a problem as unlocking did not
> flush the file. On recent perls however, it is ok. Just drop the LOCK_UN
> stuff.
>
> > sub view
> > {
> > my ($header) = @_;
> > open (BOOKFILE, $bookfile) or print header and print
> > "<center><strong>Viewing Guestbook - Version $version - No
> > guests</strong><hr><a href=\"$homepage\">To homepage</a></center>" and
exit;
> > flock (BOOKFILE, LOCK_SH);
> > my @contentsofbook=<BOOKFILE>;
>
> This can become a problem one day when the gustbook is large. Also
> remember that CGI scripts run concurrently. If you have ten users all
> requesting to see the guestbook, you have to read keep it in memory ten
> times.
>
> > flock (BOOKFILE, LOCK_UN);
> > close (BOOKFILE);
> > my $contentsofbook=join('', @contentsofbook);
> > @contentsofbook = split (/$string/, $contentsofbook);
> > @contentsofbook = reverse (@contentsofbook);
>
> This looks inefficient. You join it and split it again immediately
> afterwards. As I recall, $string is the separator you use between
> entries or so. That means you can have perl do that work for you
> implicitely:
>
> my @contentsofbook = do {
> local $/ = $string;
> <BOOKFILE>;
> };
>
> After that you have one entry in each array element.
>
> > print @contentslen;
> > }
> > else
> > {
> > @contentslen = @contentsofbook[0 .. 10];
> > print @contentslen;
> > }
>
> Bad variable names here. @contentslen does not contains lengths of
> something. It apparently contains guastbook entries. Your variable names
> should reflect that.
>
> > sub gethead
> > {
> > my ($header) = @_;
> > my @header;
> >
> > if (-e "$header")
>
> Those quotes are not needed. Anything that is not needed should be
> dropped. That's one principle of programming.
>
> > {
> > open (HEADER, "$header") or print header and print "An error occured
> > during this operation: <b>$!</b>. Please press the back button on your
> > browser and try again.<hr>" and exit;
> > flock (HEADER, LOCK_SH);
> > @header = <HEADER>;
> > flock (HEADER, LOCK_UN);
> > close (HEADER);
> > }
> > else
> > {
> > open (HEADER, ">$header") or print header and print "An error occured
> > during this operation: <b>$!</b>. Please press the back button on your
> > browser and try again.<hr>" and exit;
> > flock (HEADER, LOCK_EX);
> > print HEADER <<END;
> > <html>
> > <head>
> > <title>GBOOK2 Version $version</title>
> > </head>
> > <body>
> > END
>
> You do things at runtime that should be done on installation time. Add
> to your README that a header file has to exist. It will simplify your
> script if it can be sure that certain files are there.
>
> > sub getfoot
> > {
> > my ($footer) = @_;
> > my @footer;
> > if (-e "$footer")
> > {
> > open (FOOTER, "$footer") or print header and print "An error occured
> > during this operation: <b>$!</b>. Please press the back button on your
> > browser and try again.<hr>" and exit;
> > flock (FOOTER, LOCK_SH);
> > @footer = <FOOTER>;
> > flock (FOOTER, LOCK_UN);
> > close (FOOTER);
> > }
> > else
> > {
> > open (FOOTER, ">$footer") or print header and print "An error occured
> > during this operation: <b>$!</b>. Please press the back button on your
> > browser and try again.<hr>" and exit;
> > flock (FOOTER, LOCK_EX);
> > print FOOTER <<END;
> > </body></html>
> > END
> > close (FOOTER);
> > open (FOOTER, "$footer") or print header and print "An error occured
> > during this operation: <b>$!</b>. Please press the back button on your
> > browser and try again.<hr>" and exit;
> > flock (FOOTER, LOCK_SH);
> > @footer = <FOOTER>;
> > flock (FOOTER, LOCK_UN);
> > close (FOOTER);
> > }
> > chmod (0770, $footer);
> > return @footer;
> > }
>
> Same for the footer. What you can do is provide an installation script
> in your distribution that will first check the integrity and existance
> of all files and, in case they aren't there, create them.
>
> > sub getdate {
> > my ($day, $mon, $year)=(localtime)[3,4,5];
> > $mon++; #month is returned in a 0-11 range
> > $year +=1900;
> > my $date = $mon . "/" . $day . "/" . $year;
> > return $date;
> > }
>
> Ah, good, you eventually got rid of the call to 'date'.
>
> > yeah I know the indents suck, but I'm too lazy to clean them up. it's
just
> > my program screws them up.
>
> Use a better editor. It's no excuse to use bad tools. If you use a sane
> editor like vim or emacs, correcting the indentation is just one
> key-stroke away. Also, there is
>
> http://perltidy.sf.net/
>
> It can't hurt to let it run over your script.
>
> Tassilo
> --
>
$_=q#",}])!JAPH!qq(tsuJ[{@"tnirp}3..0}_$;//::niam/s~=)]3[))_$-3(rellac(=_$({
>
pam{rekcahbus})(rekcah{lrePbus})(lreP{rehtonabus})!JAPH!qq(rehtona{tsuJbus#;
>
$_=reverse,s+(?<=sub).+q#q!'"qq.\t$&."'!#+sexisexiixesixeseg;y~\n~~dddd;eval
thanks tassilo, thanks bigtime, I shall probably get back to work on it
soon. This is great advice. BTW, the /g modifier means global replace.
-Robin
------------------------------
Date: Thu, 22 Apr 2004 12:14:26 -0700
From: "Robin" <robin @ infusedlight.net>
Subject: Re: free source guestbook (finished)
Message-Id: <c696pj$drv$1@reader2.nmix.net>
> You do things at runtime that should be done on installation time. Add
> to your README that a header file has to exist. It will simplify your
> script if it can be sure that certain files are there.
> Same for the footer. What you can do is provide an installation script
> in your distribution that will first check the integrity and existance
> of all files and, in case they aren't there, create them.
your right, the header and footer are packaged with the zip file for the
guestbook though, and I implicitly implied that you can edit them, so I
guess I should change it to something else. The files don't really have to
exist though. Although I might add code like
if (! gethead ($headerfile))
{
@head = ('<html>', '<body>, 'etc');
}
else
{
@head = gethead ($headerfile);
}
Do you think that's a good idea?
Thanks,
-Robin
------------------------------
Date: Thu, 22 Apr 2004 15:15:40 -0400
From: Sherm Pendley <spamtrap@dot-app.org>
Subject: Re: free source guestbook (finished)
Message-Id: <Td2dnXWveIxGhBXdRVn-hw@adelphia.com>
Robin wrote:
> "Tassilo v. Parseval" <tassilo.parseval@rwth-aachen.de> wrote in message
> news:c67qpm$8f0fh$1@ID-231055.news.uni-berlin.de...
>> > if ($name !~ /^\s*$/g and $email !~ /^\s*$/g and $message !~ /^\s*$/g
> and
>> > $email !~ /<.*>/s and param ('webname') !~ /<.*>/g and param ('url') !~
>> > /<.*>/g and $name !~ /<.*>/s and $name !~ /$string/g and $message !~
>> > /$string/g and $website !~ /$string/g and $email !~ /$string/g and
>> > $name
> !~
>> > /$string2/g and $message !~ /$string2/g and $email !~ /$string2/g and
> param
>> > ('webname') !~ /$string2/g and param ('url') !~ /$string2/g)
>>
>> Uggh. Maybe it's time to create a function that does the above check for
>> you. And again, watch your regex modifiers. What is /g supposed to do in
>> the above matches?
> BTW, the /g modifier means global replace.
Please don't parrot the docs back at people who understand them a lot better
than you do. It's rude.
The /g modifier specifies global operation when used with s///. But the
above code isn't doing any substitution; it's just matching with //. So,
the /g in the above doesn't do anything.
Now, the question remains: What did you *think* it was going to do?
sherm--
--
Cocoa programming in Perl: http://camelbones.sourceforge.net
Hire me! My resume: http://www.dot-app.org
------------------------------
Date: Thu, 22 Apr 2004 15:30:05 -0400
From: Sherm Pendley <spamtrap@dot-app.org>
Subject: Re: free source guestbook (finished)
Message-Id: <W9adnejj6oKmgBXdRVn-uQ@adelphia.com>
Robin wrote:
> I should change it to something else. The files don't really have to
> exist though. Although I might add code like
...
> Do you think that's a good idea?
Writing your code so that it's able to cope with exceptional situations -
such as missing and/or unreadable templates - is *always* a good idea. No
one can ever predict all of the possible error conditions, of course; as
soon as we write idiot-proof code, along comes a better idiot. But it's
still worth making the attempt.
One idea you should forget about, though, is the one in the subject. Code is
very rarely, if ever, "finished." Virtually everything you write will need
to be maintained over time.
That's one reason for good formatting, descriptive variable names, comments,
and all that good stuff. It's not just for other people - it's for you too.
Trying to modify one's own five- or ten-year-old code can be an educational
experience.
sherm--
--
Cocoa programming in Perl: http://camelbones.sourceforge.net
Hire me! My resume: http://www.dot-app.org
------------------------------
Date: 22 Apr 2004 21:21:55 GMT
From: "Tassilo v. Parseval" <tassilo.parseval@rwth-aachen.de>
Subject: Re: free source guestbook (finished)
Message-Id: <c69d1j$906pa$1@ID-231055.news.uni-berlin.de>
Also sprach Robin:
>> You do things at runtime that should be done on installation time. Add
>> to your README that a header file has to exist. It will simplify your
>> script if it can be sure that certain files are there.
>
>> Same for the footer. What you can do is provide an installation script
>> in your distribution that will first check the integrity and existance
>> of all files and, in case they aren't there, create them.
>
> your right, the header and footer are packaged with the zip file for the
> guestbook though, and I implicitly implied that you can edit them, so I
> guess I should change it to something else. The files don't really have to
> exist though. Although I might add code like
[...]
You also mailed this as a CC to me. It would help if you could in future
mention this in your mail, otherwise I reply via mail just to realize a
bit later that I should have better responded in the group.
Tassilo
--
$_=q#",}])!JAPH!qq(tsuJ[{@"tnirp}3..0}_$;//::niam/s~=)]3[))_$-3(rellac(=_$({
pam{rekcahbus})(rekcah{lrePbus})(lreP{rehtonabus})!JAPH!qq(rehtona{tsuJbus#;
$_=reverse,s+(?<=sub).+q#q!'"qq.\t$&."'!#+sexisexiixesixeseg;y~\n~~dddd;eval
------------------------------
Date: Thu, 22 Apr 2004 17:33:58 +0100
From: "Kevin Ireland" <kevin_ireland@adaptec.com>
Subject: Help with TCP_NODELAY and socket.ph
Message-Id: <c68s5k$1ns$1$830fa79f@news.demon.co.uk>
Hi,
I am trying to set TCP_NODELAY for a perl socket object, but I am having
problems with socket.ph on my system, which I had made using h2ph.The error
I get is:
_h2ph_pre.ph did not return a true value at C:/Perl/site/lib/socket.ph line
1.
which I get when I run my script, with the line: require "socket.ph";
I am new to using ActiveState's windows perl implementation, so I am not
sure if I have configured this correctly. I have tried looking in the perl
FAQ, but no luck on how to get around this.
Thanks in Advance.
--
Regards,
Kevin Ireland
Test Engineer/Team Lead
Adaptec UK Ltd
4th Floor, Howard House
Queens Avenue,
BRISTOL BS8 1SD
(e) kevin_ireland@adaptec.com
(t) +44 (0) 117 920 9622 ( direct )
+44 (0) 117 930 9600 ( switchboard )
------------------------------
Date: Thu, 22 Apr 2004 13:50:06 -0700
From: Jon Ericson <Jon.Ericson@jpl.nasa.gov>
Subject: Huffman coding and Parse::RecDescent
Message-Id: <rcgbrljeo01.fsf@Jon-Ericson.sdsio.prv>
I've been playing with Parse::RecDescent lately and I've run into an
annoyance. I'd appreciate some advice about how to deal with it.
Take, for an example, this abbreviated grammar for reading a baseball
score-sheet:
events: play(s) /\z/
play: home_run | caught_stealing | hit_by_pitch | catchers_interference
| <error>
home_run: 'H' | 'HR'
caught_stealing: 'CS'
hit_by_pitch: 'HP'
catchers_interference: 'C'
Obviously, there are bugs in the grammar. For instance, it fails when
given 'HP' or 'HR', since the first production in the home_run rule
greedily gobbles up the initial 'H'. It isn't that hard to fix:
events: play(s) /\z/
play: caught_stealing | catchers_interference | hit_by_pitch | home_run
| <error>
caught_stealing: 'CS'
catchers_interference: 'C'
hit_by_pitch: 'HP'
home_run: 'HR' | 'H'
This works and it's easy to maintain, but it's massively inefficient.
Home runs are substantially more common than hit batsmen, but because
the code for hit by pitch is longer than one of the home run codes,
you have to try it first. That means a lot of expensive backtracking,
which is criminal in this sort of data. It's trivial to order
baseball plays by frequency.
Notice that Huffman coding hurts us here. The most common plays in
baseball have the shortest codes, in general. Cather's interference
and caught stealing are the exceptions that prove the rule.
Fortunately, we can do negative lookahead and preserve the original
ordering:
home_run: 'HR' |'H' ...!'P'
{$item[1]}
The action explicitly returns the first item, otherwise we get
whatever was returned by the negative lookahead when 'H' matches. I'm
not sure if this is a bug, since it doesn't seem to be documented.
Maybe I should use regexp lookahead instead?
But this is harder to maintain. The next time you add a play, you
have to go back and make sure it doesn't interfere with one of the
other productions. Or if you reorder the productions to squeeze a bit
more performance out of the grammar, you have to audit the rule.
How have other people dealt with this?
Thanks,
Jon
------------------------------
Date: Thu, 22 Apr 2004 19:33:17 +0200
From: Matija Papec <perl@my-header.org>
Subject: Re: mod_perl, apache
Message-Id: <0e0g80lffvo08iu97t4j1h2737dau07lbr@4ax.com>
X-Ftn-To: Gunnar Hjalmarsson
Gunnar Hjalmarsson <noreply@gunnar.cc> wrote:
>> serves php scripts. I know that Apache 2 has built in support, but
>> I would like to make quick fix for older version. Is that possible?
>>
>> Where should I look,
>
>Not in a Usenet group for the Perl programming language.
I guess, it's slightly related to perl modules.
--
Matija
------------------------------
Date: Thu, 22 Apr 2004 19:39:32 +0200
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: mod_perl, apache
Message-Id: <c690c7$9ha88$1@ID-184292.news.uni-berlin.de>
Matija Papec wrote:
> Gunnar Hjalmarsson wrote:
>> Matija Papec wrote:
>>> serves php scripts. I know that Apache 2 has built in support,
>>> but I would like to make quick fix for older version. Is that
>>> possible?
>>>
>>> Where should I look,
>>
>> Not in a Usenet group for the Perl programming language.
>
> I guess, it's slightly related to perl modules.
In the subject line you mention mod_perl, but then you talk about
serving PHP scripts, and that's done through mod_php, isn't it? To me
it sounds as if your problem is much better suited for an Apache group.
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: Thu, 22 Apr 2004 16:32:02 -0400
From: Brian <b.gaber@pwgsc.gc.ca>
Subject: Re: Moving Directory using win32api::File
Message-Id: <40882BC2.5D4449D2@pwgsc.gc.ca>
Nope that is not it. I am logged on as administrator. As well, nothing
succeeds, there is no copy, nothing exists in destination directory. I
just think MoveFile displays a different error than MoveFileEx does for the
same condition.
I would be grateful for any other ideas.
Sisyphus wrote:
> Brian wrote:
> > I am trying to move a directory that contains numerous other
> > subdirectories, e.g. c:\temp\source\temp1, temp2, to a new directory,
> > e.d. c:\test. Here is my script:
> >
> > use Win32API::File qw( :ALL );
> > use strict;
> >
> > my $source = "c:\\temp\\source";
> > my $destination = "c:\\test";
> > my $mvError = "";
> >
> > MoveFileEx( $source, $destination, MOVEFILE_REPLACE_EXISTING() )
> > or die "Can't move $source to $destination: ",fileLastError(),"\n";
> >
> > I get the following error:
> >
> > Can't move c:\temp\source to c:\test\: Access is denied
> >
> > Any ideas?
> >
> > When I try: MoveFile( $source, $destination )
> >
> > I get an error stating that the file already exists
> >
> >
>
> Just a guess:
> You need administrator rights to delete files from C:\temp (which would
> not be unusual if that is your $ENV{'TEMP'} directory) - which is why
> you get the "Access is denied" message. Creating a copy, however, poses
> no problem - so that part of MoveFileEx() succeeds.
> I assume that the "file already exists" message (that you subsequently
> get) is, in fact, correct ?
>
> Cheers,
> Rob
>
> --
> To reply by email u have to take out the u in kalinaubears.
------------------------------
Date: Fri, 23 Apr 2004 01:06:36 +1000
From: Sisyphus <kalinaubears@iinet.net.au>
Subject: Re: Operator overloading
Message-Id: <4087e0a9$0$16593$5a62ac22@freenews.iinet.net.au>
Anno Siegel wrote:
>
> What brought you to that conclusion? It's wrong. The overload routine
> must *return* an object, it doesn't have to create it. It is perfectly
> free to return its first argument with or without prior modification.
>
That's what I needed to know.
If I want to return the "first argument with or without prior
modification" then the overload routine needs to increase the first
arg's reference count - otherwise 'DESTROY($obj)' gets called. That's
where I was stuffing up. Your definitive reply quickly led me to that
realisation. (Actually I don't know that the reference count *needs* to
be increased - but it's certainly one way of efficiently fixing the
problem I was experiencing.)
The overload routines are Inline C routines, and they use functions in
the GMP library - and I doubted there was much use in posting any code.
Perhaps I was wrong about that .... or perhaps not. The current script
I'm using to test things out is reproduced below and seems to me to be
working nicely - in so far as it goes :-)
Thanks Anno.
Cheers,
Rob
package overloaded;
use warnings;
use Benchmark;
use overload
'*' => \&overload_mul,
'+' => \&overload_add,
'*=' => \&overload_mul_eq;
use Inline (C => Config =>
LIBS => '-lgmp',
BUILD_NOISY => 1,
);
use Inline C => <<'EOC';
#include <stdio.h>
#include <stdlib.h>
#include <gmp.h>
SV * Rmpz_init_set_str(SV * num, SV * base) {
mpz_t * mpz_t_obj;
unsigned long b = SvUV(base);
if(b == 1 || b > 36) croak("Second argument supplied to
Rmpz_init_set_str() is not in acceptable range");
New(1, mpz_t_obj, sizeof(mpz_t), mpz_t);
if(mpz_t_obj == NULL) croak("Failed to allocate memory in
Rmpz_init_set_str function");
if(mpz_init_set_str (*mpz_t_obj, SvPV_nolen(num), b))
croak("First argument supplied to Rmpz_init_set_str() is not a
valid base %u number", b);
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}
SV * overload_mul(SV * a, SV * b, SV * third) {
mpz_t * mpz_t_obj, t;
New(1, mpz_t_obj, sizeof(mpz_t), mpz_t);
if(mpz_t_obj == NULL) croak("Failed to allocate memory in
overload_mul function");
mpz_init(*mpz_t_obj);
if(SvUOK(b)) {
mpz_mul_ui(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), SvUV(b));
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}
if(SvIOK(b)) {
mpz_mul_si(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), SvIV(b));
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}
if(SvNOK(b)) {
mpz_init_set_d(t, SvNV(b));
mpz_mul(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), t);
mpz_clear(t);
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}
if(SvROK(b)) {
mpz_mul(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), *((mpz_t *)
SvIV(SvRV(b))));
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}
croak("Invalid argument supplied to overload_mul");
}
SV * overload_mul_eq(SV * a, SV * b, SV * third) {
mpz_t t;
if(SvUOK(b)) {
SvREFCNT_inc(a);
mpz_mul_ui(*((mpz_t *) SvIV(SvRV(a))), *((mpz_t *)
SvIV(SvRV(a))), SvUV(b));
return a;
}
if(SvIOK(b)) {
SvREFCNT_inc(a);
mpz_mul_si(*((mpz_t *) SvIV(SvRV(a))), *((mpz_t *)
SvIV(SvRV(a))), SvIV(b));
return a;
}
if(SvNOK(b)) {
SvREFCNT_inc(a);
mpz_init_set_d(t, SvNV(b));
mpz_mul(*((mpz_t *) SvIV(SvRV(a))), *((mpz_t *) SvIV(SvRV(a))), t);
mpz_clear(t);
return a;
}
if(SvROK(b)) {
SvREFCNT_inc(a);
mpz_mul(*((mpz_t *) SvIV(SvRV(a))), *((mpz_t *) SvIV(SvRV(a))),
*((mpz_t *) SvIV(SvRV(b))));
return a;
}
croak("Invalid argument supplied to overload_mul_eq");
}
SV * overload_add(SV * a, SV * b, SV * third) {
mpz_t * mpz_t_obj, t;
New(1, mpz_t_obj, sizeof(mpz_t), mpz_t);
if(mpz_t_obj == NULL) croak("Failed to allocate memory in
overload_mul function");
mpz_init(*mpz_t_obj);
if(SvUOK(b)) {
mpz_add_ui(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), SvUV(b));
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}
if(SvIOK(b)) {
if(SvIV(b) >= 0) {
mpz_add_ui(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), SvIV(b));
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}
mpz_sub_ui(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), SvIV(b) * -1);
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}
if(SvNOK(b)) {
mpz_init_set_d(t, SvNV(b));
mpz_add(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), t);
mpz_clear(t);
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}
if(SvROK(b)) {
mpz_add(*mpz_t_obj, *((mpz_t *) SvIV(SvRV(a))), *((mpz_t *)
SvIV(SvRV(b))));
return sv_setref_pv(newSViv(0), "overloaded", mpz_t_obj);
}
croak("Invalid argument supplied to overload_add function");
}
SV * Rmpz_get_str(SV * p, SV * base) {
char * out;
SV * outsv;
unsigned long b = SvUV(base);
if(b < 2 || b > 36) croak("Second argument supplied to
Rmpz_get_str() is not in acceptable range");
New(2, out, mpz_sizeinbase(*((mpz_t *) SvIV(SvRV(p))), b) + 5, char);
if(out == NULL) croak("Failed to allocate memory in Rmpz_deref
function");
mpz_get_str(out, b, *((mpz_t *) SvIV(SvRV(p))));
outsv = newSVpv(out, 0);
Safefree(out);
return outsv;
}
void DESTROY(SV * p) {
/* printf("Destroying mpz "); */
mpz_clear(*((mpz_t *) SvIV(SvRV(p))));
Safefree((mpz_t *) SvIV(SvRV(p)));
}
EOC
my $str = '12345';
my $x = Rmpz_init_set_str($str, 10);
my $y = Rmpz_init_set_str('7', 10);
my $z = 1 * $x * $y * (2 ** 43);
print Rmpz_get_str($z, 10), "\n";
$z = -9 + $z + $y + -7;
print Rmpz_get_str($z, 10), "\n";
$z = $z + 9;
print Rmpz_get_str($z, 10), "\n";
$z *= 11;
print Rmpz_get_str($z, 10), "\n";
$z *= 11;
print Rmpz_get_str($z, 10), "\n";
$z *= $y;
print Rmpz_get_str($z, 10), "\n";
timethese (1, {
'ovrld1' => '$z = factorial_1(50000);',
'ovrld2' => '$z = factorial_2(50000);',
});
sub factorial_1 {
my $n = $_[0];
my $ret = Rmpz_init_set_str('1', 16);
for(2 .. $n) {$ret = $ret * $_}
return $ret;
}
sub factorial_2 {
my $n = $_[0];
my $ret = Rmpz_init_set_str('1', 16);
for(2 .. $n) {$ret *= $_}
return $ret;
}
--
To reply by email u have to take out the u in kalinaubears.
------------------------------
Date: 22 Apr 2004 21:26:58 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: Operator overloading
Message-Id: <c69db2$pgv$1@mamenchi.zrz.TU-Berlin.DE>
Sisyphus <kalinaubears@iinet.net.au> wrote in comp.lang.perl.misc:
> Anno Siegel wrote:
>
> >
> > What brought you to that conclusion? It's wrong. The overload routine
> > must *return* an object, it doesn't have to create it. It is perfectly
> > free to return its first argument with or without prior modification.
> >
>
> That's what I needed to know.
> If I want to return the "first argument with or without prior
> modification" then the overload routine needs to increase the first
> arg's reference count - otherwise 'DESTROY($obj)' gets called. That's
> where I was stuffing up. Your definitive reply quickly led me to that
> realisation. (Actually I don't know that the reference count *needs* to
> be increased - but it's certainly one way of efficiently fixing the
> problem I was experiencing.)
For overload routines written in Perl, there is nothing special to
consider. You return something, perl deals with the refcount.
> The overload routines are Inline C routines, and they use functions in
Now, that's a different story, though I seem to remember that Inline
can handle the refcounts of SVs you return for you. I may be wrong,
it's been a while...
> the GMP library - and I doubted there was much use in posting any code.
> Perhaps I was wrong about that .... or perhaps not. The current script
> I'm using to test things out is reproduced below and seems to me to be
> working nicely - in so far as it goes :-)
Well... I didn't look closely, but you seem to do quite a bit of
explicit refcount handling. I wonder if it's all necessary.
Anno
------------------------------
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.
NOTE: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice.
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 6446
***************************************
