Here is my code:
my $self = shift;
my $h = shift;
print "$h\n";
my #headers = split /,/, $h;
foreach my $el (#{$expected}) {
my $t = shift #headers;
chomp ($t);
chomp ($el);
print Dumper($el cmp $t, $el, $t);
print "test: \'$el\' eq \'$t\' ";
unless ($el eq $t) {
print "not ok $el ne $t\n";
return 0;
} else {
print "ok\n";
}
}
return 1;
In my first unit test I pass a string to $h which matches $expected.
I then have a unit test which ensure the function fails when passed a string that does not match. These two tests behave as expected.
Server,Jira Project,Issue Type,Summary,Description,Assignee,Labels,Epic Link
$VAR1 = 0;
$VAR2 = 'Server';
$VAR3 = 'Server';
test: 'Server' eq 'Server' ok
When I pull the line in from a CSV file and pass it to this function I get a different response.
Server,Jira Project,Issue Type,Summary,Description,Assignee,Labels,Epic Link
$VAR1 = -1;
$VAR2 = 'Server';
$VAR3 = 'Server';
test: 'Server' eq 'Server' not ok Server ne Server
The compare somehow implies that the expected value is somehow less than what is being tested. My mind immediately goes to there must be a leading or trailing character on what is being tested. However, printing and Dumping doesn't seem to confirm that (unless I'm missing something). The chomps are just out of sheer desperation.
What am I missing?
First off thanks #hobbs for the $Data::Dumper::Useqq = 1; suggestion. It was immediately obvious that there were some leading characters that I didn't know how to detect.
$VAR1 = -1;
$VAR2 = "Server";
$VAR3 = "\357\273\277Server";
The CSV file I am reading contained Byte Ordermarking information.
I'll strip them off. Thanks all for getting me going again.
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;
What does ".=" mean in Perl (dot-equals)? Example code below (in the while clause):
if( my $file = shift #ARGV ) {
$parser->parse( Source => {SystemId => $file} );
} else {
my $input = "";
while( <STDIN> ) { $input .= $_; }
$parser->parse( Source => {String => $input} );
}
exit;
Thanks for any insight.
The period . is the concatenation operator. The equal sign to the right means that this is an assignment operator, like in C.
For example:
$input .= $_;
Does the same as
$input = $input . $_;
However, there's also some perl magic in this, for example this removes the need to initialize a variable to avoid "uninitialized" warnings. Try the difference:
perl -we 'my $x; $x = $x + 1' # Use of uninitialized value in addition ...
perl -we 'my $x; $x += 1' # no warning
This means that the line in your code:
my $input = "";
Is quite redundant. Albeit some people might find it comforting.
For pretty much any binary operator X, $a X= $b is equivalent to $a = $a X $b. The dot . is a string concatenation operator; thus, $a .= $b means "stick $b at the end of $a".
In your code, you start with an empty $input, then repeatedly read a line and append it to $input until there's no lines left. You should end up with the entire file as the contents of $input, one line at a time.
It should be equivalent to the loopless
local $/;
$input = <STDIN>;
(define line separator as a non-defined character, then read until the "end of line" that never comes).
EDIT: Changed according to TLP's comment.
You have found the string concatenation operator.
Let's try it :
my $string = "foo";
$string .= "bar";
print $string;
foobar
This performs concatenation to the $input var. Whatever is coming in via STDIN is being assigned to $input.
I'm writting a small server with perl. There is some small problem. When the client give me a sentence like this "op:xxx:xxx:xxx", I'll get op. then do things depending on what op is. It works will if the op is adduser and so on. (I use if $op eq "adduser"...)
But when I get a "getList:xxx:xxx" and I have get the $op = getList, it can't pass it like "if $op eq "getList"". I know, it must be my mistake. But I just can't find it.
thank you for everyone.
use warnings;
use strict;
package MyPackage;
use base qw(Net::Server);
our %data_base;
our %tag_base;
sub list {
my %resault;
foreach ( keys %tag_base) {
print STDERR $_ . "1";
my #tags = split /:/, $tag_base{$_};
foreach ( #tags) {
$resault{$_} ++;
}
}
my #tags;
foreach ( keys %resault) {
push #tags, "$_,$resault{$_}";
}
$_ = join ";", #tags;
print ;
print STDERR ;
}
sub users {
my $topic = shift;
my #users;
foreach ( keys %tag_base) {
push #users, $_ if $tag_base{$_} =~ /$topic/;
}
$_ = join ";", #users;
print ;
}
sub process_request {
my $self = shift;
my $person;
my #info;
while (<STDIN>) {
my #gets = split /:/, $_;
print STDERR "#gets\n";
# $data_base{shift #person} = join ":", #person;
my $op = shift #gets;
$op =~ s/\s//;
print STDERR $op . "\n";
if ( $op eq "adduser") {
my $user_name = shift #gets;
if ( exists $data_base{$user_name}) {
print "already_exist";
} else {
$data_base{$user_name} = join ":", #gets;
print "addUserSu";
}
} elsif ( $op eq "login") {
my $login_name = shift #gets;
my $login_pw = shift #gets;
if ( defined $data_base{$login_name}) {
$person = $data_base{$login_name};
#info = split /:/, $person;
$info[0] =~ s/\s+//;
if ($login_pw eq $info[0]) {
print "$person";
} else {
print "/$info[0]/";
}
} else {
print "unexist_user";
}
} elsif ( $op eq "addTag") {
my $tag_user = shift #gets;
$tag_base{$tag_user} = join ":", #gets;
print "addTagSu";
} elsif ( $op eq "getList") {
print STDERR "right";
&list;
} elsif ( $op eq "getUsers") {
&users;
}
}
}
MyPackage->run(port => 13800);
I can see two (simple) reasons this might fail:
$op =~ s/\s//;
You only remove one whitespace: The first one. If your intention is to strip all whitespace, you'd want s/\s+//g.
And second:
Random capital letters in strings, variable names and commands is Evil. eq is case sensitive, so if $op is "getlist", then if ($op eq "getList") will be false. Unless capitalization is important to you, you could do if (lc($op) eq "getlist").
Without sample input, expected output and actual output, this is however nothing more than guesswork.
Also, as a debug statement, this is useless:
print STDERR $op . "\n";
That is easily confused and overlooked. For example, if $op is empty, it just produces a blank line in your error log. Use:
print STDERR "OP is: '$op'\n";
Now you will be able to identify the line where $op should appear, and you will be more easily see whitespace surrounding it.
You are reading strings without chomping them.
i.e.
When you run your code :
addtag:fred:barney
The input is stored as fred => "barney\n"
when you getList, the output is :
barney
,1;
I suspect the client is expecting 1 line of output that reads :
barney,1;
So, just add a chomp in your code here :
while (<STDIN>) {
chomp;
my #gets = split /:/, $_;
There's a bunch out there, as Perl is a pretty sugary language, but the most used statements in any language is the combination of if statements and setting values. I think I've found many of them, but there's still a few gaps. Ultimately, the goal would be to not have to write a variable name more than once:
Here's what I have so far:
$r ||= $s; # $r = $s unless ($r);
$r //= $s; # $r = $s unless (defined $r);
$r &&= $s; # $r = $s if ($r);
$r = $c ? $s : $t; # if ($c) { $r = $s } else { $r = $t }
$c ? $r : $s = $t; # if ($c) { $r = $t } else { $s = $t }
$r = $s || $t; # if ($s) { $r = $s } else { $r = $t }
$r = $s && $t; # if ($s) { $r = $t } else { $r = $s = undef, 0, untrue, etc. }
$c and return $r; # return $r if ($c);
$c or return $r; # return $r unless ($c);
$c and $r = $s; # $r = $s if ($c);
#$r{qw(a b c d)} # ($r->{a}, $r->{b}, $r->{c}, $r->{d})
Somebody also had a really interesting article on a "secret operator", shown here:
my #part = (
'http://example.net/app',
( 'admin' ) x!! $is_admin_link,
( $subsite ) x!! defined $subsite,
$mode,
( $id ) x!! defined $id,
( $submode ) x!! defined $submode,
);
However, what I've found to be missing from the list is:
$r <= $s; # read as "$r = min($r, $s);" except with short-circuiting
$r = $s if (defined $s); # what's the opposite of //?
$r and return $r # can that be done without repeating $r?
Is there anything else worth adding? What other conditional set variables are available to reduce the code? What else is missing?
These structures from your question could be written a little bit more clearly using the low precedence and and or keywords:
$c and return $r; # return $r if ($c);
$c or return $r; # return $r unless ($c);
$c and $r = $s; # $r = $s if ($c);
The nice thing about and and or is that unlike the statement modifier control words, and and or can be chained into compound expressions.
Another useful tool for syntactic sugar is using the for/foreach loop as a topicalizer over a single value. Consider the following:
$var = $new_value if defined $new_value;
vs
defined and $var = $_ for $new_value;
or things like:
$foo = "[$foo]";
$bar = "[$bar]";
$_ = "[$_]" for $foo, $bar;
the map function can also be used in this manner, and has a return value you can use.
There's also the left hand side ternary operator:
$cond ? $var1 : $var2 = "the value";
is equivalent to:
if ($cond) {
$var1 = "the value";
} else {
$var2 = "the value";
}
$r = $r < $s ? $r : $s;:
$r = $s if $r > $s;
or
use List::Util qw( min );
$r = min($r, $s);
or:
sub min_inplace {
my $min_ref = \shift;
for (#_) { $$min_ref = $_ if $$min_ref > $_; }
}
min_inplace($r, $s);
$r = $s if (defined $s);:
$r = $s // $r;
$r = $t; $r = $s if (defined $s);:
$r = $s // $t;
$r = !$s ? $s : $t;:
$r = $s && $t;
One of the biggest called for features in Perl was the switch statement. This finally appeared in Perl 5.10. I'm just using the example from the documentation:
use feature qw(say switch); #My preference
#use feature ":5.10"; #This does both "say" and "switch"
[...]
given($foo) {
when (undef) {
say '$foo is undefined';
}
when ("foo") {
say '$foo is the string "foo"';
}
when ([1,3,5,7,9]) {
say '$foo is an odd digit';
continue; # Fall through
}
when ($_ < 100) {
say '$foo is numerically less than 100';
}
when (\&complicated_check) {
say 'a complicated check for $foo is true';
}
default {
die q(I don't know what to do with $foo);
}
}
Why o' why did they go with given/when and not switch/case like you find in most languages is a mystery to me. And, why if the statement is given/when, do you specify it in use features as switch?
Alas, the people who made these decisions are at a higher plane than I am, so I have no right to even question these luminaries.
I avoid the more exotic stuff, and stick with the easiest to understand syntax. Imagine the person who has to go through your code and find a bug of add a feature, which would be easier for that person to understand:
$r &&= $s;
or
if ($r) {
$r = $s;
}
And, maybe I might realize that I really meant:
if (not defined $r) {
$r = $s;
}
And, in this case, I might even say:
$r = $s if not defined $r;
Although I don't usually like post-fixed if statements because people tend to miss the if part when glancing through the code.
Perl is compiled at runtime, and the compiler is fairly efficient. So, even though it's way cooler to write $r &&= $s and it earns it earns you more geek points and is less to type, it doesn't execute any faster. The biggest amount of time spent on code is on maintaining it, so I'd rather skip the fancy stuff and go for readability.
By the way, when I think of syntactic sugar, I think of things added to the language to improve readability. A great example is the -> operator:
${${${$employee_ref}[0]}{phone}}[0];
vs.
$employee_ref->[0]->{phone}->[0];
Of course, if you're storing data as a reference to a list to a hash to a list, you are probably better off using object oriented coding.
There's also:
$hash{$key||'foo'} = 1; # if($key) { $hash{$key} = 1 } else { $hash{'foo'} = 1 }
I have a hash of lists that is not getting populated.
I checked that the block at the end that adds to the hash is in fact being called on input. It should either add a singleton list if the key doesn't exist, or else push to the back of the list (referenced under the right key) if it does.
I understand that the GOTO is ugly, but I've commented it out and it has no effect.
The problem is that when printhits is called, nothing is printed, as if there are no values in the hash. I also tried each (%genomehits), no dice.
THANKS!
#!/usr/bin/perl
use strict;
use warnings;
my $len = 11; # resolution of the peaks
#$ARGV[0] is input file
#$ARGV[1] is call number
# optional -s = spread number from call
# optional -o specify output file name
my $usage = "see arguments";
my $input = shift #ARGV or die $usage;
my $call = shift #ARGV or die $usage;
my $therest = join(" ",#ARGV) . " ";
print "the rest".$therest."\n";
my $spread = 1;
my $output = $input . ".out";
if ($therest =~ /-s\s+(\d+)\s/) {$spread = $1;}
if ($therest =~ /-o\s+(.+)\s/) {$output = $1;}
# initialize master hash
my %genomehits = ();
foreach (split ';', $input) {
my $mygenename = "err_naming";
if ($_ =~ /^(.+)-/) {$mygenename = $1;}
open (INPUT, $_);
my #wiggle = <INPUT>;
&singlegene(\%genomehits, \#wiggle, $mygenename);
close (INPUT);
}
&printhits;
#print %genomehits;
sub printhits {
foreach my $key (%genomehits) {
print "key: $key , values: ";
foreach (#{$genomehits{$key}}) {
print $_ . ";";
}
print "\n";
}
}
sub singlegene {
# let %hash be the mapping hash
# let #mygene be the gene to currently process
# let $mygenename be the name of the gene to currently process
my (%hash) = %{$_[0]};
my (#mygene) = #{$_[1]};
my $mygenename = $_[2];
my $chromosome;
my $leftbound = -2;
my $rightbound = -2;
foreach (#mygene) {
#print "Doing line ". $_ . "\n";
if ($_ =~ "track" or $_ =~ "output" or $_ =~ "#") {next;}
if ($_ =~ "Step") {
if ($_ =~ /chrom=(.+)\s/) {$chromosome = $1;}
if ($_ =~ /span=(\d+)/) {$1 == 1 or die ("don't support span not equal to one, see wig spec")};
$leftbound = -2;
$rightbound = -2;
next;
}
my #line = split /\t/, $_;
my $pos = $line[0];
my $val = $line[-1];
# above threshold for a call
if ($val >= $call) {
# start of range
if ($rightbound != ($pos - 1)) {
$leftbound = $pos;
$rightbound = $pos;
}
# middle of range, increment rightbound
else {
$rightbound = $pos;
}
if (\$_ =~ $mygene[-1]) {goto FORTHELASTONE;}
}
# else reinitialize: not a call
else {
FORTHELASTONE:
# typical case, in an ocean of OFFs
if ($rightbound != ($pos-1)) {
$leftbound = $pos;
}
else {
# register the range
my $range = $rightbound - $leftbound;
for ($spread) {
$leftbound -= $len;
$rightbound += $len;
}
#print $range . "\n";
foreach ($leftbound .. $rightbound) {
my $key = "$chromosome:$_";
if (not defined $hash{$key}) {
$hash{$key} = [$mygenename];
}
else { push #{$hash{$key}}, $mygenename; }
}
}
}
}
}
You are passing a reference to %genomehits to the function singlegene, and then copying it into a new hash when you do my (%hash) = %{$_[0]};. You then add values to %hash which goes away at the end of the function.
To fix it, use the reference directly with arrow notation. E.g.
my $hash = $_[0];
...
$hash->{$key} = yadda yadda;
I think it's this line:
my (%hash) = %{$_[0]};
You're passing in a reference, but this statement is making a copy of your hash. All additions you make in singlegene are then lost when you return.
Leave it as a hash reference and it should work.
PS - Data::Dumper is your friend when large data structures are not behaving as expected. I'd sprinkle a few of these in your code...
use Data::Dumper; print Dumper \%genomehash;