*{"A::doit"} = \&{"D::doit"};
[download]

In my real problem I can't modify any class which is parent to C. Because this will break all.

I must admit that the desired output still leaves me puzzled, but you can reach a solution without using aliases, inheritance or possibly even multiple inheritance. Simply pass a D object as an optional parameter to C's doit() method. My solution below uses Moose, i cannot stress how incredibly useful Moose is, especially if you are considering using multiple inheritance (look into roles). Hope this helps. :)

#!/usr/bin/perl -l
package A;
use Moose;
sub doit { warn "A::doit\n" }


package B;
use Moose;
extends 'A';
sub doit {
    my ($self, $class) = @_;
    warn "B::doit\n";
    return $class ? $class->doit : $self->SUPER::doit;
}


package C;
use Moose;
extends 'B';


package D;
use Moose;
sub doit { warn "D::doit\n" }


package main;
my $c = C->new;
$c->doit( D->new );
[download]

output:

B::doit
D::doit

L-LL-L--L-LL-L--L-LL-L--
-R--R-RR-R--R-RR-R--R-RR
B--B--B--B--B--B--B--B--
H---H---H---H---H---H---
(the triplet paradiddle with high-hat)

In your solution I need to modify B class, but I really can't. Any modifications of classes parent to C will break all. And I can not do this modifications in source code, I need to do it at runtime.

"Any modifications of classes parent to C will break all."

If you have a good unit test suite then you should be able to make such a change and find what the change broke elsewhere and correct the problem. I would prefer to correct incorrect code rather than add more incorrect code to fix a symptom.

jeffa

L-LL-L--L-LL-L--L-LL-L--
-R--R-RR-R--R-RR-R--R-RR
B--B--B--B--B--B--B--B--
H---H---H---H---H---H---
(the triplet paradiddle with high-hat)

Yes, it helped me. Thanks

{
    package C;
    sub doit {
        no strict 'refs';
        local *{"A::doit"} = \&{"D::doit"};
        shift->SUPER::doit;
    }
}
[download]

This really helpfull. It seems I can solve my problem with this technique. Thank you.

Take a step back and tell us what do you really need to accomplish, not how you thought you could do it. Even if you could somehow subvert the parent class of B when inherited by D it would be very dirty and frail.

Yes, It seems my problem described incorrectly. I tried not to go into details.
Ok, here it is...
I am trying to develop module IO::Socket::Socks::Wrapper, just for fun and skills. And recently found that not all modules could be wrapped correctly with current version. For example:

use IO::Socket::Socks::Wrapper (
        Net::HTTPS => {
            ProxyAddr => 'localhost',
            ProxyPort => 1080,
            SocksDebug => 1,
            SocksVersion => 5
        }
);
use Net::HTTPS;

my $s = Net::HTTPS->new(Host => "encrypted.google.com") || die $@;

$s->write_request(GET => "/", 'User-Agent' => "Mozilla/5.0");
my($code, $mess, %h) = $s->read_response_headers;

while(1) {
    my $buf;
    my $n = $s->read_entity_body($buf, 1024);
    die "read failed: $!" unless defined $n;
    last unless $n;
    print $buf;
}
[download]

This doesn't work because Net::HTTPS inherits from Net::SSL and then only Net::SSL inherits from IO::Socket::INET. So, when we exports our connect function to Net::HTTPS it will be called instead of Net::SSL::connect. But Net::SSL::connect has some stuff for creating encription. So creating of the socket will fail.
But, this will work with Net::HTTP, because it directly inherits from IO::Socket::INET.
I need to solve this problem. And it seems advice about local() from Javafan helped me. Here below is what I got and it seems it works. However I need more tests. If someone can tell me less ugly way to do it, you are welcome.

package IO::Socket::Socks::Wrapper;

use strict;
use Socket;
use base 'Exporter';

our $VERSION = 0.01;
our @EXPORT_OK = 'connect';

sub import
{
    my $pkg = shift;
    
    while(my ($module, $cfg) = splice @_, 0, 2) {
        unless(defined $cfg) {
            $cfg = $module;
            $module = undef;
        }
        
        if($module) {
            # override connect() in the package
            eval "require $module"
                or die $@;
            
            if($module->isa('IO::Socket::INET')) {
                *connect = sub(*$) {
                    local(*IO::Socket::INET::connect) = sub(*$) {
                        _connect(@_, $cfg);
                    };
                    
                    my $self = shift;
                    my $ref = ref($self);
                    no strict 'refs';
                    
                    foreach my $parent (@{$ref.'::ISA'}) {
                        if($parent->isa('IO::Socket::INET')) {
                            bless $self, $parent;
                            $self->connect(@_);
                            bless $self, $ref;
                            return $self;
                        }
                    }
                }
            }
            else {
                *connect = sub(*$) {
                    _connect(@_, $cfg);
                }
            }
            
            $pkg->export($module, 'connect');
        }
        else {
            # override connect() globally
            *connect = sub(*$) {
                _connect(@_, $cfg);
            };
            
            $pkg->export('CORE::GLOBAL', 'connect');
        }
    }
}

sub _connect
{
    my ($socket, $name, $cfg) = @_;
    my $ref = ref($socket);
    
    return CORE::connect( $socket, $name )
        if (($ref && $socket->isa('IO::Socket::Socks')) || !$cfg);
        
    my ($port, $host) = sockaddr_in($name);
    $host = inet_ntoa($host);
    
    # global overriding will not work with `use' pragma
    require IO::Socket::Socks;
    
    IO::Socket::Socks->new_from_socket(
        $socket,
        ConnectAddr  => $host,
        ConnectPort  => $port,
        %$cfg
    ) or return;
    
    bless $socket, $ref
        if $ref && $ref ne 'GLOB';
}

1;
[download]