postgresql - 如何在没有文件或内存的情况下对 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 croak s 并告诉我没有提供句柄，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 能够自己创建一个真正的低级文件句柄到一些内部存储器。在我的情况下根本不支持的东西。我需要保留我的实例，因为只有它知道数据库的句柄等。

像使用 IO::Handle 一样使用我的 handle 通过调用方法 read这样的工作就像预期的那样，但我想更进一步，并与那些不希望在 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

有一种方法可以解决这个问题，但它有点奇怪。如果我正确阅读您的代码和评论，您的要求基本上是三重的:

尽可能像普通的文件句柄/IO::Handle 对象一样工作，使用户不可见它不是真正的文件。

与 Archive::Zip 合作，它主要在常规 Perl 中实现，并调用 IO::Handle::fdopen您发布的代码无法复制句柄，因为它不是真正的句柄。

与 Digest::MD5 合作，这是在 XS 中使用 PerlIO 实现的.自 tie -based 技巧和 perl 内存中的“假”文件句柄在该级别无法使用，它比 2 更技巧。

您可以通过使用 PerlIO layers with PerlIO::via 来实现所有这三个目标。 .该代码类似于您使用 tie 编写的代码。 (实现一些必需的行为方法)。此外，您可以利用 open 的“将变量作为文件打开”功能。和预卷 IO::Seekable + IO::Handle IO::File 的功能简化实现上述要求 1(使其在 Perl 代码中可用，与普通 IO::Handle 对象相同)。

下面是一个可以满足您需求的示例包。它有一些警告:

它根本不会扩展您的代码或与数据库交互；它只是使用提供的 lines arrayref 作为文件数据。如果这看起来适合您的用例，您应该调整它以与数据库一起使用。

它实现了为以下演示用法工作所需的最低限度。在大多数非演示情况下，您需要实现更多方法以使其“表现良好”(例如，它对 SEEK 、 EOF 、 BINMODE 、 SEEK 等一无所知)。请注意，您将要实现的函数的参数/预期行为与您为 tie 所做的不同。或 Tie::Handle ; “接口(interface)”具有相同的名称，但具有不同的契约。

所有接收调用者的方法都不应直接将其用作 hashref/globref；他们应该跟踪 *$self->{args} 中的所有自定义状态全局字段。这是因为受祝福的对象被创建了两次(一次被 PerlIO 祝福，一次被 SUPER::new 祝福)，所以需要通过共享引用来共享状态。如果更换 args字段或添加/删除任何其他字段，它们只会对创建它们的方法集可见:PerlIO 方法或“普通”对象方法。有关更多信息，请参阅构造函数中的注释。

PerlIO 通常不是很容易内省(introspection)。如果在像 sysread 这样的低级操作下出现问题或 <$fh> ，很多代码会出错或做意想不到的事情，因为它认为这些函数在操作级别无法死亡/原子化。类似地，当使用 PerlIO 时，故障模式很容易逃脱“死亡或返回错误值”的领域并最终进入“段错误或核心转储”的领域，特别是如果多个进程( fork() )或线程是涉及(例如，这些奇怪的情况是为什么下面的模块没有在 IO::File->new; 后面跟着 $file->open(... "via:<($class)") 实现；它对我来说是核心转储，不知道为什么)。 TL;DR 调试为什么在 PerlIO 级别出错可能很烦人，你被警告了 :)

任何处理原始文件句柄或不通过 PerlIO perlapi 函数工作的 XS 代码都不会遵守这一点。不幸的是，有很多这些，但通常不常见，支持良好的 CPAN 模块。基本上，Digest::MD5不适用于捆绑的 handle ，因为它在“低于”的级别运行 tie的魔法； PerlIO 比它“低”一个级别，但下面还有另一个级别。

这段代码有点乱，当然可以清理。特别是，它可能会比 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);