Why perl is giving different result below?
$a = "bar";
$a =~ tr/abc/ABC/d;
print "[$a]\n"; # prints "BAr" as expected.
$x = "bar";
$y = "abc";
$z = "ABC";
$x =~ tr/\\Q$y\\E/\\Q$z\\E/d;
print "[$x]\n"; # prints "bar" to my surprise.
Similarly one more test case as below:
$p = "--aaa--";
$q = "abc-";
$r = "ABC";
$p =~ tr/\\Q$q\\E/\\Q$r\\E/d;
print "[$p]\n"; # prints "--aaa--" surprisingly.
$s = "--aaa--";
$s =~ tr/abc-/ABC/d;
print "[$s]\n"; # prints "AAA" as expected.
Can some body please explain this behaviour?
Best Regards,
Mohammad S Anwar
tr/// does not interpolate.
tr/\\Q$y\\E/\\Q$z\\E/d translates
\ to \
Q to Q
$ to $
y to z
E to E
$x does not contain any of those characters, so it remains unchanged.
tr/\\Q$q\\E/\\Q$r\\E/d translates
\ to \
Q to Q
$ to $
q to r
E to E
$p does not contain any of those characters, so it remains unchanged.
To get the desired behaviour, you could use
my %tr;
#tr{ split(//, $fr) } = split(//, $to);
$_ //= '' for values %tr;
my $re = '['.( join '', map quotemeta, keys %tr ).']';
$s =~ s/($re)/$tr{$1}/g;
or
eval "\\$s =~ tr/\Q$fr\E/\Q$to\E/d";
die $# if $#;
Related
The output for the command is ent3, and from that output I want 3 to be stored in a variable
Perl code
sub {
if ( $exit == 1 )
{
$cmdStr = "lsdev | grep en | grep VLAN | awk '{ print \$1 }'\r";
$result =_run_cmd($cmdStr);
my #PdAt_val = split("\r?\n", $result);
my $num = $result =~ /([0-9]+)/;
print "The char is $num\n";
$exit = 0;
exp_continue;
Tidied code
sub {
if ( $exit == 1 ) {
$cmdStr = "lsdev | grep en | grep VLAN | awk '{ print \$1 }'\r";
$result = _run_cmd($cmdStr);
my #PdAt_val = split("\r?\n", $result);
my $num = $result =~ /([0-9]+)/;
print "The char is $num\n";
$exit = 0;
exp_continue;
Your code that is doing the work here is:
my $num = $result =~ /([0-9]+)/;
Let's put that into a simple program so we can see what's going on.
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
my $result = 'ext3';
my $num = $result =~ /([0-9]+)/;
say $num;
And that prints 1. Which isn't what we want. What's going on?
Well, if you read the documentation for the match operator (in the section Regexp Quote-Like Operators in "perlop"), you'll see what the operator returns under different circumstances. It says:
Searches a string for a pattern match, and in scalar context returns true if it succeeds, false if it fails.
So that explains the behaviour we're seeing. That "1" is just a true value saying that the match succeeded. But how do we get the value that we have captured in our parentheses. There are a couple of ways. Firstly, it's written into the $1 variable.
my $num;
if ($result =~ /([0-9]+)/) {
$num = $1;
}
say $num;
But I think the other approach is what you were looking for. If you read on, you'll see what the operator returns in list context:
m// in list context returns a list consisting of the subexpressions matched by the parentheses in the pattern, that is, ($1, $2, $3 ...)
So if we put the match operator in list context, then we'll get the contents of $1 returned. How do we put a match into list context? By making the expression a list assignment - which we can do by putting parentheses around the left-hand side of the assignment.
my ($num) = $result =~ /([0-9]+)/;
say $num;
Using regex, something like this should work:
if($result =~ /([0-9]+)/) {
$num = $1;
}
print $num;
I felt there must a better way to count occurrence instead of writing a sub in perl, shell in Linux.
#/usr/bin/perl -w
use strict;
return 1 unless $0 eq __FILE__;
main() if $0 eq __FILE__;
sub main{
my $str = "ru8xysyyyyyyysss6s5s";
my $char = "y";
my $count = count_occurrence($str, $char);
print "count<$count> of <$char> in <$str>\n";
}
sub count_occurrence{
my ($str, $char) = #_;
my $len = length($str);
$str =~ s/$char//g;
my $len_new = length($str);
my $count = $len - $len_new;
return $count;
}
If the character is constant, the following is best:
my $count = $str =~ tr/y//;
If the character is variable, I'd use the following:
my $count = length( $str =~ s/[^\Q$char\E]//rg );
I'd only use the following if I wanted compatibility with versions of Perl older than 5.14 (as it is slower and uses more memory):
my $count = () = $str =~ /\Q$char/g;
The following uses no memory, but might be a bit slow:
my $count = 0;
++$count while $str =~ /\Q$char/g;
Counting the occurences of a character in a string can be performed with one line in Perl (as compared to your 4 lines). There is no need for a sub (although there is nothing wrong with encapsulating functionality in a sub). From perlfaq4 "How can I count the number of occurrences of a substring within a string?"
use warnings;
use strict;
my $str = "ru8xysyyyyyyysss6s5s";
my $char = "y";
my $count = () = $str =~ /\Q$char/g;
print "count<$count> of <$char> in <$str>\n";
In a beautiful* Bash/Coreutils/Grep one-liner:
$ str=ru8xysyyyyyyysss6s5s
$ char=y
$ fold -w 1 <<< "$str" | grep -c "$char"
8
Or maybe
$ grep -o "$char" <<< "$str" | wc -l
8
The first one works only if the substring is just one character long; the second one works only if the substrings are non-overlapping.
* Not really.
toolic has given a correct answer, but you might consider not hardcoding your values to make the program reusable.
use strict;
use warnings;
die "Usage: $0 <text> <characters>" if #ARGV < 1;
my $search = shift; # the string you are looking for
my $str; # the input string
if (#ARGV && -e $ARGV[0] || !#ARGV) { # if str is file, or there is no str
local $/; # slurp input
$str = <>; # use diamond operator
} else { # else just use the string
$str = shift;
}
my $count = () = $str =~ /\Q$search\E/gms;
print "Found $count of '$search' in '$str'\n";
This will allow you to use the program to count for the occurrence of a character, or a string, inside a string, a file, or standard input. For example:
count.pl needles haystack.txt
some_process | count.pl foo
count.pl x xyzzy
I am having trouble understand eval or maybe I do not understand eq vs ==.
I have this short Perl script:
[red#tools-dev1 ~]$ cat so.pl
#!/usr/local/bin/perl -w
use strict;
while(<DATA>) {
chomp;
my ($arg1, $arg2, $op ) = split /,/;
if ( $op eq '=' ) {
$op = 'eq';
}
my $cmd = "$arg1 $op $arg2";
print "[$cmd]\n";
my $rc = eval $cmd || 0;
print "rc is [$rc]\n";
}
__DATA__
cat,cat,=
When I execute it I get:
[red#tools-dev1 ~]$ ./so.pl
[cat eq cat]
rc is [0]
One would think that you'd get ...
[cat eq cat]
rc is [1]
... since "cat" equals "cat", right?
Others have pointed out the root of your problem. I am going to recommend you avoid using string eval for this purpose. Instead, you can use a lookup table:
#!/usr/bin/env perl
use strict;
use warnings;
my %ops = (
'=' => sub { $_[0] eq $_[1] },
);
while(my $test = <DATA>) {
next unless $test =~ /\S/;
$test =~ s/\s+\z//;
my ($arg1, $arg2, $op ) = split /,/, $test;
if ($ops{$op}->($arg1, $arg2)) {
print "'$arg1' $op '$arg2' is true\n";
}
}
__DATA__
cat,cat,=
You're using barewords in strict mode, which is an error:
$ perl -e 'use strict; cat eq cat'
Bareword "cat" not allowed while "strict subs" in use at -e line 1.
Bareword "cat" not allowed while "strict subs" in use at -e line 1.
Execution of -e aborted due to compilation errors.
Whenever you eval a string, you should check $# to see if there was an error.
You have barewords, not strings, so you'll have to compare them as variables.
my $cmd = qq{\$arg1 $op \$arg2};
Instead of eval, consider using functions,
my %f = (
"eq" => sub { my ($x, $y) = #_; $x eq $y },
"==" => sub { my ($x, $y) = #_; $x == $y },
# ..
);
# ..
$f{$op} or die "unknown $op";
my $rc = $f{$op}->($arg1, $arg2);
You want
my $cmd = "\$arg1 $op \$arg2";
This will assign the string
$arg1 eq $arg2
to $cmd instead of
cat eq cat
which is illegal under use strict;. Had you checked the exception eval caught ($#), you would have known this.
But why are you using eval at all?
my $rc;
if ($op eq '=') {
$rc = $arg1 == $arg2;
} else {
$rc = $arg1 eq $arg2;
}
or even
my $rc = $op eq '=' ? $arg1 == $arg2 : $arg1 eq $arg2;
If you actually have more than two ops, you might want to use use a dispatch table instead.
Hmm.. I don't really understand what you want from your script. But your eval expression is in fact expended into:
eval cat eq cat || 0;
which makes no sense at all.
If you are trying to compare whether $arg1 is the same as $arg2, why not do it directly?
$rc=0;
$rc=1 if ($arg1 eq $arg2);
Is there any advantage of returning a reference to the string instead of the string itself when using the e modifier?
For example:
use strict;
use warnings;
my $str1 = my $str2 = "aa bb cc";
$str1 =~ s/\s(bb)\s/${func1($1)}/e;
$str2 =~ s/\s(bb)\s/func2($1)/e;
sub func1 {
my ($name) = #_;
my $str = "A large string";
return \$str;
}
sub func2 {
my ($name) = #_;
my $str = "A large string";
return $str;
}
I am thinking about the case when the returned string is quite large. Will it be more efficient to use a reference?
Only benchmarking will tell, but it looks like it.
Returning a scalar usually copies it.
$ perl -MDevel::Peek -e'
sub f { my $x = 'abc'; Dump($x); $x } Dump(f());
' 2>&1 | grep -Po 'PV = \K\S*'
0x275d5f0
0x276e270
But not when :lvalue is used.
$ perl -MDevel::Peek -e'
sub f :lvalue { my $x = 'abc'; Dump($x); $x } Dump(f());
' 2>&1 | grep -Po 'PV = \K\S*'
0x220bd00
0x220bd00
5.20 introduced copy-on-write strings, so both scalars ($x and the returned one) share the same string buffer until you change one (forcing a copy then).
$ perl -MDevel::Peek -e'
sub f { my $x = 'abc'; Dump($x); $x } Dump(f());
' 2>&1 | grep -Po 'PV = \K\S*'
0xda4780
0xda4780
I am needing to obtain the algorithm used in this little bit of Perl code, but I know nothing about Perl. Usually that's not a problem since I will research the language, but this regular expression stuff is way over my head!
Could anybody pseudo-code this? I just need to know what's going on so I can implement it in something else, preferably PHP or even C++, but I'll worry about that part. I just need to somehow decipher what this is doing:
$a = $ARGV[0];
$a =~ s/[^A-F0-9]+//simg;
#b = reverse split /(\S{2})/,$a;
$c = join "", #b;
$c .= "0000";
$d = hex($c) % 999999929;
print "$d\n";
What's poorly written about it? It could use a better var names, but I don't know if that's possible (since the intermediary steps don't appear to have any nameable quality), leaving only an improper use of split. The pseudo code is almost a word for word translation.
$a = $ARGV[0];
$a =~ s/[^A-F0-9]+//simg;
#b = reverse split /(\S{2})/,$a;
$c = join "", #b;
$c .= "0000";
$d = hex($c) % 999999929;
print "$d\n";
should be
$a = $ARGV[0]; # Get a hex str from cmd line E3:C9:D4
$a =~ s/[^A-F0-9]+//simg; # Remove any non-hex digits E3C9D4
#b = reverse $a =~ /(..)/sg; # Extract "bytes"; reverse D4, C9, E3
$c = join "", #b; # Join them. D4C9E3
$c .= "0000"; # Append two NULs D4C9E30000
$d = hex($c) % 999999929; # Convert from hex to number and modulus
print "$d\n"; # Print the result (in decimal).
Slightly clearer:
$a = $ARGV[0];
$a =~ s/[^0-9A-Fa-f]+//g;
$a = join '', reverse $a =~ /(..)/sg;
$a .= "0000";
$a = hex($a);
$a %= 999999929;
print "$a\n";
There might be a bug in these snippets. On a Perl with 32-bit ints, hex will overflow if the input has more than four hex digits. A Perl with 64-bit ints will handle 12 hex digits.
You seem to have taken the code from here. It's meant to take a MAC address as input, meaning the code requires 64-bit integers or Math::BigInt to work. There's no way around it since you want to modulus a 64-bit value.
Here's a concise way to do it that only works on Perls with 64-bit integers:
my $mac = $ARGV[0];
$mac =~ s/[^0-9A-Fa-f]+//g;
die length($mac) != 12;
# "123456789ABC" => 0xBC9A785634120000
my $hash = unpack('Q<', pack('H*', "0000$mac"));
$hash %= 999999929;
print "$hash\n";
For portability, you're better off integrating Math::BigInt into the earlier version.
It's looking for a bunch octets in hex concatenated together as the first argument of the program, and applying modulus.
So, if the program is invoked as:
$ myprog.pl A0B0
then the value in $c will be B0A00000. Therefore, the value of $d should be 0x396A6C8E.
It is a particularly bad piece of code written by someone who is scared of pack and unpack.
$a = $ARGV[0]; # assign first command line arg to $a
$a =~ s/[^A-F0-9]+//simg; # delete non-hex from $a
#b = reverse split /(\S{2})/,$a; # split $a by 2 non-whitespace (saving them too) to array #b and reverse it
$c = join "", #b; # join array #b to scalar $c
$c .= "0000"; # append 4 zeros to $c
$d = hex($c) % 999999929; # get modulo
print "$d\n"; # print it
$a = $ARGV[0]; #Read in the first argument on the command line
$a =~ s/[^A-F0-9]+//simg; #Substitute non hex numbers with nothing *
#b = reverse split /(\S{2})/,$a; #What is left in $a, split by 2 non-space characters
$c = join "", #b; # put the array b into $c
$c .= "0000";
$d = hex($c) % 999999929; #Convert $c to an integer and % with 999999929
print "$d\n";
simg = i: case insensitive; g: global; m: multi-line; s: single-line;
In short, we are stripping off the first hex number, then reversing the order of bytes (2 hex numbers at a time) and doing a modulo on the result.