view release on metacpan or  search on metacpan

t/unit/open_file.t  view on Meta::CPAN

#!/usr/bin/env perl

# mt-aws-glacier - Amazon Glacier sync client
# Copyright (C) 2012-2014  Victor Efimov
# http://mt-aws.com (also http://vs-dev.com) vs@vs-dev.com
# License: GPLv3
#
# This file is part of "mt-aws-glacier"
#
#    mt-aws-glacier is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    mt-aws-glacier is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.


use strict;
use warnings;
use utf8;
use Test::More tests => 50;
use Test::Deep;
use Encode;
use FindBin;

# before 'use xxx Utils'
our $OpenStack = undef;
our $BinmodeStack = undef;
sub _open { CORE::open($_[0], $_[1], $_[2]) };
BEGIN { no warnings 'once'; *CORE::GLOBAL::open = sub(*;$@) { push @$OpenStack, \@_; _open(@_) }; };
BEGIN { no warnings 'once'; *CORE::GLOBAL::binmode = sub(*;$) { push @$BinmodeStack, \@_; CORE::binmode($_[0]) }; };


use lib map { "$FindBin::RealBin/$_" } qw{../lib ../../lib};
use TestUtils 'w_fatal';
use Data::Dumper;
use File::Path;


use App::MtAws::Utils;
use App::MtAws::Exceptions;




my $mtroot = get_temp_dir();
my $tmp_file = "$mtroot/open_file_test";

unlink $tmp_file;
rmtree $tmp_file;


sub new_stack(&)
{
	local $OpenStack = [];
	local $BinmodeStack = [];
	shift->();
}

sub last_call()
{
	$OpenStack->[0]
}


#
# mode
#

ok ! defined eval { open_file(my $f, $tmp_file); 1};
ok $@ =~ /Argument "mode" is required/;

ok ! defined eval { open_file(my $f, $tmp_file, mode => 'x'); 1};
ok $@ =~ /unknown mode/;

{
	ok open_file(my $f, $tmp_file, mode => '>', binary => 1);
}

new_stack {
	ok open_file(my $f, $tmp_file, mode => '>', binary => 1);
	is '>', last_call->[1]
};

new_stack {
	ok open_file(my $f, $tmp_file, mode => '>>', binary => 1);
	is '>>', last_call->[1]
};

new_stack {
	ok open_file(my $f, $tmp_file, mode => '>>', binary => 1);

t/unit/open_file.t  view on Meta::CPAN

new_stack {
	local $App::MtAws::Utils::_filename_encoding = 'KOI8-R';
	is get_filename_encoding, 'KOI8-R';
	my $utfname = $mtroot."/тест";
	eval { open_file(my $f, $utfname, mode => '>', binary => 1, use_filename_encoding => 1); };
	is last_call->[2], encode("KOI8-R", $utfname), "should use filename_ecnoding when it's not UTF";
};


new_stack {
	my $utfname = $mtroot."/тест";
	eval { open_file(my $f, $utfname, mode => '>', binary => 1, use_filename_encoding => 0); };
	is last_call->[2], $utfname, "should not use filename_ecnoding";
};

#
# should work
#

{
	create_tmp_file("123");
	open_file(my $f, $tmp_file, mode => '<', binary => 1);
	my @a = <$f>;
	cmp_deeply [@a], ['123'];
}

#
# file checks
#

{
	unlink $tmp_file;
	mkpath $tmp_file;
	ok ! defined eval { open_file(my $f, $tmp_file, mode => '>', binary => 1); 1 };
	ok $@ =~ /not a plain file/i;
	rmtree $tmp_file;
}

{
	create_tmp_file("");
	ok ! defined eval { open_file(my $f, $tmp_file, mode => '<', binary => 1, not_empty=>1); 1 };
	ok $@ =~ /should not be empty/i;
	unlink $tmp_file;
}


unlink $tmp_file;
{
	ok ! defined open_file(my $f, $tmp_file, mode => '<', binary => 1);
}

ok defined eval { open_file(my $f, $tmp_file, mode => '>', binary => 1); 1};
unlink $tmp_file;

unlink $tmp_file;


sub create_tmp_file
{
	CORE::open F, ">", $tmp_file;
	binmode F;
	print F @_ ? shift : "1\n";
	close F;

}

1;