Perl Best Practices

18.10. Overriding Strictures

Turn off strictures or warnings explicitly, selectively, and in the smallest possible scope.

Sometimes you really do need to implement something arcane; something that would cause use strict or use warnings to complain. In this case, because you'll always be using both those pragmas (see the previous three guidelines, "Strictures", "Warnings", and "Correctness"), you'll need to turn them off temporarily.

The key to doing that without compromising the robustness of your code is to turn off warnings and strictures in the smallest possible scope. And to turn off only the particular warnings you intend to cause or those specific strictures that you're intentionally violating.

For example, suppose you needed a Sub::Tracking module that, when passed the name of a subroutine, would modify that subroutine so that any subsequent call to it was logged. For example:

use Digest::SHA qw( sha512_base64 ); use Sub::Tracking qw( track_sub ); track_sub('sha512_base64');

# and later... my $text_key = sha512_base64($original_text);

# Use of subroutine automatically logged

Such a module might be implemented as in Example 18-1.

Example 18-1. A module for tracking subroutine calls

package Sub::Tracking; use version; our $VERSION = qv(0.0.1); use strict; use warnings; use Carp; use Perl6::Export::Attrs; use Log::Stdlog {level => 'trace'};

# Utility to create a tracked version of an existing subroutine... sub _make_tracker_for { my ($sub_name, $orig_sub_ref) = @_;

# Return a new subroutine... return sub {

# ...which first determines and logs its call context my ($package, $file, $line) = caller; print {*STDLOG} trace => "Called $sub_name(@_) from package $package at '$file' line $line";

# ...and then transforms into a call to the original subroutine goto &{$orig_sub_ref}; } }

# Replace an existing subroutine with a tracked version... sub track_sub : Export { my ($sub_name) = @_;

# Locate the (currently untracked) subroutine in the caller's symbol table... my $caller = caller; my $full_sub_name = $caller.'::'.$sub_name; my $sub_ref = do { no strict 'refs'; *{$full_sub_name}{CODE} };

# Or die trying... croak "Can't track nonexistent subroutine '$full_sub_name'" if !defined $sub_ref;

# Then build a tracked version of it... my $tracker_ref = _make_tracker_for($sub_name, $sub_ref);

# And install that version back in the caller's symbol table... { no strict 'refs'; *{$full_sub_name} = $tracker_ref; } return; } 1;

# Magic true value required at end of module

The _make_tracker_for( ) utility subroutine creates a new anonymous subroutine that first logs the fact that it has been called:

print {*STDLOG} trace => "Called $sub_name(@_) from package $package at '$file' line $line";

then turns itself into the original subroutine instead^[*]:

^[*] This is known as a "magic goto". It replaces the current subroutine call with a call to whatever subroutine you tell it to go to. It's very useful when you're installing a wrapper around an existing subroutine. Your wrapper call can do whatever it needs to do, then silently transform itself into a call to the wrapped subroutine. After which, even caller won't be able to tell the difference. See the entry for goto in perlfunc.

goto &{$orig_sub_ref};

The Sub::Tracking::track_sub( ) subroutine expects to be passed the name of the subroutine to be tracked. It takes that name, prepends the caller's package name ($caller.'::'.$sub_name), and then looks up that fully qualified name to see if there is a corresponding subroutine entry in the caller's symbol table (*{$full_sub_name}{CODE}). The result of this look-up will be either a reference to the named subroutine or undef (if no such subroutine exists).

track_sub( ) then creates a new tracking version of the subroutine:

my $tracker_ref = _make_tracker_for($sub_name, $sub_ref);

and installs it back in the caller's symbol table:

*{$full_sub_name} = $tracker_ref;

The problem here is that both the symbol table look-up and the symbol table assignment use a string ($full_sub_name) as the name of the symbol table entry, rather than a hard reference to it. Using a string instead of a real reference would normally incur the wrath of use strict, but the no strict 'refs' declarations tell the compiler to turn a blind eye.

Of course, it's particularly tedious to have to set up those tiny block scopes to contain the no strict declarations, especially when you could get the same effect simply by omitting the use strict at the start of the module:

package Sub::Tracking; # use strict -- Disabled because symbolic references needed below use warnings; use Carp; use Stdlog; use version; our $VERSION = qv(0.0.1); # etc.

But that's a bad practice, because it would remove the strictures not only from the two lines where they're not wanted, but from every other line as well. That could easily mask other strictness violations that you would still like to be informed of.

Nor would it have been acceptable to turn off strict references throughout the track_sub( ) subroutine:

sub track_sub : Export { my ($sub_name) = @_; no strict 'refs'; # Locate the (currently untracked) subroutine in the caller's symbol table... my $caller = caller; my $full_sub_name = $caller.'::'.$sub_name; my $sub_ref = *{$full_sub_name}{CODE}; # Or die trying... croak "Can't track nonexistent subroutine '$full_sub_name'" if !defined $sub_ref; # Then build a tracked version of it... my $TRacker_ref = _make_tracker_for($sub_name, $sub_ref); # And install that version back in the caller's symbol table... *{$full_sub_name} = $tracker_ref; return; }

That would still exclude far more code from strictness-checking than was (ahem) strictly necessary.

Wrapping extra do blocks or raw blocks tightly around any statement that is deliberately violating strictness is tedious, but not as tedious as spending an hour debugging some unexpected symbolic reference, unauthorized package variable, or undeclared subroutine that use strict would otherwise have caught.