package Base;

use strict;
use warnings;

use fields qw( _f );

sub new
{
    my Base $self = shift;
    if ( !ref $self )     
    {
        $self = fields::new( $self );
    }
    $self->{_f} = 'base';
    return $self;
}

sub base { my Base $self = shift; $self->{_f}; }
sub set_base { my Base $self = shift; $self->{_f} = shift; }

1;

##</code><code>##

package Derived;

use strict;
use warnings;

use base 'Base';
use fields qw( _f );

sub new
{
    my $class = shift;
    my Derived $self = fields::new( $class );
    $self->SUPER::new();
    $self->{_f} = 'derived';
    return $self;
}

sub derived { my Derived $self = shift; $self->{_f}; }

1;

##</code><code>##

#!/usr/bin/perl

use strict;
use warnings;
use Test::More tests => 4;
use Derived;

my Derived $obj = Derived->new();

is( $obj->base(),    'base',    'Base::_f eq base' );
is( $obj->derived(), 'derived', 'Derived::_f eq derived' );

diag( 'Setting Base::_f to base2' );
$obj->set_base( 'base2' );

is( $obj->base(),    'base2',   'Base::_f eq base2' );
is( $obj->derived(), 'derived', 'Derived::_f still eq derived' );

1;

##</code><code>##

sub PKG() { __PACKAGE__ }
...
    $self->{PKG.'.foo'} = 42;