view release on metacpan or  search on metacpan

lib/App/MtAws/HttpSegmentWriter.pm  view on Meta::CPAN

	my $self = $_[0];
	return unless defined($_[1]);
	my $len = length($_[1]);
	$self->{buffer} .= $_[1];
	$self->{pending_length} += $len;
	$self->{total_length} += $len;
	if ($self->{pending_length} > $self->{write_threshold}) {
		$self->_flush();
	}
	1;
}

sub _flush
{
	confess "not implemented";
}

sub treehash
{
	undef;
}

sub _flush_buffers
{
	my ($self, @files) = @_;
	my $len = length($self->{buffer});
	for my $fh (@files) {
		print $fh $self->{buffer} or confess "cant write to file $!";
	}
	if (my $th = $self->treehash) {
		$th->eat_data_any_size($self->{buffer});
	}
	$self->{total_commited_length} += $len;
	$self->{buffer} = '';
	$self->{pending_length} = 0;
	$len;
}

sub finish
{
	my ($self) = @_;
	$self->_flush();
	$self->{total_commited_length} == $self->{total_length} or confess;
	return ($self->{total_length} && ($self->{total_length} == $self->{size})) ? ('ok') : ('retry', 'Unexpected end of data');
}

package App::MtAws::HttpSegmentWriter;

our $VERSION = '1.120';

use strict;
use warnings;
use utf8;
use App::MtAws::Utils;
use Fcntl qw/SEEK_SET LOCK_EX/;
use Carp;
use base qw/App::MtAws::HttpWriter/;


# when file not found/etc error happen, it can mean Temp file deleted by another process, so we
# don't need to throw error, most likelly signal will arrive in a few milliseconds
sub delayed_confess(@)
{
	sleep 2;
	confess @_;
}


sub new
{
	my ($class, %args) = @_;
	my $self = \%args;
	bless $self, $class;
	$self->SUPER::initialize();
	$self->initialize();
	return $self;
}

sub initialize
{
	my ($self) = @_;
	defined($self->{filename}) or confess;
	defined($self->{tempfile}) or confess;
	defined($self->{position}) or confess;
}

sub reinit
{
	my $self = shift;
	$self->{incr_position} = 0;
	$self->{treehash} = App::MtAws::TreeHash->new();
	$self->SUPER::reinit(@_);
}

sub treehash { shift->{treehash} }

sub _flush
{
	my ($self) = @_;
	if ($self->{pending_length}) {
		open_file(my $fh, $self->{tempfile}, mode => '+<', binary => 1) or delayed_confess "cant open file $self->{tempfile} $!";
		flock $fh, LOCK_EX or delayed_confess;
		$fh->flush();
		$fh->autoflush(1);
		seek $fh, $self->{position}+$self->{incr_position}, SEEK_SET or delayed_confess "cannot seek() $!";
		$self->{incr_position} += $self->_flush_buffers($fh);
		close $fh or delayed_confess; # close will unlock
	}
}

sub finish
{
	my ($self) = @_;
	my @r = $self->SUPER::finish();
	return @r;
}


package App::MtAws::HttpFileWriter;

our $VERSION = '1.120';