How do I search and replace with "OR" condition - perl

This is a trivial issue, but I hope someone can point me to the right way to do it. I have a string "Thunderstorms" which I replace with "T/storms".
s/Thunderstorms/T\/Storms/gi
It so happens that "Thunderstorms" is sometimes written as "Thunder Storms". Instead of writing two search and replace commands, I am looking for replacing "Thunderstorms" or "Thunder storms" with "T/Storms" in one command.

You can use \s* to match zero or more whitespaces:
use warnings;
use strict;
while (<DATA>) {
s{Thunder\s*storms}{T/Storms}gi;
print;
}
__DATA__
Thunderstorms
Thunder Storms
Thunder storms
Outputs:
T/Storms
T/Storms
T/Storms
I used different delimeters for the substitution operator (s{}{}) to avoid escaping the /.

use |.
s/Thunderstorms|Thunder\sStorms/T\/Storms/gi
sample code:
use strict;
use warnings;
my $str = 'Thunderstorms foo Thunder Storms bar';
$str =~ s/Thunderstorms|Thunder\sStorms/T\/Storms/gi;
print $str;

Related

Chopping the last sequence of a pattern

I have this series of values
rd_8KB_rms
rd_8KB_rms_qd1
rd_8KB_wh
rd_8KB_wh_q1
rd_8KB_wms
rd_8KB_wms_qd1
rd_256K_rms
rd_256K_rms_1
and where there are 3 underscores I would like to chop the last underscore and the characters that trail it ( which are variable in number). I think I have tried variations of substr, split, regex but can't find anything that works
You can use transliteration tr/_// to count the number of underscores and substitution s/_[^_]*$// to remove the part from the last underscore to the end.
#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
while (<DATA>) {
chomp;
s/_[^_]*$// if tr/_// == 3;
say;
}
__DATA__
rd_8KB_rms
rd_8KB_rms_qd1
rd_8KB_wh
rd_8KB_wh_q1
rd_8KB_wms
rd_8KB_wms_qd1
rd_256K_rms
rd_256K_rms_1
If there can be even more underscores, use a variant like
s/_[^_]*$// until tr/_// <= 3;

Perl - Convert integer to text Char(1,2,3,4,5,6)

I am after some help trying to convert the following log I have to plain text.
This is a URL so there maybe %20 = 'space' and other but the main bit I am trying convert is the char(1,2,3,4,5,6) to text.
Below is an example of what I am trying to convert.
select%20char(45,120,49,45,81,45),char(45,120,50,45,81,45),char(45,120,51,45,81,45)
What I have tried so far is the following while trying to added into the char(in here) to convert with the chr($2)
perl -pe "s/(char())/chr($2)/ge"
All this has manage to do is remove the char but now I am trying to convert the number to text and remove the commas and brackets.
I maybe way off with how I am doing as I am fairly new to to perl.
perl -pe "s/word to remove/word to change it to/ge"
"s/(char(what goes in here))/chr($2)/ge"
Output try to achieve is
select -x1-Q-,-x2-Q-,-x3-Q-
Or
select%20-x1-Q-,-x2-Q-,-x3-Q-
Thanks for any help
There's too much to do here for a reasonable one-liner. Also, a script is easier to adjust later
use warnings;
use strict;
use feature 'say';
use URI::Escape 'uri_unescape';
my $string = q{select%20}
. q{char(45,120,49,45,81,45),char(45,120,50,45,81,45),}
. q{char(45,120,51,45,81,45)};
my $new_string = uri_unescape($string); # convert %20 and such
my #parts = $new_string =~ /(.*?)(char.*)/;
$parts[1] = join ',', map { chr( (/([0-9]+)/)[0] ) } split /,/, $parts[1];
$new_string = join '', #parts;
say $new_string;
this prints
select -x1-Q-,-x2-Q-,-x3-Q-
Comments
Module URI::Escape is used to convert percent-encoded characters, per RFC 3986
It is unspecified whether anything can follow the part with char(...)s, and what that might be. If there can be more after last char(...) adjust the splitting into #parts, or clarify
In the part with char(...)s only the numbers are needed, what regex in map uses
If you are going to use regex you should read up on it. See
perlretut, a tutorial
perlrequick, a quick-start introduction
perlre, the full account of syntax
perlreref, a quick reference (its See Also section is useful on its own)
Alright, this is going to be a messy "one-liner". Assuming your text is in a variable called $text.
$text =~ s{char\( ( (?: (?:\d+,)* \d+ )? ) \)}{
my #arr = split /,/, $1;
my $temp = join('', map { chr($_) } #arr);
$temp =~ s/^|$/"/g;
$temp
}xeg;
The regular expression matches char(, followed by a comma-separated list of sequences of digits, followed by ). We capture the digits in capture group $1. In the substitution, we split $1 on the comma (since chr only works on one character, not a whole list of them). Then we map chr over each number and concatenate the result into a string. The next line simply puts quotation marks at the start and end of the string (presumably you want the output quoted) and then returns the new string.
Input:
select%20char(45,120,49,45,81,45),char(45,120,50,45,81,45),char(45,120,51,45,81,45)
Output:
select%20"-x1-Q-","-x2-Q-","-x3-Q-"
If you want to replace the % escape sequences as well, I suggest doing that in a separate line. Trying to integrate both substitutions into one statement is going to get very hairy.
This will do as you ask. It performs the decoding in two stages: first the URI-encoding is decoded using chr hex $1, and then each char() function is translated to the string corresponding to the character equivalents of its decimal parameters
use strict;
use warnings 'all';
use feature 'say';
my $s = 'select%20char(45,120,49,45,81,45),char(45,120,50,45,81,45),char(45,120,51,45,81,45)';
$s =~ s/%(\d+)/ chr hex $1 /eg;
$s =~ s{ char \s* \( ( [^()]+ ) \) }{ join '', map chr, $1 =~ /\d+/g }xge;
say $s;
output
select -x1-Q-,-x2-Q-,-x3-Q-

Perl string in Quote Word?

Seem like my daily road block. Is this possible? String in qw?
#!/usr/bin/perl
use strict;
use warnings;
print "Enter Your Number\n";
my $usercc = <>;
##split number
$usercc =~ s/(\w)(?=\w)/$1 /g;
print $usercc;
## string in qw, hmm..
my #ccnumber = qw($usercc);
I get Argument "$usercc" isn't numeric in multiplication (*) at
Thanks
No.
From: http://perlmeme.org/howtos/perlfunc/qw_function.html
How it works
qw() extracts words out of your string
using embedded whitsepace as the
delimiter and returns the words as a
list. Note that this happens at
compile time, which means that the
call to qw() is replaced with the list
before your code starts executing.
Additionlly, no interpolation is possible in the string you pass to qw().
Instead of that, use
my #ccnumber = split /\s+/, $usercc;
Which does what you probably want, to split $usercc on whitespace.

Can I use the y operator to do a non-one-to-one transliteration in Perl?

The y operator in Perl does character-by-character transliteration. For example, if we do y/abc/dfg to the string "foobar", we get "foofdr". But what if I want to transliterate "ā" to "ei" and "ä" to "a:" and "ō" to "әu" and "o" to "ɒ".
I tried the following line of code but no luck:(
y/āäōo/(ei)(a:)(әu)ɒ/
Do we hopefully have a workaround for this problem? Or do I have to repeatedly use the s operator and do a lot of cumbersome substitutions?
Thanks in advance for any guidance :)
In this case, create a hash and go from the keys to the strings easily.
use warnings;
use strict;
use utf8;
binmode STDOUT, ":utf8";
my $string = "āäōo";
my %trans = qw/ā ei ä a: ō u o ɒ/;
my $keys = join '', keys %trans;
$string =~ s/([$keys])/$trans{$1}/g;
print "$string\n";
You need to alter this if your keys are more than one character long by sorting the keys in order of decreasing length and joining them using ( | | ) instead of [ ].
It sounds like you're trying to do something similar to Text::Unaccent::PurePerl.

How can I reverse a string that contains combining characters in Perl?

I have the string "re\x{0301}sume\x{0301}" (which prints like this: résumé) and I want to reverse it to "e\x{0301}muse\x{0301}r" (émusér). I can't use Perl's reverse because it treats combining characters like "\x{0301}" as separate characters, so I wind up getting "\x{0301}emus\x{0301}er" ( ́emuśer). How can I reverse the string, but still respect the combining characters?
You can use the \X special escape (match a non-combining character and all of the following combining characters) with split to make a list of graphemes (with empty strings between them), reverse the list of graphemes, then join them back together:
#!/usr/bin/perl
use strict;
use warnings;
my $original = "re\x{0301}sume\x{0301}";
my $wrong = reverse $original;
my $right = join '', reverse split /(\X)/, $original;
print "original: $original\n",
"wrong: $wrong\n",
"right: $right\n";
The best answer is to use Unicode::GCString, as Sinan points out
I modified Chas's example a bit:
Set the encoding on STDOUT to avoid "wide character in print" warnings;
Use a positive lookahead assertion (and no separator retention mode) in split (doesn't work after 5.10, apparently, so I removed it)
It's basically the same thing with a couple of tweaks.
use strict;
use warnings;
binmode STDOUT, ":utf8";
my $original = "re\x{0301}sume\x{0301}";
my $wrong = reverse $original;
my $right = join '', reverse split /(\X)/, $original;
print <<HERE;
original: [$original]
wrong: [$wrong]
right: [$right]
HERE
You can use Unicode::GCString:
Unicode::GCString treats Unicode string as a sequence of extended grapheme clusters defined by Unicode Standard Annex #29 [UAX #29].
#!/usr/bin/env perl
use utf8;
use strict;
use warnings;
use feature 'say';
use open qw(:std :utf8);
use Unicode::GCString;
my $x = "re\x{0301}sume\x{0301}";
my $y = Unicode::GCString->new($x);
my $wrong = reverse $x;
my $correct = join '', reverse #{ $y->as_arrayref };
say "$x -> $wrong";
say "$y -> $correct";
Output:
résumé -> ́emuśer
résumé -> émusér
Perl6::Str->reverse also works.
In the case of the string résumé, you can also use the Unicode::Normalize core module to change the string to a fully composed form (NFC or NFKC) before reverseing; however, this is not a general solution, because some combinations of base character and modifier have no precomposed Unicode codepoint.
Some of the other answers contain elements that don't work well. Here is a working example tested on Perl 5.12 and 5.14. Failing to specify the binmode will cause the output to generate error messages. Using a positive lookahead assertion (and no separator retention mode) in split will cause the output to be incorrect on my Macbook.
#!/usr/bin/perl
use strict;
use warnings;
use feature 'unicode_strings';
binmode STDOUT, ":utf8";
my $original = "re\x{0301}sume\x{0301}";
my $wrong = reverse $original;
my $right = join '', reverse split /(\X)/, $original;
print "original: $original\n",
"wrong: $wrong\n",
"right: $right\n";