Perl: Can't pass an "on-the-fly" array to a sub - perl

strftime(), as per cpan.org:
print strftime($template, #lt);
I just can't figure the right Perl code recipe for this one. It keeps reporting an error where I call strftime():
...
use Date::Format;
...
sub parse_date {
if ($_[0]) {
$_[0] =~ /(\d{4})/;
my $y = $1;
$_[0] =~ s/\d{4}//;
$_[0] =~ /(\d\d)\D(\d\d)/;
return [$2,$1,$y];
}
return [7,7,2010];
}
foreach my $groupnode ($groupnodes->get_nodelist) {
my $groupname = $xp->find('name/text()', $groupnode);
my $entrynodes = $xp->find('entry', $groupnode);
for my $entrynode ($entrynodes->get_nodelist) {
...
my $date_added = parse_date($xp->find('date_added/text()', $entrynode));
...
$groups{$groupname}{$entryname} = {...,'date_added'=>$date_added,...};
...
}
}
...
my $imday = $maxmonth <= 12 ? 0 : 1;
...
while (my ($groupname, $entries) = each %groups) {
...
while (my ($entryname, $details) = each %$entries) {
...
my $d = #{$details->{'date_added'}};
$writer->dataElement("creation", strftime($date_template, (0,0,12,#$d[0^$imday],#$d[1^$imday]-1,#$d[2],0,0,0)));
}
...
}
...
If I use () to pass the required array by strftime(), I get:
Type of arg 2 to Date::Format::strftime must be array (not list) at ./blah.pl line 87, near "))"
If I use [] to pass the required array, I get:
Type of arg 2 to Date::Format::strftime must be array (not anonymous list ([])) at ./blah.pl line 87, near "])"
How can I pass an array on the fly to a sub in Perl? This can easily be done with PHP, Python, JS, etc. But I just can't figure it with Perl.
EDIT: I reduced the code to these few lines, and I still got the exact same problem:
#!/usr/bin/perl
use warnings;
use strict;
use Date::Format;
my #d = [7,13,2010];
my $imday = 1;
print strftime( q"%Y-%m-%dT12:00:00", (0,0,12,$d[0^$imday],$d[1^$imday]-1,$d[2],0,0,0));

Where an array is required and you have an ad hoc list, you need to actually create an array. It doesn't need to be a separate variable, you can do just:
strftime(
$date_template,
#{ [0,0,12,$d[0^$imday],$d[1^$imday],$d[2],0,0,0] }
);
I have no clue why Date::Format would subject you to this hideousness and not just expect multiple scalar parameters; seems senseless (and contrary to how other modules implement strftime). Graham Barr usually designs better interfaces than this. Maybe it dates from when prototypes still seemed like a cool idea for general purposes.

To use a list as an anonymous array for, say, string interpolation, you could write
print "#{[1, 2, 3]}\n";
to get
1 2 3
The same technique provides a workaround to Date::Format::strftime's funky prototype:
print strftime(q"%Y-%m-%dT12:00:00",
#{[0,0,12,$d[0^$imday],$d[1^$imday]-1,$d[2],0,0,0]});
Output:
1900-24709920-00T12:00:00

Normally, it is easy to pass arrays "on-the-fly" to Perl subroutines. But Date::Format::strftime is a special case with a special prototype ($\#;$) that doesn't allow "list" arguments or "list assignment" arguments:
strftime($format, (0,0,12,13,7-1,2010-1900)); # not ok
strftime($format, #a=(0,0,12,13,7-1,2010-1900)); # not ok
The workaround is that you must call strftime with an array variable.
my #time = (0,0,12,13,7-1,2010-1900); # note: #array = ( ... ), not [ ... ]
strftime($format, #time);

I looked again and I see the real problem in this code:
my $d = #{$details->{'date_added'}};
$writer->dataElement("creation", strftime($date_template, (0,0,12,#$d[0^$imday],#$d[1^$imday]-1,#$d[2],0,0,0)));
Specifically #{$details->{'date_added'}} is a dereference. But you're assigning it to a scalar variable and you don't need to dereference in the line below it:
my #d = #{$details->{'date_added'}};
$writer->dataElement("creation", strftime($date_template, (0,0,12,$d[0^$imday],$d[1^$imday]-1,$d[2],0,0,0)));
I've created a regular array for your reference #d and just accessed it as a regular array ( $d[ ... ] instead of #$d[ ... ] )

Related

Can I make a variable optional in a perl sub prototype?

I'd like to understand if it's possible to have a sub prototype and optional parameters in it. With prototypes I can do this:
sub some_sub (\#\#\#) {
...
}
my #foo = qw/a b c/;
my #bar = qw/1 2 3/;
my #baz = qw/X Y Z/;
some_sub(#foo, #bar, #baz);
which is nice and readable, but the minute I try to do
some_sub(#foo, #bar);
or even
some_sub(#foo, #bar, ());
I get errors:
Not enough arguments for main::some_sub at tablify.pl line 72, near "#bar)"
or
Type of arg 3 to main::some_sub must be array (not stub) at tablify.pl line 72, near "))"
Is it possible to have a prototype and a variable number of arguments? or is something similar achievable via signatures?
I know it could be done by always passing arrayrefs I was wondering if there was another way. After all, TMTOWTDI.
All arguments after a semi-colon are optional:
sub some_sub(\#\#;\#) {
}
Most people are going to expect your argument list to flatten, and you are reaching for an outdated tool to do what people don't expect.
Instead, pass data structures by reference:
some_sub( \#array1, \#array2 );
sub some_sub {
my #args = #_;
say "Array 1 has " . $args[0]->#* . " elements";
}
If you want to use those as named arrays within the sub, you can use ref aliasing
use v5.22;
use experimental qw(ref_aliasing);
sub some_sub {
\my( #array1 ) = $_[0];
...
}
With v5.26, you can move the reference operator inside the parens:
use v5.26;
use experimental qw(declared_refs);
sub some_sub {
my( \#array1 ) = $_[0];
...
}
And, remember that v5.20 introduced the :prototype attribute so you can distinguish between prototypes and signatures:
use v5.20;
sub some_sub :prototype(##;#) { ... }
I write about these things at The Effective Perler (which you already read, I see), in Perl New Features, a little bit in Preparing for Perl 7 (which is mostly about what you need to stop doing in Perl 5 to be future proof).

Is it possible to match a string $x = "foo" with a variable named $foo and assign a value only if it matches?

What I am trying to ask is easily shown.
Imagine 2 variables named as
my ($foo, $bar) = (0,0);
and
my #a = ("foo","bar","beyond","recognition");
is it possible to string match $a[0] with the variable named $foo, and assign a value to it (say "hi") only if it matches identically?
I am trying to debug this some code (not mine), and I ran into a tough spot. Basically, I have a part of the script where I have a bunch of variables.
my ($p1, $p2, $p3, $p4)= (0,0,0,0); # *Edited*
my #ids = ("p1","p2","p3","p4")
I have a case where I need to pass each of those variables as a hash key to call a certain operation inside a loop.
for (0..3){
my $handle = get_my_stuff(#ids);
my $ret = $p1->do_something(); # <- $p1 is used for the first instance of loop.
...
...
...
}
FOr the first iteration of the loop, I need to use $p1, but for the second iteration of the loop I need to pass (or call)
my $ret = $p2->do_something(); # not $p1
So what I did was ;
my $p;
for (1..4){
my $handle = get_my_stuff(#ids);
no strict 'refs';
my $ret = $p{$_}->do_something();
...
...
...
use strict 'refs';
...
}
But the above operation is not allowed, and I am unable to call my key in such a manner :(. As it turns out, $p1 became a blessed hash as soon after get_my_stuff() was called. And to my biggest surprise, somehow the script in the function (too much and too long to paste here) assign or pass a hash reference to my variables only if they match.
You don't need to try to invent something to deal with variable names. Your idea to use a hash is correct, but your approach is flawed.
It seems your function get_my_stuff takes a list of arguments and transforms them somehow. It then returns a list of objects that correspond to the arguments. Instead of doing that in the loop, do it before you loop through the numbers and build up your hash by assigning each id to an object.
Perl allows you to assign to a hash slice. In that case, the sigil changes to an #. My below implementation uses DateTime with years to show that the objects are different.
use strict;
use warnings;
use feature 'say';
use DateTime;
# for illustration purposes
sub get_my_stuff {
return map { DateTime->new( year => (substr $_, 1) + 2000 ) } #_;
}
my #ids = qw(p1 p2 p3 p4);
my %p;
# create this outside of the loop
#p{#ids} = get_my_stuff(#ids);
foreach my $i ( 1.. 4 ) {
say $p{'p' . $i}->ymd; # "do_something"
}
This will output
2001-01-01
2002-01-01
2003-01-01
2004-01-01

Perl find out if X is an element in an array

I don't know why small things are too not working for me in Perl. I am sorry for that.
I have been trying it around 2 hrs but i couldn't get the results.
my $technologies = 'json.jquery..,php.linux.';
my #techarray = split(',',$technologies);
#my #techarray = [
# 'json.jquery..',
# 'php.linux.'
# ];
my $search_id = 'json.jquery..';
check_val(#techarray, $search_id);
And i am doing a "if" to search the above item in array. but it is not working for me.
sub check_val{
my #techarray = shift;
my $search_id = shift;
if (grep {$_ eq $search_id} #techarray) {
print "It is there \n";
}else{
print "It is not there \n";
}
}
Output: It always going to else condition and returns "It is not there!" :(
Any idea. Am i done with any stupid mistakes?
You are using an anonymous array [ ... ] there, which as a scalar (reference) is then assigned to #techarray, as its only element. It is like #arr = 'a';. An array is defined by ( ... ).
A remedy is to either define an array, my #techarray = ( ... ), or to properly define an arrayref and then dereference when you search
my $rtecharray = [ .... ];
if (grep {$_ eq $search_id} #$rtecharray) {
# ....
}
For all kinds of list manipulations have a look at List::Util and List::MoreUtils.
Updated to changes in the question, as the sub was added
This has something else, which is more instructive.
As you pass an array to a function it is passed as a flat list of its elements. Then in the function the first shift picks up the first element,
and then the second shift picks up the second one.
Then the search is over the array with only 'json.jquery..' element, for 'php.linux.' string.
Instead, you can pass a reference,
check_val(\#techarray, $search_id);
and use it as such in the function.
Note that if you pass the array and get arguments in the function as
my (#array, $search_id) = #_; # WRONG
you are in fact getting all of #_ into #array.
See, for example, this post (passing to function) and this post (returning from function).
In general I'd recommend passing lists by reference.

Converting code to perl sub, but not sure I'm doing it right

I'm working from a question I posted earlier (here), and trying to convert the answer to a sub so I can use it multiple times. Not sure that it's done right though. Can anyone provide a better or cleaner sub?
I have a good deal of experience programming, but my primary language is PHP. It's frustrating to know how to execute in one language, but not be able to do it in another.
sub search_for_key
{
my ($args) = #_;
foreach $row(#{$args->{search_ary}}){
print "#$row[0] : #$row[1]\n";
}
my $thiskey = NULL;
my #result = map { $args->{search_ary}[$_][0] } # Get the 0th column...
grep { #$args->{search_in} =~ /$args->{search_ary}[$_][1]/ } # ... of rows where the
0 .. $#array; # first row matches
$thiskey = #result;
print "\nReturning: " . $thiskey . "\n";
return $thiskey;
}
search_for_key({
'search_ary' => $ref_cam_make,
'search_in' => 'Canon EOS Rebel XSi'
});
---Edit---
From the answers so far, I've cobbled together the function below. I'm new to Perl, so I don't really understand much of the syntax. All I know is that it throws an error (Not an ARRAY reference at line 26.) about that grep line.
Since I seem to not have given enough info, I will also mention that:
I am calling this function like this (which may or may not be correct):
search_for_key({
'search_ary' => $ref_cam_make,
'search_in' => 'Canon EOS Rebel XSi'
});
And $ref_cam_make is an array I collect from a database table like this:
$ref_cam_make = $sth->fetchall_arrayref;
And it is in the structure like this (if I understood how to make the associative fetch work properly, I would like to use it like that instead of by numeric keys):
Reference Array
Associative
row[1][cam_make_id]: 13, row[1][name]: Sony
Numeric
row[1][0]: 13, row[1][1]: Sony
row[0][0]: 19, row[0][1]: Canon
row[2][0]: 25, row[2][1]: HP
sub search_for_key
{
my ($args) = #_;
foreach my $row(#{$args->{search_ary}}){
print "#$row[0] : #$row[1]\n";
}
print grep { $args->{search_in} =~ #$args->{search_ary}[$_][1] } #$args->{search_ary};
}
You are moving in the direction of a 2D array, where the [0] element is some sort of ID number and the [1] element is the camera make. Although reasonable in a quick-and-dirty way, such approaches quickly lead to unreadable code. Your project will be easier to maintain and evolve if you work with richer, more declarative data structures.
The example below uses hash references to represent the camera brands. An even nicer approach is to use objects. When you're ready to take that step, look into Moose.
use strict;
use warnings;
demo_search_feature();
sub demo_search_feature {
my #camera_brands = (
{ make => 'Canon', id => 19 },
{ make => 'Sony', id => 13 },
{ make => 'HP', id => 25 },
);
my #test_searches = (
"Sony's Cyber-shot DSC-S600",
"Canon cameras",
"Sony HPX-32",
);
for my $ts (#test_searches){
print $ts, "\n";
my #hits = find_hits($ts, \#camera_brands);
print ' => ', cb_stringify($_), "\n" for #hits;
}
}
sub cb_stringify {
my $cb = shift;
return sprintf 'id=%d make=%s', $cb->{id}, $cb->{make};
}
sub find_hits {
my ($search, $camera_brands) = #_;
return grep { $search =~ $_->{make} } #$camera_brands;
}
This whole sub is really confusing, and I'm a fairly regular perl user. Here are some blanket suggestions.
Do not create your own undef ever -- use undef then return at the bottom return $var // 'NULL'.
Do not ever do this: foreach $row, because foreach my $row is less prone to create problems. Localizing variables is good.
Do not needlessly concatenate, for it offends the style god: not this, print "\nReturning: " . $thiskey . "\n";, but print "\nReturning: $thiskey\n";, or if you don't need the first \n: say "Returning: $thiskey;" (5.10 only)
greping over 0 .. $#array; is categorically lame, just grep over the array: grep {} #{$foo[0]}, and with that code being so complex you almost certainly don't want grep (though I don't understand what you're doing to be honest.). Check out perldoc -q first -- in short grep doesn't stop until the end.
Lastly, do not assign an array to a scalar: $thiskey = #result; is an implicit $thiskey = scalar #result; (see perldoc -q scalar) for more info. What you probably want is to return the array reference. Something like this (which eliminates $thiskey)
printf "\nReturning: %s\n", join ', ', #result;
#result ? \#result : 'NULL';
If you're intending to return whether a match is found, this code should work (inefficiently). If you're intending to return the key, though, it won't -- the scalar value of #result (which is what you're getting when you say $thiskey = #result;) is the number of items in the list, not the first entry.
$thiskey = #result; should probably be changed to $thiskey = $result[0];, if you want mostly-equivalent functionality to the code you based this off of. Note that it won't account for multiple matches anymore, though, unless you return #result in its entirety, which kinda makes more sense anyway.

How can I "store" an operator inside a variable in Perl?

I'm looking for a way to do this in Perl:
$a = "60"; $b = "< 80";
if ( $a $b ) { then .... }
Here, $b "holds" an operator... can I do this? Maybe some other way?
It's nice to see how people discover functional programming. :-)
Luckily, Perl has capabilities to create and store functions on-the-fly. For example, the sample in your question will look like this:
$a = "60"; $b = sub { $_[0] < 80 };
if ( $b->($a) ) { .... }
In this example, a reference to the anonymous subroutine is stored in $b, the sub having the same syntax for argument passing as a usual one. -> is then used to call-by-reference (the same syntax you probably use for references to arrays and hashes).
But, of course, if you want just to construct Perl expressions from arbitrary strings, you might want to use eval:
$a = "60"; $b = " < 80";
if ( eval ("$a $b") ) { .... }
However, doing this via eval is not safe, if the string you're eval-ing contains parts that come as user input. Sinan Ünür explained it perfectly in his answer-comment.
How about defining a function that wraps the needed condition:
my $cond = sub { $_[0] < 80 };
if ( $cond->( $a ) ) {
...
}
This should be a comment but comments are too cramped for something like this so I am making it CW.
For the case which you showed where the contents of the variables that are going to be passed to string eval, the accepted solution is correct.
If, however, the contents of $a and $b come from user input, then take a look at the following script:
#!/usr/bin/perl
use strict; use warnings;
my $x = '80';
my $y = '; warn "evil laugh!\n"; exit';
if ( eval ($x . $y) ) {
print "it worked!!!\n";
}
If the strings are entered by the user, there is nothing preventing the user from passing to your program the string ';system "rm -rf /bin"'.
So, the correct solution to your question would require writing or using an expression parser.
BTW, you should not use $a and $b as variable names as the are magical package local variables used by sort and as such they are exempt from strict — and you must always use strict and warnings in your programs.
$a = "60"; $b = "< 80";
if( eval($a. $b)){
print "ok";
}
see perldoc eval for more
I wonder if Number::Compare is of any interest here. From the example:
Number::Compare->new(">1Ki")->test(1025); # is 1025 > 1024
my $c = Number::Compare->new(">1M");
$c->(1_200_000); # slightly terser invocation
Safer form if you trust (or can sufficiently validate) $op and don't trust the safety of the inputs:
my $compare_x = $user_input_x;
my $compare_y = $user_input_y;
my $op = <some safe non-user-input, or otherwise checked against a safe list>;
if ( eval("\$compare_x $op \$compare_y") )
{
...
}