One of the most deliciously controversial parts of standard perl are the pragma modules base.pm and fields.pm. Many people hate them, but they served me well for several years. Now though, it’s time to refactor my module to use a plugin instead of an embedded class. The fields pragma is only useful for static compile-time fields, so I’m dropping it as I move to a more generic model. I may well use the fields pragma again in the future, so I’m recording here the code that worked, because there’s a fair bit to it.

package Cari::Mysql::Defaults;
use fields qw(
    RaiseError
    PrintError
    PrintWarn
    AutoCommit
    TraceLevel
    mysql_enable_utf8
    label
    cnfdir
    cnfgroup
    cnf
    driver
    db
    host
    port
    user
    password
);
my __PACKAGE__ $Defaults = fields::new(__PACKAGE__);
%$Defaults = (
    RaiseError => 1,
    PrintError => 0,
    PrintWarn => 0,
    AutoCommit => 1,
    TraceLevel => 0,
    mysql_enable_utf8 => 0,
    label => undef,
    cnfdir => '.',
    cnfgroup => 'client',
    cnf => 'undefined',
    driver => 'mysql',
    db => 'test',
    host => undef,
    port => undef,
    user => undef,
    password => undef
);

sub new {
    my ($proto, %param) = @_;
    my $class = ref($proto) || $proto;
    my __PACKAGE__ $self = fields::new($class);
    # When called as object method, acts as a 'clone' method
    %$self = ref($proto) ? %$proto : %$Defaults;
    %$self = (%$self, %param) if scalar %param;
    return $self;
}

sub defaults {
    my ($proto, %param) = @_;
    return ref($proto) ? $proto->merge(%param)
                       : $Defaults->merge(%param) if %param;
    return ref($proto) ? $proto : $Defaults;
}

{ # BEGIN no strict
no strict 'refs';
for my $datum (keys %{__PACKAGE__ . '::FIELDS'}) {
    *$datum = sub {
        my ($self, $val) = @_;
        my $r = ref($self) ? $self : $Defaults;
        $r->{$datum} = $val if scalar @_ > 1;
        return $r->{$datum};
    };
}
} # END no strict
Advertisements