如何在没有文件或内存的情况下将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并且告诉我没有提供句柄，另一方面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来使用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

有一种解决方法，但有点奇怪。如果我正确地阅读您的代码和评论，您的要求基本上是三倍的：

1. 尽可能像普通的文件句柄/ IO :: Handle对象一样工作，这使得它不是用户看不到的真实文件。
2. 使用Archive::Zip，它主要在常规Perl中实现，并调用您发布的IO::Handle::fdopen代码，因为它不是真正的句柄，因此无法复制句柄。
3. 使用Digest::MD5，使用PerlIO在XS中实施。由于基于tie的技巧和perl内存中的“假”文件句柄在该级别不可用，因此它比2更加苛刻。

您可以使用PerlIO layers with PerlIO::via完成所有这三项操作。代码类似于您使用tie编写的代码（实现一些必需的行为方法）。此外，您可以利用open的“打开变量作为文件”功能以及IO::Seekable的预先IO::Handle + IO::File功能来简化上述要求1（make它可以在Perl代码中以与普通IO::Handle对象相同的方式使用。）

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

• 它根本不会扩展您的代码或与DB交互;它只使用提供的lines arrayref作为文件数据。如果这看起来像是适合您的用例，您应该使其适应数据库。
• 它实现了以下演示用法所需的最低。在大多数非演示案例中，您需要实现更多方法以使其“表现良好”（例如，它不知道SEEK，EOF，BINMODE，{{1等等。请注意，您要实现的函数的参数/预期行为与您对SEEK或Tie::Handle所执行的操作不同。 “界面”具有相同的名称，但签订了不同的合同。
• 接收调用者的所有方法都应不直接将其用作hashref / globref;他们应该跟踪tie glob字段中的所有自定义状态。这是因为祝福对象是两次（一旦被PerlIO祝福，一次被*$self->{args}祝福），所以状态需要通过共享引用共享。如果替换SUPER::new字段或添加/删除任何其他字段，它们将仅对创建它们的方法集可见：PerlIO方法或“普通”对象方法。有关详细信息，请参阅构造函数中的注释。
• PerlIO一般来说不容易反省。如果某些内容在args或sysread之类的低级操作下失败，那么很多代码都会出错或做出意想不到的事情，因为它认为这些函数无法死亡/原子化操作水平。类似地，当弄乱PerlIO时，失败模式很容易逃脱“死亡或返回错误值”的境界，并最终进入“段错误或核心转储”领域，尤其是在多个进程（<$fh>）或涉及线程（例如，这些奇怪的情况是为什么下面的模块没有在fork()后面跟IO::File->new;实现;为我核心转储，不明白为什么）。 TL; DR调试PerlIO级别出错的原因可能很烦人，你被警告：）
• 任何解决原始文件句柄或不通过PerlIO perlapi函数工作的XS代码都不会遵守此规定。不幸的是，很多这些，但通常不是常见的，支持良好的CPAN模块。基本上，$file->open(... "via:<($class)")不适用于绑定句柄，因为它在“低于”Digest::MD5的魔法水平下运行; PerlIO比这更“低”，但还有另一个级别。
• 这段代码有点混乱，当然可以清理。特别是，直接tie分层对象可能会更好一点，跳过所有奇怪的伪间接对象的东西，然后以其他方式将其包装在IO :: Handle中，例如，通过IO::Wrap。
• PerlIO在许多旧版本的Perls上不起作用或工作方式不同。

包装：

open()

使用示例：

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;