Is it possible to assign a signature to a variable and then reuse it in different functions/methods?
I've found my $sig = :($a, $b); but I don't know how I could use the variable as a signature in a function.
One way:
my $sig = :( $a, $b );
sub foo ( &function where { .signature ~~ $sig } ) {}
sub bar ( $p, $q ) {}
sub qux ( $waldo ) {}
foo &bar;
say "OK at line 10"; # OK at line 10
foo &qux; # Constraint type check failed ... line 12".
Related
I have a 2 text file. file1 contains IDs:
0 ABCD
3 ABDF
4 ACGFR
6 ABCD
7 GFHTRSFS
And file2:
ID001 AB ACGFR DF FD GF TYFJ ANH
ID002 DFR AG ABDF HGT MNJ POI YUI
ID003 DGT JHY ABCD YTRE NHYT PPOOI IUYNB
ID004 GFHTRSFS MJU UHY IUJ POL KUH KOOL
If the second column of file 1 matches to any entry in file 2 then the first column of file 2 should be the answer for it.
The output should be like:
0 ID003
3 ID002
4 ID001
6 ID003
7 ID004
(2nd column of file1 (ABCD) found match to 3rd row of file 2 which has ID003. So, ID003 should be the answer to it).
I have tried examples form other posts too, but somehow they are not matching to this.
Any help will be grateful.
Kind Regards
When trying to match up records from one file with records in another, the idea is to use a hash ( also known as an associative array, set of key-value pairs, or dictionaries ) to store the relationship between the first column and the rest of the columns. In effect, create the following relationships:
file1: ABCD -> 0
ABDF -> 3
ACGFR -> 4
FGHTRSS -> 6
GFHTRSFS -> 7
file2: AB -> ID001
ACGFR -> ID001
DF -> ID001
...
ANH -> ID001
DFR -> ID002
AG -> ID002
...
KUH -> ID004
KOOL -> ID004
The actual matching up of records between the files amounts to determining
if both hashes, here file1 and file2 both have keys defined for each file1 record. Here we can see that ACGFR is a key for both, therefore we can match up 4 and ID001, and so on for the rest of the keys.
In perl, we can create a hash by assigning pairs of values:
my %hash = ( foo => 1, bar => 2 );
A hash can also be created using references:
my $hash_ref = { foo => 1, bar => 2 };
Keys can be found using the keys function, and individual values can be extracted:
my $val1 = $hash{ foo }; # regular hash
my $val2 = $hash_ref->{ foo }; # hash reference
Whether a particular key is a member of a hash can be tested using the exists function.
With that background out of the way, here is one way to do this in perl:
matchup_files.pl
#!/usr/bin/env perl
use warnings;
use strict;
my $usage = "usage: $0 file1 file2\n";
my ($file1, $file2) = #ARGV;
for my $file ($file1, $file2) {
die $usage unless defined $file && -f $file; # -f checks whether $file is an actual file
}
# Create mappings col2 -> col1
# col3 -> col1
# col4 -> col1
my $h1 = inverted_hash_file_on_first_column( $file1 );
my $h2 = hash_file_on_first_column( $file2 );
# Try to find matching pairs
my $matches = {};
for my $h1_key ( keys %$h1 ) {
my $h1_val = $h1->{$h1_key};
if ( exists $h2->{ $h1_val } ) {
# We have a match!
my $num = $h1_key;
my $id = $h2->{ $h1_val };
$matches->{ $num } = $id;
}
}
# Print them out in numerical order
for my $num ( sort { $a <=> $b } keys %$matches ) {
my $id = $matches->{$num};
print join(" ", $num, $id) . "\n";
}
exit 0; # Success
sub inverted_hash_file_on_first_column {
my ($file) = #_;
return _hash_file($file, 1);
}
sub hash_file_on_first_column {
my ($file) = #_;
return _hash_file($file, 0);
}
sub _hash_file {
my ($file, $inverted) = #_;
my $fhash = {};
open my $fh, "<", $file or die "Unable to open $file : $!";
while ( my $line = <$fh> ) {
my #fields = split /\s+/, $line; # Split line on whitespace
my $key = shift #fields; # First column
for my $field ( #fields ) {
if ( $inverted ) {
die "Duplicated field '$field'" if exists $fhash->{ $key };
$fhash->{ $key } = $field;
} else {
die "Duplicated field '$field'" if exists $fhash->{ $field };
$fhash->{ $field } = $key;
}
}
}
return $fhash;
}
output
matchup_files.pl input1 input2
0 ID003
3 ID002
4 ID001
6 ID003
7 ID004
I am trying to write a function that can take all of its arguments and print them as a string exactly as they were entered.
For example using the following function:
test('arg1' => $arg1, 'arg2' => $arg2);
I would like to get the following string inside of the function formatted EXACTLY as seen below:
"'arg1' => $arg1, 'arg2' => $arg2"
I want to do this so I can print all of the arguments the same way that they were entered for debugging/testing purposes.
Perl provides special debugging hooks that let you see the raw lines of compiled source files. You can write a custom debugger that prints the original line every time a subroutine is invoked.
The following lets you specify one or more subroutines you want to match; every time a matching subroutine is invoked, the corresponding line is printed.
package Devel::ShowCalls;
our %targets;
sub import {
my $self = shift;
for (#_) {
# Prepend 'main::' for names without a package specifier
$_ = "main::$_" unless /::/;
$targets{$_} = 1;
}
}
package DB;
sub DB {
($package, $file, $line) = caller;
}
sub sub {
print ">> $file:$line: ",
${ $main::{"_<$file"} }[$line] if $Devel::ShowCalls::targets{$sub};
&$sub;
}
1;
To trace invocations of functions foo and Baz::qux in the following program:
sub foo {}
sub bar {}
sub Baz::qux {}
foo(now => time);
bar rand;
Baz::qux( qw/unicorn pony waffles/ );
Run:
$ perl -d:ShowCalls=foo,Baz::qux myscript.pl
>> myscript.pl:5: foo(now => time);
>> myscript.pl:7: Baz::qux( qw/unicorn pony waffles/ );
Note that this will only print the first line of the invocation, so it won't work for calls like
foo( bar,
baz );
I know this is probably not the best solution, but it works:
sub test {
my (undef, $file_name, $line_number) = caller;
open my $fh, '<', $file_name or die $!;
my #lines = <$fh>;
close $fh;
my $line = $lines[$line_number - 1];
trim($line);
print $line."\n";
}
sub trim {
return map { $_ =~ s/^\s+|\s+$//g } #_;
}
Now when you run this:
test(time);
You will get this as the output:
test(time);
I'm treating large blocks of all-caps text, converting them to mixed case and adding punctuation. However, there's a large set of words and names that I want to capitalize, such as days of the week, months, people, and so on.
Rather than using a giant glob of substitutions, is there a way to use an array or hash of properly capitalized terms somehow? So if I have a string "and then on monday, we should see bob and sue" to convert it to "and then on Monday, we should see Bob and Sue" if I have the terms stored in an array or hash?
Thanks!
use feature qw( fc ); # Alternatively, "lc" is "close enough".
my #to_capitalize = qw( Monday Bob Sue );
my #abbreviations = qw( USA );
my #exceptions = qw( iPhone );
my %words = (
( map { fc($_) => ucfirst(lc($_)) } #to_capitalize ),
( map { fc($_) => uc($_) } #abbreviations ),
( map { fc($_) => $_ } #exceptions ),
);
my $pat =
join '|',
#map quotemeta, # If this is needed, our use of \b is incorrect.
keys %words;
s/\b($pat)\b/$words{fc($1)}/ig;
Adjust as needed.
You could create a hash of words to transformations, then if you encounter those words apply the expected transformation:
use strict;
use warnings;
use feature qw(say);
my %transformations = (
monday => \&titlecase,
bob => \&titlecase,
sue => \&titlecase,
shout => \&uppercase,
);
while ( my $line = <$filehandle> ) {
chomp $line;
foreach my $word ( split /\s+/, $line ) {
if ( my $transform = $transformations{lc $word} ) {
$line =~ s/$word/$transform->($word)/ge;
}
}
say $line;
}
sub titlecase {
my ($s) = #_;
return ucfirst lc $s;
}
sub uppercase {
my ($s) = #_;
return uc $s;
}
Thanks for the great ideas. I ended up using the idea of a hash (for the first time!). This may not be very optimal but it gets the job done :)
%capitalize = (
"usa" => "USA",
"nfl" => "NFL",
);
$row = "I live in the usa and love me some nfl.";
foreach my $key (keys %capitalize) {
if ($row =~ $key) {
$row =~ s/$key/$capitalize{$key}/g;
}
}
print $row;
in my code, I have a function which verifies if a cell from an worksheet contains valid values, meaning:
1. it contains something.
2. the contained value is not SPACE, TAB or ENTER.
when i am just checking the function within a print (to print the value returned by the function for a single cell), apparently, everything works fine.
when I am integrating the "print of the result" into a while loop, for checking a range of cells, it received the error message: Can't call method "value" on an undefined value at D:\test.pl
here is my code:
use strict;
use Spreadsheet::ParseXLSX;
my $parser = Spreadsheet::ParseXLSX->new();
sub check_cell($) {
my ( $worksheet, $a, $b ) = #_;
if ( $worksheet->get_cell( $a, $b )
or not ord( $worksheet->get_cell( $a, $b )->value() ) ~~ [ 32, 9, 10 ] )
{
return 1;
} else {
return 0;
}
}
my $workbook = $parser->parse('D:\test.pl data.xlsx');
if ( !defined $workbook ) {
die $parser->error(), ".\n";
}
my $worksheet = $workbook->worksheet(0);
my $i = 8;
while ( &check_cell( $worksheet, $i, 0 ) ) {
print &check_cell( $worksheet, $i, 0 ), "\n";
$i++;
}
if I remove the while and index increment, everything works fine.
Can anyone tell me why the error occurs in 1st case?
Thank you.
When you compare two strings for equallity, you have to use eq, not ==
while( check_cell($worksheet, $i, 0) eq "correct cell" ) {
#...
};
Also, it's more natural to return 0 or 1 in your check_cell sub, so you haven't to test the result in while loop:
sub check_cell {
# return 1 if it's ok, else 0
}
while( check_cell($worksheet, $i, 0) ) {
#...
};
And the smartmatch operator ~~ has been marked as experimental since Perl 5.18.0
When $worksheet->get_cell($a, $b) doesn't return a defined value, you can't call ->value on the undefined value it returned. Don't you want to use and instead of or in the condition?
in this case, it worked modifying the condition:
instead of this:
if ( $worksheet->get_cell( $a, $b )
or not ord( $worksheet->get_cell( $a, $b )->value() ) ~~ [ 32, 9, 10 ] )
{
return 1;
}
I used:
if ( $worksheet -> get_cell($a, $b) ) {
if ( not ord($worksheet -> get_cell($a, $b) -> value()) ~~ [32, 9, 10] ){
return 1;
}
}
and the scrit exits without any error.
Thank you guys for your help.
I am running a string equality check like this:
if($myString eq "ExampleString")
Is there a value that myString could have which would cause execution to enter the if structure no matter what the string literal is?
Yes, with objects and overloaded operators:
package AlwaysTrue {
use overload 'eq' => sub { 1 },
'""' => sub { ${+shift} };
sub new {
my ($class, $val) = #_;
bless \$val => $class;
}
}
my $foo = AlwaysTrue->new("foo");
say "foo is =$foo=";
say "foo eq bar" if $foo eq "bar";
Output:
foo is =foo=
foo eq bar
However, "$foo" eq "bar" is false, as this compares the underlying string.
If you mean "any string other than undef", then simply check
if (defined $myString)
If you mean "any string other than undef or empty string", then simply check
if ($myString) # Has a slight bug - will NOT enter if the number 0 passed
#or
if ($myString || $myString == 0) # Avoids the above bug
If you mean ANY ANY string, you don't need an if.... but if you want one anyway:
if (1)
If you mean "any string that isn't looking like a number" (e.g. distinguish "11" from "11a"):
use Scalar::Util qw(looks_like_number);
if (Scalar::Util::looks_like_number($myString))