[7019] in Perl-Users-Digest
Perl-Users Digest, Issue: 644 Volume: 8
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sun Jun 22 17:07:12 1997
Date: Sun, 22 Jun 97 14:00:12 -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 Sun, 22 Jun 1997 Volume: 8 Number: 644
Today's topics:
None (William C Ralph)
Some more case-matching substitution (William C Ralph)
Digest Administrivia (Last modified: 8 Mar 97) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sat, 21 Jun 1997 18:56:01 -0500 (CDT)
From: ralphwc@mail.auburn.edu (William C Ralph)
Subject: None
Message-Id: <Pine.SOL.3.95.970621184357.25063A-100000@wood2>
As suggested, I found the following subroutine in the faq for
case-matching substitution:
sub preserve_case($$)
{
my ($old, $new) = @_;
my ($state) = 0; # 0 = no change; 1 = lc; 2 = uc
my ($i, $oldlen, $newlen, $c) = (0, length($old), length($new));
my ($len) = $oldlen < $newlen ? $oldlen : $newlen;
for ($i = 0; $i < $len; $i++) {
if ($c = substr($old, $i, 1), $c =~ /[\W\d_]/) {
$state = 0;
} elsif (lc $c eq $c) {
substr($new, $i, 1) = lc(substr($new, $i, 1));
$state = 1;
} else {
substr($new, $i, 1) = uc(substr($new, $i, 1));
$state = 2;
}
}
# finish up with any remaining new (for when new is longer than
old)
if ($newlen > $oldlen) {
if ($state == 1) {
substr($new, $oldlen) = lc(substr($new, $oldlen));
} elsif ($state == 2) {
substr($new, $oldlen) = uc(substr($new, $oldlen));
}
}
return $new;
}
Which is invoked by using:
$output =~ s/($find)/preserve_case($1, "$replace")/gie;
This works great for several hundred find and replace variables like I
have, except for the following example:
$output = "It was a Catastrophe.";
$find = "cat";
$replace = "feline";
Because you end up with, "It was a Felineastrophe."
So you also do:
$find = " cat ";
$replace = " feline ";
But if you have the case where
$output = "Did you see that cat?"
$find = " cat? ";
$replace = " feline? ";
Because the substitution operator reads "?" as a special character. So
how can you change $find and $replace or $output =~ s/... to deal with
periods and question marks?
Carter Ralph
------------------------------
Date: Sat, 21 Jun 1997 18:43:29 -0500 (CDT)
From: ralphwc@mail.auburn.edu (William C Ralph)
Subject: Some more case-matching substitution
Message-Id: <Pine.SOL.3.95.970621184001.24997B-100000@wood2>
As suggested, I found the program on the faq page. It reads as follows:
sub preserve_case($$)
{
my ($old, $new) = @_;
my ($state) = 0; # 0 = no change; 1 = lc; 2 = uc
my ($i, $oldlen, $newlen, $c) = (0, length($old), length($new));
my ($len) = $oldlen < $newlen ? $oldlen : $newlen;
for ($i = 0; $i < $len; $i++) {
if ($c = substr($old, $i, 1), $c =~ /[\W\d_]/) {
$state = 0;
} elsif (lc $c eq $c) {
substr($new, $i, 1) = lc(substr($new, $i, 1));
$state = 1;
} else {
substr($new, $i, 1) = uc(substr($new, $i, 1));
$state = 2;
}
}
# finish up with any remaining new (for when new is longer than
old)
if ($newlen > $oldlen) {
if ($state == 1) {
substr($new, $oldlen) = lc(substr($new, $oldlen));
} elsif ($state == 2) {
substr($new, $oldlen) = uc(substr($new, $oldlen));
}
}
return $new;
}
And is invoked by using:
------------------------------
Date: 8 Mar 97 21:33:47 GMT (Last modified)
From: Perl-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 8 Mar 97)
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.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 644
*************************************
