Perl crypt() acting weird - perl

I'm using the function below to create a hash for a one-time download link (Originally from perlmonks). The weird thing is I always get the same hash result.
I've been RTFMing. I made sure that the crypt() function gets the last 8 characters of $exp, and also verified the $exp indeed changes. I've also tried manually feeding the crypt() function with random values, only those worked out fine and the hash result changed.
What am I missing here?
use strict;
use CGI;
sub chash {
my $exp = $_;
my $key = 'abcd1234'; //not actual key
my $hash = crypt(substr($exp,-8,8),$key);
$hash = substr($hash, 2);
$hash =~ s/[^a-zA-Z0-9]//g; $hash = uc($hash);
return $hash;
}
my $exp = time() + 60;
my $hash = chash($exp);
my $download_url="http://script.pl?$exp-$hash";

You want to pull the first item off #_ instead of trying to read $_ in your sub.
my $exp = shift;
or
my ($exp) = #_;
or
my $exp = $_[0];
From perlsub:
Any arguments passed in show up in the array #_ . Therefore, if you called a function with two arguments, those would be stored in $_[0] and $_[1] . The array #_ is a local array, but its elements are aliases for the actual scalar parameters.

Parameters to a sub will be passed in #_ not in $_.
use strict;
use warnings ;
use CGI;
sub chash {
my ( $exp ) = #_;
my $key = 'abcd1234'; # not actual key
my $hash = crypt(substr($exp,-8,8),$key);
$hash = substr($hash, 2);
$hash =~ s/[^a-zA-Z0-9]//g;
$hash = uc($hash);
return $hash;
}
my $exp = time() + 60;
my $hash = chash($exp);
my $download_url="http://script.pl?$exp-$hash";
Using use warnings; would have hinted you to this mistake.

Related

Variable Scope outside foreach loop Perl

Here is the problem:
Generating 10 iterations of 50 iterations and accessing the 50 character string outside the inner foreach loop.
I have tried putting the 50x iteration inside a sub function and calling it, but that was unsuccessful.
Thus far, I only get a single character outside the foreach loop whether it's in a sub function or not. I'm fairly certain this is a scope issue that I'm failing to see.
So, code:
#!/usr/bin/perl
use strict;
use warnings;
my #dna = ('A','G','T','C');
my $i;
my $str;
for ($i=1; $i<11; $i++){
#print $i . " ";
foreach(1..50){
my $nt = int(rand $#dna + 1);
$str = $dna[$nt];
#correct here all 50 nts
print $str;
}
#single nt here
#print $str;
print "\n";
}
Output: Corerct, but I need to access $str as is below but outside the foreach loop and within the first for loop.
TGATTAGCGTCCGCGCGTATTGTATTAAGCCACAGAATGTAATGCCAAGA
GCTATAGGAAGACGCCGATCCCTGGACCGGCACAGGCACGGTAACAGCAG
TTGTTGTAGGATCCCAGGGAGCGAAGCACGTGAACTGCGACTAATTTCAA
TAACCAGGCAACACTAAACAGCTCCCATGTGTAAGGACGTATAGGCAGTT
GTAATTGTAGATCACAAAATTTACACGGTATAGCATTAACTGGAACCTGC
AACAGTGCCGTTTATTAATCTCCTCTAGTGTAGGGACGAATCGACCACGG
CGTGAGCAAGCACAAATATCCTTTAGGGGTGTGCTTAAAACACCCAGTAG
GAGTTCATAGGCCAACAATATGGCAAAGCCTTGCCCCATCAAATTCGGCG
TTGCGTCTGCGAACACTGTTGGTGTGCCTTTAGTGCGGGTTACTCGAGAA
CGCGATCTCCGTTTATAACGCTAGCAAACTACTACGGACCGAGGCATCGC
I removed the extra space in the string. It was superfluous.
This was another attempt at getting to the variable to no avail:
use strict;
use warnings;
my $str;
my #dna = ('A','G','T','C');
for (my $i=1; $i<11; $i++){
fifty();
print $str;
}
sub fifty {
foreach (1 .. 50){
my $nt = int(rand $#dna + 1);
$str = $dna[$nt];
return $str;
}
}
for (my $i=1; $i<11; $i++){
fifty();
Infiftyyou return something but you discard ist, as you do no assignement like $str= fifty();
print $str;
}
And here you print something that has no value yet as it seems - in fact you assign a value in fifty- but you shouldn't use global variables.
sub fifty {
foreach (1 .. 50){
my $nt = int(rand $#dna + 1);
$str = $dna[$nt];
Here you discard whatever is in $str and assign one letter instead. Also you assign to a global variable - which you should avoid.
return $str;
}
}
And here you directly leave fifty and return just the one character - which you (see above) discard.
I found this to work perfectly: Turns out to be scope as far as I could tell and not sure why I was stuck. Regardless, moving on now.
#!/usr/bin/perl
use strict;
use warnings;
my #dna = ('A','G','T','C');
my $i;
my $str;
for ($i=1; $i<11; $i++){
my $filename = "seq_" . $i;
open(my $OUT, '>', $filename) or die("Can't open $filename($!)");
foreach(1..50){
my $nt = int(rand $#dna + 1);
$str = $dna[$nt];
print $OUT $str;
}
close $filename;
}

Perl unexpected result

Imagine I have this Perl script
my $name = " foo ";
my $sn = " foosu";
trim($name, \$sn);
print "name: [$name]\n";
print "sn: [$sn]\n";
exit 0;
sub trim{
my $fref_trim = sub{
my ($ref_input) = #_;
${$ref_input} =~ s/^\s+// ;
${$ref_input} =~ s/\s+$// ;
};
foreach my $input (#_){
if (ref($input) eq "SCALAR"){
$fref_trim->($input);
} else {
$fref_trim->(\$input);
}
}
}
Result:
name: [foo]
sn: [foosu]
I would expect $name to be "[ foo ]" when printing the value after calling trim, but the sub is setting $name as I would want it. Why is this working, when it really shouldn't?
I'm not passing $name by reference and the trim sub is not returning anything. I'd expect the trim sub to create a copy of the $name value, process the copy, but then the original $name would still have the leading and trailing white spaces when printed in the main code.
I assume it is because of the alias with #_, but shouldn't the foreach my $input (#_) force the sub to copy the value and only treat the value not the alias?
I know I can simplify this sub and I used it only as an example.
Elements of #_ are aliases to the original variables. What you are observing is the difference between:
sub ltrim {
$_[0] =~ s/^\s+//;
return $_[0];
}
and
sub ltrim {
my ($s) = #_;
$s =~ s/^\s+//;
return $s;
}
Compare your code to:
#!/usr/bin/env perl
my $name = " foo ";
my $sn = " foosu";
trim($name, \$sn);
print "name: [$name]\n";
print "sn: [$sn]\n";
sub trim {
my #args = #_;
my $fref_trim = sub{
my ($ref_input) = #_;
${$ref_input} =~ s/^\s+//;
${$ref_input} =~ s/\s+\z//;
};
for my $input (#args) {
if (ref($input) eq "SCALAR") {
$fref_trim->($input);
}
else {
$fref_trim->(\$input);
}
}
}
Output:
$ ./zz.pl
name: [ foo ]
sn: [foosu]
Note also that the loop variable in for my $input ( #array ) does not create a new copy for each element of the array. See perldoc perlsyn:
The foreach loop iterates over a normal list value and sets the scalar variable VAR to be each element of the list in turn. ...
...
the foreach loop index variable is an implicit alias for each item in the list that you're looping over.
In your case, this would mean that, at each iteration $input is an alias to the corresponding element of #_ which itself is an alias to the variable that was passed in as an argument to the subroutine.
Making a copy of #_ thus prevents the variables in the calling context from being modified. Of course, you could do something like:
sub trim {
my $fref_trim = sub{
my ($ref_input) = #_;
${$ref_input} =~ s/^\s+//;
${$ref_input} =~ s/\s+\z//;
};
for my $input (#_) {
my $input_copy = $input;
if (ref($input_copy) eq "SCALAR") {
$fref_trim->($input_copy);
}
else {
$fref_trim->(\$input_copy);
}
}
}
but I find making a wholesale copy of #_ once to be clearer and more efficient assuming you do not want to be selective.
I assume it is because of the alias with #_, but shouldn't the foreach my $input (#_) force the sub to copy the value and only treat the value not the alias?
You're right that #_ contains aliases. The part that's missing is that foreach also aliases the loop variable to the current list element. Quoting perldoc perlsyn:
If any element of LIST is an lvalue, you can modify it by modifying VAR inside the loop. Conversely, if any element of LIST is NOT an lvalue, any attempt to modify that element will fail. In other words, the foreach loop index variable is an implicit alias for each item in the list that you're looping over.
So ultimately $input is an alias for $_[0], which is an alias for $name, which is why you see the changes appearing in $name.

Perl: Change in Subroutine not printing outside of routine

So I want to change numbers that I pass into a subroutine, and then retain those numbers being changed, but it doesn't seem to work.
my $A = 0;
my $T = 0;
my $C = 0;
my $G = 0;
foreach my $bases in (keys %basereads){
count ($bases, $A, $T, $C, $G);
}
Here is my subroutine
sub count {
my $bases = shift;
my $A = shift;
my $T = shift;
my $C = shift;
my $G = shift;
for (my $i = 0; $i < length($bases); $i++){
print "$bases\t";
if (uc(substr($bases,$i,1)) eq 'A'){
$A++;
}elsif (uc(substr($bases,$i,1)) eq 'T'){
$T++;
} elsif (uc(substr($bases,$i,1)) eq 'G'){
$G++;
} elsif (uc(substr($bases,$i,1)) eq 'C'){
$C++;
} else { next; }
}
print "$A\t$C\t$T\t$G\n";
return my($bases, $A, $T, $C, $G);
}
after the subroutine, I want to stored the altered A, C, T, G into a hashmap. When I print bases and ATCG inside the subroutine, it prints, so I know the computer is running through the subroutine, but it's not saving it, and when I try to manipulate it outside the subroutine (after I've called it), it starts from zero (what I had defined the four bases as before). I'm new to Perl, so I'm a little weary of subroutines.
Could someone help?
Always include use strict; and use warnings; at the top of EVERY script.
With warnings enabled, you should've gotten the following messages:
"my" variable $bases masks earlier declaration in same scope at script.pl line ...
"my" variable $A masks earlier declaration in same scope at script.pl line ...
"my" variable $T masks earlier declaration in same scope at script.pl line ...
"my" variable $C masks earlier declaration in same scope at script.pl line ...
"my" variable $G masks earlier declaration in same scope at script.pl line ...
These are caused by the my before your return statement:
return my($bases, $A, $T, $C, $G);
Correct this by simply removing the my:
return ($bases, $A, $T, $C, $G);
And then you just need to capture your returned values
($bases, $A, $T, $C, $G) = count($bases, $A, $T, $C, $G);
Given that you're new to perl, I'm sure you won't be surprised that your code could be cleaned up further though. If one uses a hash, it makes it a lot easier to count various characters in a string, as demonstrated below:
use strict;
use warnings;
my $A = 0;
my $T = 0;
my $C = 0;
my $G = 0;
foreach my $bases (keys %basereads) {
my %counts;
for my $char (split //, $bases) {
$counts{$char}++;
}
$A += $counts{A};
$T += $counts{T};
$C += $counts{C};
$G += $counts{G};
}

"Odd number of elements in hash assignment" - simple example code included, why does it happen?

Basically when I shift a hash to work with it in a subroutine I get the error: Odd number of elements in hash assignment. Am I supposed to use a hash reference instead if I wish to pass hashes to subroutines?
#!/usr/bin/perl -w
use strict;
my ($a, $b, $c, %hash) = &getVals() ;
&run($a,$b,$c,%hash) ;
sub getVals() {
$hash{"f"} = "abc" ;
$a = "A" ;
$b = "B" ;
$c = "C" ;
return ($a, $b, $c, %hash) ;
}
sub run() {
my $a = shift;
my $b = shift;
my $c = shift;
my %hash = shift; #error here
#do stuff here. . .
}
shift removes the first element from #_ and returns it. You can either use the reference, or just assign the whole list (after shifting the single elements) to the hash:
my %hash = #_;
It's impossible to pass hashes to subroutines. Subroutines can take a list of scalars as arguments. (It's also the only thing they can return.)
getVals returns 5 scalars:
A
B
C
f
abc
shift returns the first scalar in #_ after removing it. You want to assign all the remaining scalars in #_ (f and abc) to the hash, not just the first one.
sub run {
my $a = shift;
my $b = shift;
my $c = shift;
my %hash = #_;
...
}
or
sub run {
my ($a, $b, $c, %hash) = #_;
...
}
try this
#!/usr/bin/perl -w
use strict;
my ($a, $b, $c, %hash) = &getVals() ;
&run($a,$b,$c,%hash) ;
sub getVals() {
$hash{"f"} = "abc" ;
$a = "A" ;
$b = "B" ;
$c = "C" ;
return ($a, $b, $c, %hash) ;
}
sub run() {
my $a = shift;
my $b = shift;
my $c = shift;
my %hash = #_;
#.............
}

help understanding perl hash

Perl newbie here...I had help with this working perl script with some HASH code and I just need help understanding that code and if it could be written in a way that I would understand the use of HASHES more easily or visually??
In summary the script does a regex to filter on date and the rest of the regex will pull data related to that date.
use strict;
use warnings;
use constant debug => 0;
my $mon = 'Jul';
my $day = 28;
my $year = 2010;
my %items = ();
while (my $line = <>)
{
chomp $line;
print "Line: $line\n" if debug;
if ($line =~ m/(.* $mon $day) \d{2}:\d{2}:\d{2} $year: ([a-zA-Z0-9._]*):.*/)
{
print "### Scan\n" if debug;
my $date = $1;
my $set = $2;
print "$date ($set): " if debug;
$items{$set}->{'a-logdate'} = $date;
$items{$set}->{'a-dataset'} = $set;
if ($line =~ m/(ERROR|backup-date|backup-size|backup-time|backup-status)[:=](.+)/)
{
my $key = $1;
my $val = $2;
$items{$set}->{$key} = $val;
print "$key=$val\n" if debug;
}
}
}
print "### Verify\n";
for my $set (sort keys %items)
{
print "Set: $set\n";
my %info = %{$items{$set}};
for my $key (sort keys %info)
{
printf "%s=%s;", $key, $info{$key};
}
print "\n";
}
What I am trying to understand is these lines:
$items{$set}->{'a-logdate'} = $date;
$items{$set}->{'a-dataset'} = $set;
And again couple lines down:
$items{$set}->{$key} = $val;
Is this an example of hash reference? hash of hashes?
I guess i'm confused with the use of {$set} :-(
%items is a hash of hash references (conceptually, a hash of hashes). $set is the key into %items and then you get back another hash, which is being added to with keys 'a-logdate' and 'a-dataset'.
(corrected based on comments)
Lou Franco's answer is close, with one minor typographical error—the hash of hash references is %items, not $items. It is referred to as $items{key} when you are retrieving a value from %items because the value you are retrieving is a scalar (in this case, a hash reference), but $items would be a different variable.