This is simplified example and not the actual case.
Currently I have a utility module (let's call it Z), which declares a number of functions and holds some state variable (let's call it Print
) in a variable:
package Z;
use strict;
use warnings;
use feature qw(say);
our $Print;
sub test {
say @_ if $Print;
}
1;
This obviously done so that printing of some stuff may be turned on / off by the use
ing module.
This is a utility module, so it's being use
d by many modules. For example, X and Y which, respectively, don't and do desire printing:
package X;
use strict;
use warnings;
use Z;
$Z::Print = 0; # Sets Z::Print to 0
sub f {
Z::test(@_);
}
1;
package Y;
use strict;
use warnings;
use Z;
$Z::Print = 1; # Sets Z::Print to 1
sub f {
Z::test(@_);
}
1;
Obviously this leads to problems when, e.g., X and Y are both use
d in the same script, as, e.g. in this case, Y will "step on X's foot" by changing the value of Z::Print
globally:
#!/usr/bin/env perl
# test.pl
use strict;
use warnings;
use X;
use Y;
my $v = 0;
X::f($v);
Y::f($v);
user@server ~/[REDACTED] (git)-[REDACTED] % ./test.pl
0 # X prints, unwanted
0 # Y prints, wanted
In reality, X and Y are actually about 10 modules that rely on this Z module, and all these dependants are either classes comprised of a number of methods or "bundles" of functions; most methods / functions of these dependants rely on Z for something.
I'll appreciate any inputs. Thank you
You could use local
in each of the callers that needs $Z::Print
to be set.
sub f {
local $Z::Print = 1;
Z::test( @_ );
}
Here's an approach that reduces the changes the to caller, but requires changes to Z.
In the caller, replace
$Z::Print = 1;
with
our $Z_Print = 1;
In Z, remove
our $Print;
and replace
$Print
with
Print
and add
# Look up the call stack for the first package that's not this module.
sub _get_caller {
for ( my $i = 1; ; ++$i ) {
my $caller = caller( $i );
return __PACKAGE__ if !defined( $caller );
return $caller if $caller ne __PACKAGE__;
}
}
my $prefix = __PACKAGE__ =~ s/::/_/gr; # Or whatever.
sub Print :lvalue {
my $caller = _get_caller();
my $name = "${caller}::${prefix}_Print";
no strict qw( refs );
$$name
}
That said, your exacting requirements can be met. This requires using magic.
In Z, replace
our $Print;
with
use Variable::Magic qw( wizard cast );
# Look up the call stack for the first package that's not this module.
sub _get_caller {
for ( my $i = 1; ; ++$i ) {
my $caller = caller( $i );
return __PACKAGE__ if !defined( $caller );
return $caller if $caller ne __PACKAGE__;
}
}
# In `get` and `set`,
# `$_[0]` is ref to the magic variable.
# `$_[1]` is the hash ref returned by `data`.
my $wiz = wizard(
data => sub { return { }; },
get => sub { ${ $_[0] } = $_[1]->{ _get_caller() }; return; },
set => sub { $_[1]->{ _get_caller() } = ${ $_[0] }; return; },
);
cast( our $Print, $wiz );
data
is called when the magic is added to $Print
. It's a constructor of sorts. The value returned will be provided to future calls to the get
and set
callbacks associated with the variable.get
is called when $Print
is read. The value read is the value of $Print
after this call, which is allowed to change the value of $Print
.set
is called after $Print
is modified.The same $wiz
can be used for multiple variables. And we can add support for defaults.
my $wiz = wizard(
data => sub {
my $var_ref = shift;
my %data = @_;
$data->{ default } = 0 if !exists( $data->{ default } );
$data->{ backend } = { } if !exists( $data->{ backend } );
return \%data;
},
get => sub {
my $var_ref = shift;
my $data = shift;
my $default = $data->{ default };
my $backend = $data->{ backend };
my $caller = _get_caller();
if ( !exists( $backend->{ $caller } ) ) {
$backend->{ $caller } = $default;
}
$$var_ref = $backend->{ $caller };
return;
},
set => sub {
my $var_ref = shift;
my $data = shift;
my $backend = $data->{ backend };
my $caller = _get_caller();
$backend->{ $caller } = $$var_ref
return;
},
);
cast( our $Print, $wiz, default => 1 );
Disclaimer: All three of these interfaces are bad.