Remove all characters except "all" or "ALL" - perl

I have string like this
$input = "ALL112343" or $input = "all11234" or $input = "ALL 1234"
my expect output would be
$input = "ALL" or $input = "all"
so, how can I remove all the character in that string except the word "all" or "ALL"?
Thank you all for your help,

You want
($input) = $input =~ /(all)/i;

If there can only be one occurrence of all or ALL:
$input = $input =~ /(all|ALL)/ ? $1 : "";
If there can be multiple occurrences of all or ALL:
$input =~ s/\G(?:all|ALL)*\K.//sg;
$input = join('', $input =~ /all|ALL/g );
It might be more useful to have an array of matches:
my #matches = $input =~ /all|ALL/g;

Related

Split to get only characters in Perl

I have a string like this :
Reporting EXE1 BASE,Normal
I need to get a var for every words like :
$info = "Reporting";
$host = "EXE1";
$device = "BASE";
$status = "Normal";
In fact, i saw the function "Split" might be a good use, but i don't understand the patern to use.
I prefer to use a global regex pattern match instead of split. That way you can specify the characters that you're interested in instead of the ones that you want to discard, and there's no chance of a spurious initial empty field if your string happens to start with a separator
It looks like you want to pick out "word" characters, which are upper and lower case letters, decimal digits, and the underscore character. There's a built-in character class \w for that, so finding all sequences that match \w+ should find the data for you
Here's an example program
use strict;
use warnings 'all';
my $s = 'Reporting EXE1 BASE,Normal';
my ( $info, $host, $device, $status ) = $s =~ /\w+/g;
print qq{\$info = "$info"\n};
print qq{\$host = "$host"\n};
print qq{\$device = "$device"\n};
print qq{\$status = "$status"\n};
output
$info = "Reporting"
$host = "EXE1"
$device = "BASE"
$status = "Normal"
If you want to allow more characters than \w matches then you could use
my ( $info, $host, $device, $status ) = $s =~ /[^\s,]+/g;
which matches sequences of characters that are neither space nor comma
Given your sample data the results are identical, but I cannot tell what your real data looks like
Use split(/\s|,/,"Reporting EXE1 BASE,Normal") to split the string on comma and blank
You might try this code.
my $str = "Reporting EXE1 BASE,Normal";
my #fields = split /\s|,/, $str;
my $info = $fields[0];
my $host = $fields[1];
my $device = $fields[2];
my $status = $fields[3];
print "$info\n";
print "$host\n";
print "$device\n";
print "$status\n";
Or more compact version -
my $str = "Reporting EXE1 BASE,Normal";
my ( $info, $host, $device, $status ) = split /[\s,]/, $str ;
print "$info\n";
print "$host\n";
print "$device\n";
print "$status\n";
No need to store the data in an array. Directly create the list and give the variable name to it.
my $string = "Reporting EXE1 BASE,Normal";
my ($info ,$host,$device,$status) = split(/\s|,/,$string);
print "$info ,$host,$device,$status";
Or else you could use pattern matching
my ($info ,$host,$device,$status) = $string =~m/(\w+)/g;

Perl: how to split string without storing into array and continue split?

I guess this has been asked before, but I can't find it.
Say
my $string = "something_like:this-and/that";
my #w1 = split(/_/, $string);
my #w2 = split(/-/, $w1[1]);
my #w3 = split(/:/, $w2[0]);
print $w3[1]; #print out "this"
Is there anyway to avoid the temporary array variables #w1, #w2 and #w3 and get $w3[1] directly? I remember continue split works, but forget the syntax.
Thanks.
Yes, it's possible, but would be much harder to read, so isn't advised:
my $string = "something_like:this-and/that";
my $this = (split /:/, (split /-/, (split(/_/, $string))[1])[0])[1];
print $this; #print out "this"
Alternatively, you could use a regex in this instance, but don't think it adds anything:
my $string = "something_like:this-and/that";
my ($this) = $string =~ /.*?_.*?:([^-]*)/ or warn "not found";
print $this;
Your own solution unnecessarily splits on underscores, unless your real data is significantly different from your example. You could write this
use strict;
use warnings;
my $string = "something_like:this-and/that";
my $value = (split /-/, (split /:/, $string)[1])[0];
print $value;
Or this solution uses regular expressions and does what you ask
use strict;
use warnings;
my $string = "something_like:this-and/that";
my ($value) = $string =~ /:([^_-]*)/;
print $value;
output
this
This will modify $string in place:
my $string = "something_like:this-and/that";
$string =~ s/^.*:(.+)-.*/$1/;

Pattern Matching in perl

I want to parse some information from the file.
Information in the file:
Rita_bike_house_Sha9
Rita_bike_house
I want to have output like dis
$a = Rita_bike_house and $b = Sha9,
$a = Rita_bike_house and $b = "original"
In order to get that I have used the below code:
$name = #_; # This #_ has all the information from the file that I have shown above.
#For matching pattern Rita_bike_house_Sha9
($a, $b) = $name =~ /\w\d+/;
if ($a ne "" and $b ne "" ) { return ($a,$b) }
# this statement doesnot work at all as its first condition
# before the end is not satisified.
Is there any way where I can store "Rita_bike_house" in $a and "Sha9" in $b? I think my regexp is missing with something. Can you suggest anything?
Please don't use the variables $a and $b in your code. There are used by sort and will confuse you.
Try:
while( my $line = <DATA> ){
chomp $line;
if( $line =~ m{ \A ( \w+ ) _ ( [^_]* \d [^_]* ) \z }msx ){
my $first = $1;
my $second = $2;
print "\$a = $first and \$b = $second\n";
}else{
print "\$a = $line and \$b = \"original\"\n";
}
}
__DATA__
Rita_bike_house_Sha9
Rita_bike_house
Not very nice, but the next:
use strict;
use warnings;
while(<DATA>) {
chomp;
next if /^\s*$/;
my #parts = split(/_/);
my $b = pop #parts if $parts[$#parts] =~ /\d/;
$b //= '"original"';
my $a = join('_', #parts);
print "\$a = $a and \$b = $b,\n";
}
__DATA__
Rita_bike_house_Sha9
Rita_bike_house
prints:
$a = Rita_bike_house and $b = Sha9,
$a = Rita_bike_house and $b = "original",
If you are sure that the pattern which is required will always be similar to 'Sha9' and also it will appear at the end then just do a greedy matching....
open FILE, "filename.txt" or die $!;
my #data = <FILE>;
close(<FILE>);
#my $line = "Rita_bike_house_Sha9";
foreach $line (#data)
{
chomp($line);
if ($line =~ m/(.*?)(_([a-zA-Z]+[0-9]+))?$/)
{
$a = $1;
$b = $3 ? $3 : "original";
}
}

How to display user input on one line in a palandrome assignment?

In perl, I have to determine whether user input is a palindrome or not and it must display like this:
Enter in 7 characters: ghghghg #one line here #
Palindrome! #second line answer#
But instead this is what it does:
Enter in 7 characters: g #one line#
h #second line#
g #third line#
h #fourth line#
g #fifth line#
h #sixth line#
g Palindrom
e! #seventh line#
My problem seems to be on the chomp lines with all the variables but I just can't figure out what to do and I've been at if for hours. I need a simple solution, but have not progressed to arrays yet so need some simple to fix this. Thanks
And here is what i have so far, the formula seems to work but it keeps printing a new line for each character:
use strict;
use warnings;
my ($a, $b, $c, $d, $e, $f, $g);
print "Enter in 7 characters:";
chomp ($a = <>); chomp ($b = <>); chomp ($c = <>); chomp ($d = <>); chomp ($e = <>); chomp ($f = <>); chomp ($g = <>);
if (($a eq $g) && ($b eq $f) && ($c eq $e) && ($d eq $d) && ($e eq $c) && ($f eq $b) && ($g eq $a))
{print "Palindrome! \n";}
else
{print "Not Palindrome! \n";}
If you're going to determine if a word is the same backwards, may I suggest using reverse and lc?
chomp(my $word = <>);
my $reverse = reverse $word;
if (lc($word) eq lc($reverse)) {
print "Palindrome!";
} else {
print "Not palindrome!";
}
Perl is famous for its TIMTOWTDI. Here are two more ways of doing it:
print "Enter 7 characters: ";
chomp(my $i= <STDIN>);
say "reverse: ", pal_reverse($i) ? "yes" : "no";
say "regex: ", pal_regex($i) ? "yes" : "no";
sub pal_reverse {
my $i = (#_ ? shift : $_);
return $i eq reverse $i;
}
sub pal_regex {
return (#_ ? shift() : $_) =~ /^(.?|(.)(?1)\2)$/ + 0;
}
use strict;
use warnings;
use feature 'say';
print "Please enter 7 characters : ";
my $input = <>; # Read in input
chomp $input; # To remove trailing "\n"
# Season with input validation
warn 'Expected 7 characters, got ', length $input, ' instead'
unless length $input == 7;
# Determine if it's palindromic or not
say $input eq reverse $input
? 'Palindrome'
: 'Not palindrome' ;
TIMTOWTDI for the recursion-prone:
sub is_palindrome {
return 1 if length $_[0] < 2; # Whole string is palindromic
goto \&is_palindrome
if substr $_[0], 0, 1, '' eq substr $_[0], -1, 1, ''; # Check next chars
return; # Not palindromic if we reach here
}
say is_palindrome( 'ghghghg' ) ? 'Palindromic' : 'Not palindromic' ;
And perldoc perlretut for those who aren't :)
Recursive patterns
This feature (introduced in Perl 5.10) significantly extends the power
of Perl's pattern matching. By referring to some other capture group
anywhere in the pattern with the construct (?group-ref), the pattern
within the referenced group is used as an independent subpattern in
place of the group reference itself. Because the group reference may
be contained within the group it refers to, it is now possible to
apply pattern matching to tasks that hitherto required a recursive
parser.
To illustrate this feature, we'll design a pattern that matches if a
string contains a palindrome. (This is a word or a sentence that,
while ignoring spaces, interpunctuation and case, reads the same
backwards as forwards. We begin by observing that the empty string or
a string containing just one word character is a palindrome. Otherwise
it must have a word character up front and the same at its end, with
another palindrome in between.
/(?: (\w) (?...Here be a palindrome...) \g{-1} | \w? )/x
Adding \W* at either end to eliminate what is to be ignored, we
already have the full pattern:
my $pp = qr/^(\W* (?: (\w) (?1) \g{-1} | \w? ) \W*)$/ix;
for $s ( "saippuakauppias", "A man, a plan, a canal: Panama!" ){
print "'$s' is a palindrome\n" if $s =~ /$pp/;
}

Perl - How to change every $variable occurrence of ";" in a string

Very new here so be gentle. :)
Here is the jist of what I want to do:
I want to take a string that is made up of numbers separated by semi-colons (ex. 6;7;8;9;1;17;4;5;90) and replace every "X" number of semicolons with a "\n" instead. The "X" number will be defined by the user.
So if:
$string = "6;7;8;9;1;17;4;5;90";
$Nth_number_of_semicolons_to_replace = 3;
The output should be:
6;7;8\n9;1;17\n4;5;90
I've found lots on changing the Nth occurrence of something but I haven't been able to find anything on changing every Nth occurrence of something like I am trying to describe above.
Thanks for all your help!
use List::MoreUtils qw(natatime);
my $input_string = "6;7;8;9;1;17;4;5;90";
my $it = natatime 3, split(";", $input_string);
my $output_string;
while (my #vals = $it->()) {
$output_string .= join(";", #vals)."\n";
}
Here is a quick and dirty answer.
my $input_string = "6;7;8;9;1;17;4;5;90";
my $count = 0;
$input_string =~ s/;/++$count % 3 ? ";" : "\n"/eg;
Don't have time for a full answer now, but this should get you started.
$string = "6;7;8;9;1;17;4;5;90";
$Nth_number_of_semicolons_to_replace = 3;
my $regexp = '(' . ('\d+;' x ($Nth_number_of_semicolons_to_replace - 1)) . '\d+);';
$string =~ s{ $regexp ) ; }{$1\n}xsmg
sub split_x{
my($str,$num,$sep) = #_;
return unless defined $str;
$num ||= 1;
$sep = ';' unless defined $sep;
my #return;
my #tmp = split $sep, $str;
while( #tmp >= $num ){
push #return, join $sep, splice #tmp, 0, $num;
}
push #return, join $sep, #tmp if #tmp;
return #return;
}
print "$_\n" for split_x '6;7;8;9;1;17;4;5;90', 3
print join( ',', split_x( '6;7;8;9;1;17;4;5;90', 3 ) ), "\n";
my $string = "6;7;8;9;1;17;4;5;90";
my $Nth_number_of_semicolons_to_replace = 3;
my $num = $Nth_number_of_semicolons_to_replace - 1;
$string =~ s{ ( (?:[^;]+;){$num} [^;]+ ) ; }{$1\n}gx;
print $string;
prints:
6;7;8
9;1;17
4;5;90
The regex explained:
s{
( # start of capture group 1
(?:[^;]+;){$num} # any number of non ';' characters followed by a ';'
# repeated $num times
[^;]+ # any non ';' characters
) # end of capture group
; # the ';' to replace
}{$1\n}gx; # replace with capture group 1 followed by a new line
If you've got 5.10 or higher, this could do the trick:
#!/usr/bin/perl
use strict;
use warnings;
my $string = '1;2;3;4;5;6;7;8;9;0';
my $n = 3;
my $search = ';.*?' x ($n -1);
print "string before: [$string]\n";
$string =~ s/$search\K;/\n/g;
print "print string after: [$string]\n";
HTH,
Paul