Finding out who is trying to access private hashes

Posted by robbiebow on 1 November, 2007 under perl | Be the First to Comment

Had an interesting problem this week with a hostile legacy codebase. There is a “config” module in the codebase that opens a file and creates methods for each of the variables to give you a config object. You can then get your config values by calling the appropriate method. This works fine but in some places in the code base someone has decided to ignore the methods and access the variables directly. Turns out the package stores the variables in a hash called “config” in the object. Accessing the variables directly is therefore possible by doing something along the lines of:

my $car = $config->{config}{car};

Tsk for the Config.pm author not encapsulating his data properly. I wrote a new Config.pm to replace the old one with a shiny, Class::Accessor::Fast
based one, with read only accessors and properly encapsulated data. But
then we need to know what other packages were going to try to access
the data directly, and fix them accordingly. I did this by making a
“config” hash and then tieing that to a sub routine that creates a
warning, plus it also then tries to access the appropriate method to
return the value the caller is trying to fetch. This means that if this
slips into production there is less risk of things blowing up, whilst
being able to find out what is trying to get to the data directly.

I used Tie::Sub to do the tie and it ended up looking something like this:

package My::Config;

use strict;use Config::Auto;use Tie::Sub;use base qw(Class::Accessor::Fast);

sub new {    my $class = shift;    my $file  = shift || die 'Config file not supplied';

    my $cnf   = Config::Auto::parse($file, format => "perl")                       || die "Problem parsing $file : $!";    my @accessors;    push @accessors, $_ for keys %$cnf;

    $class->mk_ro_accessors(@accessors);

    my $self = $class->SUPER::new($cnf);    tie my %hash, 'Tie::Sub', sub { my $method = shift;                    warn "Tried to access $method directly";                    if ($self->can($method)) {                      return $self->$method;                    }                    return;                  };    $self->{config} = \%hash;    return $self;}

1;

package main;

my $config = My::Config->new('transport.config');

print $config->{config}{not_a_method}; # returns nothingprint $config->{config}{car}; # returns "ford"

1;

__END__