#!/usr/bin/perl
use strict;
use warnings;

package Top;

sub new {
    my ($class, %params) = @_;
    my $self = bless \%params, $class;

    $self->{var1} = 'Top set var1';
    $self->{var3} = 'Top set var3';
    return $self;
}


sub clonish {
    my ($class, $other, %params) = @_;

    return bless {%$other, %params}, $class;
}


sub doPrint {
    my ($self) = @_;
    my $type = ref $self;
    
    print "Test ($type): $_ => $self->{$_}\n" for keys %$self;
}


package Top::Extend1;

push @Top::Extend1::ISA, 'Top';

sub doPrint {
    my ($self) = @_;
    my $type = ref $self;
    
    print "Override ($type): $_ => $self->{$_}\n" for keys %$self;
}


package Top::Extend2;

push @Top::Extend2::ISA, 'Top';

sub new {
    my ($class, %params) = @_;
    my $self = $class->SUPER::new(%params);
    
    $self->{var1} = 'Top::Extend2 set var1';
    return $self;
}


package main;

my $test = Top->new(passed1 => 'this is copied');
my $one  = Top::Extend1->clonish($test);
my $two  = Top::Extend2->clonish($test, something => 'extra');

$test->doPrint();
$one->doPrint();
$two->doPrint();

##</code><code>##

Test (Top): var3 => Top set var3
Test (Top): var1 => Top set var1
Test (Top): passed1 => this is copied
Override (Top::Extend1): var3 => Top set var3
Override (Top::Extend1): var1 => Top set var1
Override (Top::Extend1): passed1 => this is copied
Test (Top::Extend2): var3 => Top set var3
Test (Top::Extend2): var1 => Top set var1
Test (Top::Extend2): passed1 => this is copied
Test (Top::Extend2): something => extra