Unexpected results for high order function - perl

I have a higher order function that maps even position values in an array:
sub map_even(&#) {
my $block = shift;
my #res;
for $i (0..$#_) {
push #res, $i%2 ? $_[$i] : &$block($_[$i]);
}
#res;
}
print map_even {$_*$_} 1,2,3,4;
I am expecting the output to be 14316, but the actual output is
0204
Why does this happen and how can I fix this? And is there any improvement can be done to the code?

In your anonymous function you have to access first input argument via $_[0] (hint: #_ array).
use strict;
use warnings;
sub map_even(&#) {
my $block = shift;
my #res;
for my $i (0..$#_) {
push #res, $i%2 ? $block->($_[$i]) : $_[$i];
}
#res;
}
print join ",", map_even {$_[0]*$_[0]} 1,2,3,4;
output
1,4,3,16
Using $_,
sub map_even(&#) {
my $block = shift;
my #res;
for my $i (0..$#_) {
push #res, $i%2 ? $block->() : $_ for $_[$i];
# or
# local $_ = $_[$i];
# push #res, $i%2 ? $block->() : $_;
}
#res;
}
print join ",", map_even {$_*$_} 1,2,3,4;

In your map_even block, you use the special $_ variable. However, you have to set it inside your loop:
local $_ = $_[$i];
... $block->();
The $_ is a global variable and can be temporarily overridden with the local operator. The $_ has nothing to do with subroutine arguments.
About aliasing: Perls for, map and grep mostly alias $_ to the current element as a performance hack, not because this behavior would be particularly desirable. In order to perform an alias, you should localize the whole *_ typeglob which contains the $_ variable and then assign a scalar reference of the alias target to the glob:
local *_ = \$_[$i];

I would solve this one of two ways.
First, by using List::Utils's pairmap:
use strict;
use warnings;
use List::Util qw(pairmap);
my #x = (1 .. 4);
my #result = pairmap {$a, $b**2} #x;
print "#result\n";
Or more simply, by just using the indexes:
use strict;
use warnings;
my #x = (1 .. 4);
my #result = map {$_ % 2 ? $x[$_] ** 2 : $x[$_]} (0..$#x);
print "#result\n";
However, if you really wanted a new sub, I'd just setup a flip-flop:
use strict;
use warnings;
sub map_even(&#) {
my $block = shift;
my $even = 1;
map {($even ^= 1) ? $block->() : $_} #_;
}
print join " ", map_even {$_*$_} 1,2,3,4;
All output:
1 4 3 16

Related

Perl, Split string into Key:Value pairs for hash with lowercase keys without temporary array

Given a string of Key:Value pairs, I want to create a lookup hash but with lowercase values for the keys. I can do so with this code
my $a="KEY1|Value1|kEy2|Value2|KeY3|Value3";
my #a = split '\|', $a;
my %b = map { $a[$_] = ( !($_ % 2) ? lc($a[$_]) : $a[$_]) } 0 .. $#a ;
The resulting Hash would look like this Dumper output:
$VAR1 = {
'key3' => 'Value3',
'key2' => 'Value2',
'key1' => 'Value1'
};
Would it be possible to directly create hash %b without using temporary array #a or is there a more efficient way to achieve the same result?
Edit: I forgot to mention that I cannot use external modules for this. It needs to be basic Perl.
You can use pairmap from List::Util to do this without an intermediate array at all.
use strict;
use warnings;
use List::Util 1.29 'pairmap';
my $str="KEY1|Value1|kEy2|Value2|KeY3|Value3";
my %hash = pairmap { lc($a) => $b } split /\|/, $str;
Note: you should never use $a or $b outside of sort (or List::Util pair function) blocks. They are special global variables for sort, and just declaring my $a in a scope can break all sorts (and List::Util pair functions) in that scope. An easy solution is to immediately replace them with $x and $y whenever you find yourself starting to use them as example variables.
Since the key-value pair has to be around the | you can use a regex
my $v = "KEY1|Value1|kEy2|Value2|KeY3|Value3";
my %h = split /\|/, $v =~ s/([^|]+) \| ([^|]+)/lc($1).q(|).$2/xger;
use strict;
use warnings;
use Data::Dumper;
my $i;
my %hash = map { $i++ % 2 ? $_ : lc } split(/\|/, 'KEY1|Value1|kEy2|Value2|KeY3|Value3');
print Dumper(\%hash);
Output:
$VAR1 = {
'key1' => 'Value1',
'key2' => 'Value2',
'key3' => 'Value3'
};
For fun, here are two additional approaches.
A cheaper one than the original (since the elements are aliased rather than copied into #_):
my %hash = sub { map { $_ % 2 ? $_[$_] : lc($_[$_]) } 0..$#_ }->( ... );
A more expensive one than the original:
my %hash = ...;
#hash{ map lc, keys(%hash) } = delete( #hash{ keys(%hash) } );
More possible solutions using regexes to do all the work, but not very pretty unless you really like regex:
use strict;
use warnings;
my $str="KEY1|Value1|kEy2|Value2|KeY3|Value3";
my %hash;
my $copy = $str;
$hash{lc $1} = $2 while $copy =~ s/^([^|]*)\|([^|]*)\|?//;
use strict;
use warnings;
my $str="KEY1|Value1|kEy2|Value2|KeY3|Value3";
my %hash;
$hash{lc $1} = $2 while $str =~ m/\G([^|]*)\|([^|]*)\|?/g;
use strict;
use warnings;
my $str="KEY1|Value1|kEy2|Value2|KeY3|Value3";
my %hash = map { my ($k, $v) = split /\|/, $_, 2; (lc($k) => $v) }
$str =~ m/([^|]*\|[^|]*)\|?/g;
Here's a solution that avoids mutating the input string, constructing a new string of the same length as the input string, or creating an intermediate array in memory.
The solution here changes the split into looping over a match statement.
#! /usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
my $a="KEY1|Value1|kEy2|Value2|KeY3|Value3";
sub normalize_alist_opt {
my ($input) = #_;
my %c;
my $last_key;
while ($input =~ m/([^|]*(\||\z)?)/g) {
my $s = $1;
next unless $s ne '';
$s =~ s/\|\z//g;
if (defined $last_key) {
$c{ lc($last_key) } = $s;
$last_key = undef;
} else {
$last_key = $s;
}
}
return \%c;
}
print Dumper(normalize_alist_opt($a));
A potential solution that operates over the split directly. Perl might recognize and optimize the special case. Although based on discussions here and here, I'm not sure.
sub normalize_alist {
my ($input) = #_;
my %c;
my $last_key;
foreach my $s (split /\|/, $input) {
if (defined $last_key) {
$c{ lc($last_key) } = $s;
$last_key = undef;
} else {
$last_key = $s;
}
}
return \%c;
}

A simple variable count inside array

After working with this code, I am stuck at what I think is a simple error, yet I need outside eyes to see what is wrong.
I used unpack function to divide an array into the following.
#extract =
------MMMMMMMMMMMMMMMMMMMMMMMMMM-M-MMMMMMMM
------SSSSSSSSSSSSSSSSSSSSSSSSSS-S-SSSSSDTA
------TIIIIIIIIIIIIITIIIVVIIIIII-I-IIIIITTT
Apparently, after unpacking into the array, when I try to go into the while loop, #extract shows up completely empty. Any idea as to why this is happening?
print #extract; #<-----------Prints input
my $sum = 0;
my %counter = ();
while (my $column = #extract) {
print #extract; #<------- This extract is completely empty. Should be input
for (my $aa = (split ('', $column))){
$counter{$aa}++;
delete $counter{'-'}; # Don't count -
}
# Sort keys by count descending
my #keys = (sort {$counter{$b} <=> $counter{$a}} keys %counter) [0]; #gives highest letter
for my $key (#keys) {
$sum += $counter{$key};
print OUTPUT "$key $counter{$key} ";
Each line is an array element correct? I don't see in your code where you are checking the individual characters.
Assuming the input that you have shown is a 3 element array containing the line as a string:
#!/usr/bin/perl
use strict;
use warnings;
my #entries;
while(my $line = shift(#extract)){
my %hash;
for my $char(split('', $line)){
if($char =~ /[a-zA-Z]/) { $hash{$char}++ }
}
my $high;
for my $key (keys %hash) {
if(!defined($high)){ $high = $key }
elsif($hash{$high} < $hash{$key}){
$high = $key
}
}
push #entries, {$high => $hash{$high}};
}
Note this empties #extract, if you don't want to do that you'd have to use a for loop like below
for my $i (0 .. $#extract){
#my %hash etc...
}
EDIT:
Changed it so that only the highest number is actually kept
An approach using reduce from List::Util.
#!/usr/bin/perl
use strict;
use warnings;
use List::Util 'reduce';
my #extract = qw/
------MMMMMMMMMMMMMMMMMMMMMMMMMM-M-MMMMMMMM
------SSSSSSSSSSSSSSSSSSSSSSSSSS-S-SSSSSDTA
------TIIIIIIIIIIIIITIIIVVIIIIII-I-IIIIITTT
/;
for (#extract) {
my %count;
tr/a-zA-Z//cd;
for (split //) {
$count{$_}++;
}
my $max = reduce { $count{$a} > $count{$b} ? $a : $b } keys %count;
print "$max $count{$max}\n";
}

Push to array not working inside loop

AIM:
I am trying to count a value in "column" 20 in a text file, then print the number of occurrences with the values from the line in the text file. Some of the lines will be identical, with the exception of "column" 0 (first column). I am trying to use hashes (though I have limited understanding of how to use hashes).
PROBLEM:
While doing push in a sub function (inside a foreach loop) the value is not being pushed to an array outside the loop, and hence the output will not be saved to file. Printing inside of the loop works (print $dummy) and all the data is being displayed.
INPUT:
Filename1 Value1a Value2a Value3a ... Column20a ... ColumnENDa
Filename2 Value1b Value2b Value3b ... Column20b ... ColumnENDb
Filename3 Value1c Value2c Value3c ... Column20a ... ColumnENDc
...
OUTPUT (using print $dummy inside loop):
2 Column20a Filename1, Filename3
1 Column20b Filename2
...
CODE:
use strict;
use warnings;
use Cwd;
use File::Find::Rule;
use File::Spec;
use File::Basename;
use Text::Template;
use File::Slurp;
use List::MoreUtils qw(uniq);
my $current_dir = cwd;
my #test_file = read_file ("test_file.txt");
my %count = ();
my %name = ();
my #test = "Counts\tName\tFile_names";
foreach (#test_file) {
chomp $_;
our(#F) = split('\t', $_, 0);
++$count{"$F[20] "};
$name{"$F[20] "} .= "$F[0]," if $F[20];
sub END {
foreach $_ (keys %name) {
$name{$_} =~ s/,$//;
my $dummy = "$count{$_}\t $_\t $name{$_}\n";
#print $dummy;
push (#test, $dummy);
}
};
}
print "#test";
write_file( 'test.txt', #test);
Why is the push function not working outside the sub (foreach loop)?
You're not actually calling your sub.
If you meant it to be the END block, it shouldn't be a sub - and you should not use END blocks unless there's a technical reason to do so.
If you mean it to be a sub, name it something else and actually call it (the name isn't an error, just looks bad - END has special meaning).
The end of your code would be (without fixing/improving it):
foreach (#test_file) {
chomp $_;
our(#F) = split('\t', $_, 0);
++$count{$F[20]};
$name{$F[20]} .= "$F[0]," if $F[20];
}
process_test();
print "#test";
write_file( 'test.txt', #test);
##########################
sub process_test {
foreach $_ (keys %name) {
$name{$_} =~ s/,$//;
my $dummy = "$count{$_}\t $_\t $name{$_}\n";
push (#test, $dummy);
}
}
As an alternative, don't even have a sub (it's not necessary for a couple of lines of code :)
foreach (#test_file) {
chomp $_;
our(#F) = split('\t', $_, 0);
++$count{$F[20]};
$name{$F[20]} .= "$F[0]," if $F[20];
}
foreach $_ (keys %name) {
$name{$_} =~ s/,$//;
my $dummy = "$count{$_}\t $_\t $name{$_}\n";
push (#test, $dummy);
}
print "#test";
write_file('test.txt', #test);
I tested this on my own version of your code, and got the following in the output file using your test input:
Counts Name File_names
2 Column20a Filename1,Filename3
1 Column20b Filename2
Why do you code the subroutine in the foreach-loop? So for every iteration through your loop you create a new one.
There is also a problem with the name of you subroutine. Actually you don't call it. And you can't call it, because perl uses END for the END block. Let me show you this with an example:
use warnings;
use strict;
END('hello world');
sub END{
my $string = shift;
print $string;
}
The purpose of the END block is to do everything between the brackets when the program ends, therefore the name.
use warnings;
use strict;
END('hello world');
sub END{
my $string = shift;
print $string;
}
Either you omit the subroutine or you declare it in a global context e.g. at the end of the program.

Perl - Best practices when sending blocks to subs

I'm a big fan of functional programming, so when I discovered block references in Perl I started using them a lot.
However, the functions I've written that take blocks as arguments are written in this style:
sub mygrep (&#) {
my $code = shift;
my #result;
foreach $_ (#_) {
push(#result, $_) if &$code;
}
#result;
}
(From http://perldoc.perl.org/perlsub.html#Prototypes)
In essence, most of my functions set $_ in order for the code block to gain access to data in my sub. I guess my question can be split into three subquestions:
Are there some major pitfalls in this approach?
Is it a better idea to localize $_ before setting it?
Should i use partially applied functions instead?
I'm still a Perl newbie so any answers and suggestions are appreciated - thanks in advance! :)
In the code you have written:
sub mygrep (&#) {
my $code = shift;
my #result;
foreach $_ (#_) {
push(#result, $_) if &$code;
}
#result;
}
The foreach loop is implicitly localizing the $_ variable on every loop iteration. It is perfectly safe (and the fastest way to get values into $_ properly).
The only nit that I have with the code above is that every time &$code is executed, it has access to the source argument list, which could cause a bug. You could rewrite the code as follows:
sub mygrep (&#) {
my $code = shift;
my #result;
foreach $_ (splice #_) {
push(#result, $_) if &$code; # #_ is empty here
}
#result;
}
Here are a few other ways you could write that function:
sub mygrep (&#) {
my ($code, #result) = shift;
&$code and push #result, $_ for splice #_;
#result
}
sub mygrep (&#) {
my $code = shift;
# or using grep in our new grep:
grep &$code, splice #_
}
Each of these examples provides an aliased $_ to its subroutine, with proper localization.
If you are interested in higher order functions, I'd encourage you to take a look at my module List::Gen on CPAN, which provides dozens of higher order functions for manipulating both real and lazy lists.
use List::Gen;
my $list = filter {$_ % 2} <1..>;
# as a lazy array:
say "#$list[0 .. 5]"; # 1 3 5 7 9 11
# as an object:
$list->map('**2')->drop(100)->say(5); # 40401 41209 42025 42849 43681
zip('.' => <a..>, <1..>)->say(5); # a1 b2 c3 d4 e5
How about using $code->($arg)?
sub mygrep (&#) {
my $code = shift;
my #result;
foreach my $arg (#_) {
push(#result, $arg) if $code->( $arg);
}
#result;
}
I haven't tested it but I would assume this would work, and it would let you pass additional arguments to $code.
Updated: this looked fun so I went ahead and tested it. It works just fine, see below (I intensely dislike prototypes, so I removed it, especially as it kept complaining about #a not being an array ref ;--(
#!/usr/bin/perl
use strict;
use warnings;
sub mygrep {
my $code = shift;
my #result;
foreach my $arg (#_) {
push(#result, $arg) if $code->( $arg);
}
#result;
}
my #a= ( 1, 2, 3, 4, 5, 6);
print mygrep( sub { return shift() % 2 }, #a), "\n";
And of course the main fun with this line of thinking is also to generate the code;
#!/usr/bin/perl
use strict;
use warnings;
sub mygrep {
my $code = shift;
my $filter= shift;
my #result;
foreach my $arg (#_) {
push(#result, $arg) if $code->( $arg);
}
#result;
}
my #a= ( 1, 2, 3, 4, 5, 6, 7, 8, 9);
print mygrep( mod_filter( 3), #a), "\n";
print mygrep( mod_filter( 4), #a), "\n";
sub mod_filter
{ my( $filter)= #_;
return sub { ! (shift() % $filter) };
}
1. Are there some major pitfalls in this approach?
my $_; in view of the block will hide your changes to package variable $_. There's nothing you can do about that from inside of mygrep.
&$code is very special. You want &$code() or $code->() instead.
Changing $_ will change the arguments passed to mygrep. That's undesirable here.
2. Is it a better idea to localize $_ before setting it?
for provides much better localisation that local, but it also provides aliasing that's undesirable here.
3. Should i use partially applied functions instead?
I don't know what that means.
Fixed:
sub mygrep (&#) {
my $code = shift;
my #result;
for (#_) {
# Create copy so $_ can be modified safely.
for (my $s = $_) {
push #result, $_ if $code->();
}
}
return #result;
}
That said, I think mygrep is kind pointless, since map+grep already does what you want more easily. Compare
mygrep { if ($_ % 2) { ++$_; 1 } else { 0 } } LIST
with
map { $_+1 } grep { $_ % 2 } LIST
You can even merge the map and grep.
map { $_ % 2 ? $_+1 : () } LIST
It's absolutely better to localize $_. The subref can modify the value of $_, and those changes will propagate into the calling function. This isn't a problem in the mygrep() case, but could be in others.

perl: iterate over a typeglob

Given a typeglob, how can I find which types are actually defined?
In my application, we user PERL as a simple configuration format.
I'd like to require() the user config file, then be able to see which variables are defined, as well as what types they are.
Code: (questionable quality advisory)
#!/usr/bin/env perl
use strict;
use warnings;
my %before = %main::;
require "/path/to/my.config";
my %after = %main::;
foreach my $key (sort keys %after) {
next if exists $before{$symbol};
local *myglob = $after{$symbol};
#the SCALAR glob is always defined, so we check the value instead
if ( defined ${ *myglob{SCALAR} } ) {
my $val = ${ *myglob{SCALAR} };
print "\$$symbol = '".$val."'\n" ;
}
if ( defined *myglob{ARRAY} ) {
my #val = #{ *myglob{ARRAY} };
print "\#$symbol = ( '". join("', '", #val) . "' )\n" ;
}
if ( defined *myglob{HASH} ) {
my %val = %{ *myglob{HASH} };
print "\%$symbol = ( ";
while( my ($key, $val) = each %val ) {
print "$key=>'$val', ";
}
print ")\n" ;
}
}
my.config:
#A = ( a, b, c );
%B = ( b=>'bee' );
$C = 'see';
output:
#A = ( 'a', 'b', 'c' )
%B = ( b=>'bee', )
$C = 'see'
$_<my.config = 'my.config'
In the fully general case, you can't do what you want thanks to the following excerpt from perlref:
*foo{THING} returns undef if that particular THING hasn't been used yet, except in the case of scalars. *foo{SCALAR} returns a reference to an anonymous scalar if $foo hasn't been used yet. This might change in a future release.
But if you're willing to accept the restriction that any scalar must have a defined value to be detected, then you might use code such as
#! /usr/bin/perl
use strict;
use warnings;
open my $fh, "<", \$_; # get DynaLoader out of the way
my %before = %main::;
require "my.config";
my %after = %main::;
foreach my $name (sort keys %after) {
unless (exists $before{$name}) {
no strict 'refs';
my $glob = $after{$name};
print "\$$name\n" if defined ${ *{$glob}{SCALAR} };
print "\#$name\n" if defined *{$glob}{ARRAY};
print "%$name\n" if defined *{$glob}{HASH};
print "&$name\n" if defined *{$glob}{CODE};
print "$name (format)\n" if defined *{$glob}{FORMAT};
print "$name (filehandle)\n" if defined *{$glob}{IO};
}
}
will get you there.
With my.config of
$JACKPOT = 3_756_788;
$YOU_CANT_SEE_ME = undef;
#OPTIONS = qw/ apple cherries bar orange lemon /;
%CREDITS = (1 => 1, 5 => 6, 10 => 15);
sub is_jackpot {
local $" = ""; # " fix Stack Overflow highlighting
"#_[0,1,2]" eq "barbarbar";
}
open FH, "<", \$JACKPOT;
format WinMessage =
You win!
.
the output is
%CREDITS
FH (filehandle)
$JACKPOT
#OPTIONS
WinMessage (format)
&is_jackpot
Printing the names takes a little work, but we can use the Data::Dumper module to take part of the burden. The front matter is similar:
#! /usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
sub _dump {
my($ref) = #_;
local $Data::Dumper::Indent = 0;
local $Data::Dumper::Terse = 1;
scalar Dumper $ref;
}
open my $fh, "<", \$_; # get DynaLoader out of the way
my %before = %main::;
require "my.config";
my %after = %main::;
We need to dump the various slots slightly differently and in each case remove the trappings of references:
my %dump = (
SCALAR => sub {
my($ref,$name) = #_;
return unless defined $$ref;
"\$$name = " . substr _dump($ref), 1;
},
ARRAY => sub {
my($ref,$name) = #_;
return unless defined $ref;
for ("\#$name = " . _dump $ref) {
s/= \[/= (/;
s/\]$/)/;
return $_;
}
},
HASH => sub {
my($ref,$name) = #_;
return unless defined $ref;
for ("%$name = " . _dump $ref) {
s/= \{/= (/;
s/\}$/)/;
return $_;
}
},
);
Finally, we loop over the set-difference between %before and %after:
foreach my $name (sort keys %after) {
unless (exists $before{$name}) {
no strict 'refs';
my $glob = $after{$name};
foreach my $slot (keys %dump) {
my $var = $dump{$slot}(*{$glob}{$slot},$name);
print $var, "\n" if defined $var;
}
}
}
Using the my.config from your question, the output is
$ ./prog.pl
#A = ('a','b','c')
%B = ('b' => 'bee')
$C = 'see'
Working code using a CPAN module that gets some of the hair out of the way, Package::Stash. As noted in my comment to gbacon's answer, this is blind to the config file doing $someval = undef but that seems to be unavoidable, and at least the other cases are caught. It also limits itself to the SCALAR, ARRAY, HASH, CODE, and IO types -- getting GLOB and FORMAT is possible but it makes the code less pretty and also creates noise in the output :)
#!perl
use strict;
use warnings;
use Package::Stash;
sub all_vars_in {
my ($package) = #_;
my #ret;
my $stash = Package::Stash->new($package);
for my $sym ($stash->list_all_package_symbols) {
for my $sigil (qw($ # % &), '') {
my $fullsym = "$sigil$sym";
push #ret, $fullsym if $stash->has_package_symbol($fullsym);
}
}
#ret;
}
my %before;
$before{$_} ++ for all_vars_in('main');
require "my.config";
for my $var (all_vars_in('main')) {
print "$var\n" unless exists $before{$var};
}
Beginning in 5.010, you can distinguish whether a SCALAR exists using the B introspection module; see Detecting declared package variables in perl
Update: example copied from that answer:
# package main;
our $f;
sub f {}
sub g {}
use B;
use 5.010;
if ( ${ B::svref_2object(\*f)->SV } ) {
say "f: Thar be a scalar tharrr!";
}
if ( ${ B::svref_2object(\*g)->SV } ) {
say "g: Thar be a scalar tharrr!";
}
1;
UPDATE:
gbacon is right. *glob{SCALAR} is defined.
Here is the output I get using your code:
Name "main::glob" used only once:
possible typo at
test_glob_foo_thing.pl line 13.
'FOO1' (SCALAR)
'FOO1' (GLOB)
'FOO2' (SCALAR)
'FOO2' (GLOB)
'_<my.config' (SCALAR)
'_<my.config' (GLOB)
This is despite FOO2 being defined as a hash, but not as a scalar.
ORIGINAL ANSWER:
If I understand you correctly, you simply need to use the defined built-in.
#!/usr/bin/env perl
use strict;
use warnings;
my %before = %main::;
require "/path/to/my.config";
my %after = %main::;
foreach my $key (sort keys %after) {
if (not exists $before{$key}) {
if(defined($after{$key}){
my $val = $after{$key};
my $what = ref($val);
print "'$key' ($what)\n";
}
}
}
I hate to ask, but instead of messing around with typeglobs, why not switch to a real configuration format? e.g. check out Config::Simple and YAML.
I wouldn't recommend messing around with typeglobs and symbol tables in normal cases (some CPAN modules do that, but only at the bottom levels of large systems - e.g. Moose in the lowest levels of Class::MOP). Perl gives you a lot of rope to work with, but that rope is also quite happy to self-noosify and self-tie-around-your-neck if you're not careful :)
See also: How do you manage configuration files in Perl?
no strict 'refs';
my $func_name = 'myfunc';
*{$func_name}{CODE}()
use strict 'refs';
If you don't mind parsing Data::Dump output, you could use it to tease out the differences.
use strict;
use warnings;
use Data::Dump qw{ dump };
my %before = %main::;
require "my.config";
my %after = %main::;
foreach my $key ( sort keys %after ) {
if ( not exists $before{$key} ) {
my $glob = $after{$key};
print "'$key' " . dump( $glob) . "\n";
}
}
Using this code with the following config file:
$FOO1 = 3;
$FOO2 = 'my_scalar';
%FOO2 = ( a=>'b', c=>'d' );
#FOO3 = ( 1 .. 5);
$FOO4 = [ 1 .. 5 ];
I believe that this output provides enough information to be able to figure out which parts of each type glob are defined:
'FOO1' do {
my $a = *main::FOO1;
$a = \3;
$a;
}
'FOO2' do {
my $a = *main::FOO2;
$a = \"my_scalar";
$a = { a => "b", c => "d" };
$a;
}
'FOO3' do {
my $a = *main::FOO3;
$a = [1 .. 5];
$a;
}
'FOO4' do {
my $a = *main::FOO4;
$a = \[1 .. 5];
$a;
}
'_<my.config' do {
my $a = *main::_<my.config;
$a = \"my.config";
$a;
}