package My::Win32::Console;
use warnings;
use strict;
use parent qw( Win32::Console );

sub new {
    my($class, $param1, $param2) = @_;
    my $self = {};
    if (defined($param1)
    and ($param1 == constant("STD_INPUT_HANDLE",  0)
    or   $param1 == constant("STD_OUTPUT_HANDLE", 0)
    or   $param1 == constant("STD_ERROR_HANDLE",  0)))
    {
        $self->{'handle'} = _GetStdHandle($param1);
        # https://rt.cpan.org/Public/Bug/Display.html?id=33513#txn-577224:
        $self->{'handle_is_std'} = 1;
    }
    else {
        $param1 = constant("GENERIC_READ", 0)    | constant("GENERIC_WRITE", 0) unless $param1;
        $param2 = constant("FILE_SHARE_READ", 0) | constant("FILE_SHARE_WRITE", 0) unless $param2;
        $self->{'handle'} = _CreateConsoleScreenBuffer($param1, $param2,
                                              constant("CONSOLE_TEXTMODE_BUFFER", 0));
    }
    bless $self, $class;
    return $self;
}

sub DESTROY {
    my($self) = @_;
    # https://rt.cpan.org/Public/Bug/Display.html?id=33513#txn-577224:
    #_CloseHandle($self->{'handle'});
    _CloseHandle($self->{'handle'}) unless $self->{'handle_is_std'};
}

1;
__END__

当我尝试应用此补丁时 https://rt.cpan.org/Public/Bug/Display.html?id=33513#txn-577224在这个模块的帮助下，我得到了这个错误信息:

# Use of inherited AUTOLOAD for non-method My::Win32::Console::constant()
# is no longer allowed at C:/Strawberry/perl/site/lib/My/Win32/Console.pm line 10.

有没有办法让它工作？

最佳答案

问题是您正在调用许多 Win32::Console 子程序，就好像它们在 My::Win32::Console 中一样。

解决方案 1:正确引用 sub。

• 将 constant 的五个实例替换为 Win32::Console::constant。
• 将 _CreateConsoleScreenBuffer 的单个实例替换为 Win32::Console::_CreateConsoleScreenBuffer。
• 将 _CloseHandle 的单个实例替换为 Win32::Console::_CloseHandle。

解决方案 2:导入所需的 sub。

添加以下内容:

BEGIN {
   *My::Win32::Console::constant                   = \&Win32::Console::constant;
   *My::Win32::Console::_CreateConsoleScreenBuffer = \&Win32::Console::_CreateConsoleScreenBuffer;
   *My::Win32::Console::_CloseHandle               = \&Win32::Console::_CloseHandle;
}

也就是说，我认为继承在这里是不合适的(而且做得很差)。猴子补丁将是首选。

package Win32::Console::PatchForRT33513;

use strict;
use warnings;

use Win32::Console qw( );

{
    my $old_new = Win32::Console->can('new');
    my $new_new = sub {
        my ($class, $param1, $param2) = @_;
        my $self = $old_new->(@_);
        $self->{handle_is_std} = 1
            if defined($param1)
               && (  $param1 == Win32::Console::constant("STD_INPUT_HANDLE",  0)
                  || $param1 == Win32::Console::constant("STD_OUTPUT_HANDLE", 0)
                  || $param1 == Win32::Console::constant("STD_ERROR_HANDLE",  0)
                  );

        return $self;
    };

    no warnings qw( redefine );
    *Win32::Console::new = $new_new;
}

{
    my $old_DESTROY = Win32::Console->can('DESTROY');
    my $new_DESTROY = sub {
        my ($self) = @_;
        Win32::Console::_CloseHandle($self->{handle}) if !$self->{handle_is_std};
    };

    no warnings qw( redefine );
    *Win32::Console::DESTROY = $new_DESTROY;
}

1;

这样，继承自 Win32::Console 的模块就不会损坏，您仍然可以继续使用

use Win32::Console qw( STD_OUTPUT_HANDLE );
my $c = Win32::Console->new(STD_OUTPUT_HANDLE);

只要你先做到以下几点:

use Win32::Console::PatchForRT33513;

关于windows - 如何为非方法工作创建继承的 AUTOLOAD？，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/51905987/