home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #20 / NN_1992_20.iso / spool / comp / lang / perl / 5845 < prev    next >
Encoding:
Internet Message Format  |  1992-09-10  |  2.4 KB
  1. Path: sparky!uunet!dtix!darwin.sura.net!uvaarpa!mmdf
  2. From: noran!iowa!kburton@uunet.uu.net (Kevin Burton)
  3. Newsgroups: comp.lang.perl
  4. Subject: RE: Case dependent substitution
  5. Message-ID: <1992Sep10.194824.1145@uvaarpa.Virginia.EDU>
  6. Date: 10 Sep 92 19:48:24 GMT
  7. Sender: mmdf@uvaarpa.Virginia.EDU (Mail System)
  8. Reply-To: noran!iowa!kburton@uunet.uu.net
  9. Organization: The Internet
  10. Lines: 88
  11.  
  12.  
  13. Tom Christiansen writes:
  14.  
  15. |  I've often wanted a /I switch that behaved this way.  Here's
  16. |  what I use:
  17. |  
  18. |      s/abc/&mapcase('xyz')/gie;
  19. |  
  20. |  where mapcase is as follows:
  21. |  
  22. |      sub mapcase {
  23. |      local($lhs, $rhs) = ($&, shift);
  24. |      for (local($i) = 0; $i < length($lhs); $i++) {
  25. |          substr($lhs, $i, 1) =~ tr/A-Z//
  26. |          ? substr($rhs, $i, 1) =~ tr/a-z/A-Z/
  27. |          : substr($rhs, $i, 1) =~ tr/A-Z/a-z/;
  28. |      }
  29. |      $rhs;
  30. |      }
  31. |    .
  32. |    .
  33. |    .
  34. |  But it's not entirely satisfactory.  Consider
  35. |  
  36. |      $_ = "Green is the green apple who has GREEN WORMS\n";
  37. |      print;
  38. |      s/green/&mapcase3('red')/gie;
  39. |      print;
  40. |  
  41. |      print "\n";
  42. |  
  43. |      $_ = "Red is the red apple who has RED WORMS\n";
  44. |      print;
  45. |      s/red/&mapcase3('green')/gie;
  46. |      print;
  47. |  
  48. |  
  49. |  Yields:
  50. |  
  51. |      Green is the green apple who has GREEN WORMS
  52. |      Red is the red apple who has RED WORMS
  53. |  
  54. |      Red is the red apple who has RED WORMS
  55. |      Green is the green apple who has GREen WORMS
  56.  
  57. Thanks for the reply it gave me enough to generate the solution that
  58. is as follows:
  59.  
  60.     sub mapcase {
  61.         local($lhs, $rhs) = ($&, shift);
  62.         local($i,$j);
  63.     
  64.         # the case of the target will match th case of the source
  65.         for ($i = 0; $i < length($lhs); $i++)
  66.         {
  67.             substr($lhs, $i, 1) =~ tr/A-Z//
  68.             ? substr($rhs, $i, 1) =~ tr/a-z/A-Z/
  69.             : substr($rhs, $i, 1) =~ tr/A-Z/a-z/;
  70.         }
  71.     
  72.         # Avoid getting GReen when substituting re5 with green
  73.         while(substr($lhs, $i-1, 1) !~ tr/A-Za-z//)
  74.         {
  75.             $i--;
  76.         }
  77.         # Avoid getting GREen when substituting red with green
  78.         for ($j = $i; $j < length($rhs); $j++)
  79.         {
  80.              substr($lhs, $i-1, 1) =~ tr/A-Z//
  81.             ? substr($rhs, $j, 1) =~ tr/a-z/A-Z/
  82.             : substr($rhs, $j, 1) =~ tr/A-Z/a-z/;
  83.         }
  84.     
  85.         $rhs;
  86.     }
  87.  
  88. Thank you!
  89.  
  90. -
  91.  
  92. This is not an official statement of Noran Instruments. No warranty is
  93. expressed or implied. The information included herein is not to be construed
  94. as a committment on Noran's part.
  95.  
  96. Kevin Burton
  97. Noran Instruments                voice: (608) 831-6511 x317
  98. 2551 West Beltline Highway, Room 532          FAX: (608) 836-7224
  99. Middleton, WI 53562                email: kburton@noran.com
  100.