perlperl-module

How can I preserve state in a `use`d module relatively to the `use`ing module without refactoring?


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 useing module.

This is a utility module, so it's being used 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 used 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.

  1. I know (as the statement in bold itself hints at) that Z could be (and should be) refactored into a class, and that I could instantiate a local copy of Z in X and Y; this is undesirable at this point in time, because it's a lot of work;
  2. Holding a state variable in X and Y to control Z's behavior would be fine, however that would also require a huge refactor of Z's functions; this is, too, undesirable at this point in time;
  3. I'm looking for an alternate, faster solution to the solutions proposed above (if it's possible to fix this at all), even though I know changing the design would be the "correct" solution.
  4. I'm aware this could've been a bad design choice on my side. Still, that's we're I'm at right now, and I'm wondering if there's a, at least temporary, easy way out.

I'll appreciate any inputs. Thank you


Solution

  • 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 );
    

    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.