view release on metacpan or  search on metacpan

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

	my $mode = $args{mode};

	confess "not_empty can be used in read mode only"
		if ($args{not_empty} && $args{mode} ne '<');


	if (defined($args{file_encoding})) {
		$mode .= ":encoding($args{file_encoding})";
		confess "cannot use binary and file_encoding at same time'" if $args{binary};
	} elsif (!$args{binary}) {
		confess "there should be file encoding or 'binary'";
	}

	if ($args{use_filename_encoding}) {
		$filename = binaryfilename $filename;
	}

	confess "File is not a plain file" if -e $filename && (! -f $filename);
	confess "File should not be empty" if $args{not_empty} && (! -s $filename);

	open ($_[0], $mode, $filename) or return;
	my $f = $_[0];

	confess unless -f $f; # check for race condition - it was a file when we last checked, but now it's a directory
	confess if $args{not_empty} && (! -s $f);

	binmode $f if $args{binary};

	return $f;
}

sub file_size($%)
{
	my $filename = shift;
	my (%args) = (use_filename_encoding => 1, @_);
	if ($args{use_filename_encoding}) {
		$filename = binaryfilename $filename;
	}
	confess "file not exists" unless -f $filename;
	return -s $filename;
}

sub file_exists($%)
{
	my $filename = shift;
	my (%args) = (use_filename_encoding => 1, @_);
	if ($args{use_filename_encoding}) {
		$filename = binaryfilename $filename;
	}
	return -f $filename;
}

sub file_mtime($%)
{
	my $filename = shift;
	my (%args) = (use_filename_encoding => 1, @_);
	if ($args{use_filename_encoding}) {
		$filename = binaryfilename $filename;
	}
	confess "file not exists" unless -f $filename;
	return stat($filename)->mtime;
}

# TODO: test
sub file_inodev($%)
{
	my $filename = shift;
	my (%args) = (use_filename_encoding => 1, @_);
	if ($args{use_filename_encoding}) {
		$filename = binaryfilename $filename;
	}
	confess "file not exists" unless -e $filename;
	my $s = stat($filename);
	$s->dev."-".$s->ino;
}

sub is_wide_string
{
	defined($_[0]) && utf8::is_utf8($_[0]) && (bytes::length($_[0]) != length($_[0]))
}

# if we have ASCII-only data, let's drop UTF-8 flag in order to optimize some regexp stuff
# TODO: write also version which does not check is_utf8 - it's faster when utf8 always set
sub try_drop_utf8_flag
{
	Encode::_utf8_off($_[0]) if utf8::is_utf8($_[0]) && (bytes::length($_[0]) == length($_[0]));
}

sub sysreadfull_chk($$$)
{
	my $len = $_[2];
	sysreadfull(@_) == $len;
}

sub sysreadfull($$$)
{
	my ($file, $len) = ($_[0], $_[2]);
	my $n = 0;
	while ($len - $n) {
		my $i = sysread($file, $_[1], $len - $n, $n);
		if (defined($i)) {
			if ($i == 0) {
				return $n;
			} else {
				$n += $i;
			}
		} elsif ($!{EINTR}) {
			redo;
		} else {
			return $n ? $n : undef;
		}
	}
	return $n;
}

sub syswritefull_chk($$)
{
	my $length = length $_[1];
	syswritefull(@_) == $length
}

sub syswritefull($$)
{
	my ($file, $len) = ($_[0], length($_[1]));
	confess if is_wide_string($_[1]);
	my $n = 0;
	while ($len - $n) {
		my $i = syswrite($file, $_[1], $len - $n, $n);
		if (defined($i)) {
			$n += $i;
		} elsif ($!{EINTR}) {
			redo;
		} else {