view release on metacpan or  search on metacpan

lib/File/KDBX/IO.pm  view on Meta::CPAN

package File::KDBX::IO;
# ABSTRACT: Base IO class for KDBX-related streams

use warnings;
use strict;

use Devel::GlobalDestruction;
use File::KDBX::Constants qw(:bool);
use File::KDBX::Util qw(:class :empty);
use List::Util qw(sum0);
use Ref::Util qw(is_blessed_ref is_ref is_scalarref);
use Symbol qw(gensym);
use namespace::clean;

extends 'IO::Handle';

our $VERSION = '0.906'; # VERSION

sub _croak { require Carp; goto &Carp::croak }

my %ATTRS = (
    _append_output  => 0,
    _buffer_in      => sub { [] },
    _buffer_out     => sub { [] },
    _error          => undef,
    _fh             => undef,
    _mode           => '',
);
while (my ($attr, $default) = each %ATTRS) {
    no strict 'refs'; ## no critic (ProhibitNoStrict)
    *$attr = sub {
        my $self = shift;
        *$self->{$attr} = shift if @_;
        *$self->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default;
    };
}

sub new {
    my $class = shift || (caller)[0];
    my $self = bless gensym, ref($class) || $class;
    tie *$self, $self if 5.005 <= $];
    return $self;
}

sub DESTROY {
    return if in_global_destruction;
    local ($., $@, $!, $^E, $?);
    my $self = shift;
    $self->close;
}

sub close {
    my $self = shift;
    my $fh = $self->_fh // return TRUE;
    $self->_POPPED($fh);
    $self->_fh(undef);
    return $fh->close;
}
sub eof {
    my $self = shift;
    return FALSE if @{$self->_buffer_in};
    my $fh = $self->_fh // return TRUE;
    local *$self->{_error} = *$self->{_error};
    my $char = $self->getc || return TRUE;
    $self->ungetc($char);
}
sub read { shift->sysread(@_) }
sub print {
    my $self = shift;
    for my $buf (@_) {
        return FALSE if !$self->write($buf, length($buf));