如何继承 IO::Handle 以在没有文件或内存的情况下正确获取低级文件句柄？

Question

我有一个访问 PostgreSQL 数据库的应用程序，需要根据某些需要的处理从中读取一些大型二进制数据。这可能是数百 MB 甚至几 GB 的数据。请不要讨论使用文件系统等问题，现在就是这样。

该数据只是各种类型的文件，例如它可能是一个 Zip 容器或某种其他类型的存档。一些需要的处理是列出 Zip 的内容，甚至可能提取一些成员进行进一步处理，可能对存储的数据进行哈希处理......最后数据被多次读取，但只写入一次以存储它。

我使用的所有 Perl 库都可以使用文件句柄，有些可以使用 IO::Handle，有些可以使用 IO::String 或 IO::Scalar，有些只能使用低级文件句柄.所以我所做的是创建 IO::Handle 和 IO::Seekable 的子类，它就像 DBD::Pg 周围相应方法的包装器。在 CTOR 中，我创建到数据库的连接，打开一些提供的 LOID 以供读取，并将 Postgres 提供的句柄存储在实例中。然后我自己的句柄对象被转发给任何能够使用这样的文件句柄并且可以直接在 Postgres 提供的 blob 中读取和查找的人。

问题是在 IO::Handle 上使用低级文件句柄或低级文件句柄操作的库。 Digest::MD5好像是一个，Archive::Zip又是一个。 Digest::MD5 croaks 并告诉我没有提供句柄，另一方面 Archive::Zip 试图从我的创建一个新的，自己的句柄，调用 IO::Handle::fdopen 并失败我的情况。

sub fdopen {
    @_ == 3 or croak 'usage: $io->fdopen(FD, MODE)';
    my ($io, $fd, $mode) = @_;
    local(*GLOB);

    if (ref($fd) && "".$fd =~ /GLOB\(/o) {
    # It's a glob reference; Alias it as we cannot get name of anon GLOBs
    my $n = qualify(*GLOB);
    *GLOB = *{*$fd};
    $fd =  $n;
    } elsif ($fd =~ m#^\d+$#) {
    # It's an FD number; prefix with "=".
    $fd = "=$fd";
    }

    open($io, _open_mode_string($mode) . '&' . $fd)
    ? $io : undef;
}

我猜问题出在句柄的低级副本，它删除了我自己的实例，因此不再有实例拥有我的数据库连接和所有这些东西。

那么，在我的情况下，是否有可能提供一些 IO::Handle 可以在需要低级文件句柄的任何地方成功使用？

我的意思是，我没有真正的文件句柄，我只有一个对象，其中方法调用被包装到它们相应的 Postgres 方法中，为此需要数据库句柄等等。所有这些数据都需要存储在某个地方，需要完成包装等等。

我尝试做其他人正在做的事情，例如 IO::String，它还使用 tie。但最终那个用例是不同的，因为 Perl 能够自己创建一个真正的低级文件句柄到一些内部存储器。在我的情况下根本不支持的东西。我需要保留我的实例，因为只有它知道数据库句柄等。

通过调用方法 read 像 IO::Handle 一样使用我的句柄，这样的工作就像预期的那样，但我想更进一步，以便与任何不希望的人更兼容处理 IO::Handle 个对象。很像 IO::String 或 File::Temp 可以用作低级文件句柄。

package ReadingHandle;

use strict;
use warnings;
use 5.10.1;

use base 'IO::Handle', 'IO::Seekable';

use Carp ();

sub new
{
  my $invocant  = shift || Carp::croak('No invocant given.');
  my $db        = shift || Carp::croak('No database connection given.');
  my $loid      = shift // Carp::croak('No LOID given.');
  my $dbHandle  = $db->_getHandle();
  my $self      = $invocant->SUPER::new();

    *$self->{'dbHandle'}  = $dbHandle;
    *$self->{'loid'}      = $loid;
  my $loidFd              = $dbHandle->pg_lo_open($loid, $dbHandle->{pg_INV_READ});
    *$self->{'loidFd'}    = $loidFd;

  if (!defined($loidFd))
  {
    Carp::croak("The provided LOID couldn't be opened.");
  }

  return $self;
}

sub DESTROY
{
  my $self = shift || Carp::croak('The method needs to be called with an instance.');

  $self->close();
}

sub _getDbHandle
{
  my $self = shift || Carp::croak('The method needs to be called with an instance.');

  return *$self->{'dbHandle'};
}

sub _getLoid
{
  my $self = shift || Carp::croak('The method needs to be called with an instance.');

  return *$self->{'loid'};
}

sub _getLoidFd
{
  my $self = shift || Carp::croak('The method needs to be called with an instance.');

  return *$self->{'loidFd'};
}

sub binmode
{
  my $self = shift || Carp::croak('The method needs to be called with an instance.');

  return 1;
}

sub close
{
  my $self      = shift || Carp::croak('The method needs to be called with an instance.');
  my $dbHandle  = $self->_getDbHandle();
  my $loidFd    = $self->_getLoidFd();

  return $dbHandle->pg_lo_close($loidFd);
}

sub opened
{
  my $self    = shift || Carp::croak('The method needs to be called with an instance.');
  my $loidFd  = $self->_getLoidFd();

  return defined($loidFd) ? 1 : 0;
}

sub read
{
  my $self    = shift || Carp::croak('The method needs to be called with an instance.');
  my $buffer  =\shift // Carp::croak('No buffer given.');
  my $length  = shift // Carp::croak('No amount of bytes to read given.');
  my $offset  = shift || 0;

  if ($offset > 0)
  {
    Carp::croak('Using an offset is not supported.');
  }

  my $dbHandle  = $self->_getDbHandle();
  my $loidFd    = $self->_getLoidFd();

  return $dbHandle->pg_lo_read($loidFd, $buffer, $length);
}

sub seek
{
  my $self    = shift || Carp::croak('The method needs to be called with an instance.');
  my $offset  = shift // Carp::croak('No offset given.');
  my $whence  = shift // Carp::croak('No whence given.');

  if ($offset < 0)
  {
    Carp::croak('Using a negative offset is not supported.');
  }
  if ($whence != 0)
  {
    Carp::croak('Using a whence other than 0 is not supported.');
  }

  my $dbHandle  = $self->_getDbHandle();
  my $loidFd    = $self->_getLoidFd();
  my $retVal    = $dbHandle->pg_lo_lseek($loidFd, $offset, $whence);
     $retVal    = defined($retVal) ? 1 : 0;

  return $retVal;
}

sub tell
{
  my $self      = shift || Carp::croak('The method needs to be called with an instance.');
  my $dbHandle  = $self->_getDbHandle();
  my $loidFd    = $self->_getLoidFd();
  my $retVal    = $dbHandle->pg_lo_lseek($loidFd);
     $retVal    = defined($retVal) ? $retVal : -1;

  return $retVal;
}

1;

Answer 1

有办法解决这个问题，但有点奇怪。如果我正确阅读了您的代码和评论，您的要求基本上是三重的：

像普通文件一样工作handle/IO::尽可能处理对象，使用户看不到它不是真实文件的事实。
使用 Archive::Zip，它主要在常规 Perl 中实现，它会调用您发布的 IO::Handle::fdopen 代码，但它无法复制句柄，因为它不是真正的句柄。
使用 Digest::MD5，在 XS 中使用 PerlIO 实现。由于基于 tie 的技巧和内存中的 perl "fake" 文件句柄在该级别不可用，因此它比 2.

您可以使用 PerlIO layers with PerlIO::via 实现所有这三个目标。该代码类似于您使用 tie 编写的代码（实现一些必需的行为方法）。此外，您可以利用 open 的 "open variable as file" 功能和 IO::File 的预滚动 IO::Seekable + IO::Handle 功能来简化上述要求 1 的实现（使其成为可以在 Perl 代码中以与普通 IO::Handle 对象相同的方式使用。

下面是一个可以满足您需要的示例包。它有一些注意事项：

它根本不会扩展您的代码或与数据库交互；它只是使用提供的 lines arrayref 作为文件数据。如果这看起来适合您的用例，您应该调整它以使用数据库。
它实现了以下演示用法所必需的最低限度。在大多数非演示情况下，您需要实现更多方法才能使其成为 "well behaved"（例如，它对 SEEK、EOF、BINMODE、SEEK，等）。请注意，您将要实现的函数的 arguments/expected 行为与您为 tie 或 Tie::Handle 所做的不同； "interface" 名字相同，但合同不同。
所有接收调用者的方法都应该不直接将其用作hashref/globref；他们应该跟踪 *$self->{args} glob 字段中的所有自定义状态。这是因为被祝福的对象被创建了两次（一次被PerlIO祝福，一次被SUPER::new），所以状态需要通过共享引用来共享。如果您替换 args 字段或 add/remove 任何其他字段，它们将只对创建它们的方法集可见：PerlIO 方法或 "normal" 对象方法。有关详细信息，请参阅构造函数中的注释。
PerlIO 通常不是很容易反省。如果在像 sysread 或 <$fh> 这样的低级操作下失败了，很多代码会出错或做意想不到的事情，因为它认为这些功能无法 die/atomic-ish 在运营水平。同样，当使用 PerlIO 时，故障模式很容易逃离 "die or return an error value" 的领域并最终进入 "segfault or core dump" 的领域，特别是如果涉及多个进程（fork()）或线程（这些奇怪的情况是，例如，为什么下面的模块没有围绕 IO::File->new; 实现，然后是 $file->open(... "via:<($class)")；它对我来说是核心转储，不知道为什么）。 TL;DR 调试为什么在 PerlIO 级别出错可能很烦人，你被警告过:)
任何寻址原始文件句柄或不通过 PerlIO perlapi 函数工作的 XS 代码都不会接受这一点。不幸的是，有很多这样的 CPAN 模块，但通常不常见，而且支持良好。基本上，Digest::MD5 不适用于绑定句柄，因为它在 "below" tie 的魔力水平上运行； PerlIO 比那个级别 "lower"，但还有另一个级别。
这段代码有点乱，当然可以清理一下。特别是，直接 open() 分层对象可能会好一点，跳过所有奇怪的伪间接对象的东西，然后用 IO::Handle 其他方式包装它，例如通过 IO::Wrap.
PerlIO 在许多旧得多的 Perls 上不工作，或者工作方式不同。

包裹：

package TiedThing;

use strict;
use warnings;
use parent "IO::File";

our @pushargs;
sub new {
    my ( $class, $args ) = @_;
    # Build a glob to be used by the PerlIO methods. This does two things:
    # 1. Gets us a place to stick a shared hashref so PerlIO methods and user-
    # -defined object methods can manipulate the same data. They must use the
    # {args} glob field to do that; new fields written will .
    # 2. Unifies the ways of addressing that across custom functions and PerlIO
    # functions. We could just pass a hashref { args => $args } into PUSHED, but
    # then we'd have to remember "PerlIO functions receive a blessed hashref,
    # custom functions receive a blessed glob" which is lame.
    my $glob = Symbol::gensym();
    *$glob->{args} = $args;
    local @pushargs = ($glob, $class);
    my $self = $class->SUPER::new(\my $unused, "<:via($class)");
    *$self->{args} = $args;
    return $self;
}

sub custom {
    my $self = shift;
    return *$self->{args}->{customvalue};
}

sub PUSHED { return bless($pushargs[0], $pushargs[1]); }

sub FILL { return shift(@{*$_[0]->{args}->{lines}}); }

1;

用法示例：

my $object = TiedThing->new({
    lines => [join("\n", 1..9, 1..9)],
    customvalue => "custom!",
});
say "can call custom method: " . $object->custom;
say "raw read with <>: " . <$object>;
my $buf;
read($object, $buf, 10);
say "raw read with read(): " . $buf;
undef $buf;
$object->read($buf, 10);
say "OO read via IO::File::read (end): " . $buf;
my $checksummer = Digest::MD5->new;;
$checksummer->addfile($object);
say "Md5 read: " . $checksummer->hexdigest;
my $dupto = IO::Handle->new;
# Doesn't break/return undef; still not usable without implementing
# more state sharing inside the object.
say "Can dup handle: " . $dupto->fdopen($object, "r");

my $archiver = Archive::Zip->new;
# Dies, but long after the fdopen() call. Can be fixed by implementing more
# PerlIO methods.
$archiver->readFromFileHandle($object);

如何继承 IO::Handle 以在没有文件或内存的情况下正确获取低级文件句柄？

How to subclass IO::Handle to properly get a low level file handle without having a file or memory?

postgresql

perl

filehandle

perl-io