Skip to content

GitLab

Commit 5b897097 authored by Tiago Grego's avatar Tiago Grego
Browse files

basic IO needs to be in core repo

parent aae7c319
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 0 additions and 1004 deletions
modules/Bio/EnsEMBL/Utils/IO.pm deleted 100644 → 0
View file @ aae7c319
This diff is collapsed.
modules/t/utils_io/utilsIo.t deleted 100644 → 0
View file @ aae7c319
# Copyright [1999-2015] Wellcome Trust Sanger Institute and the EMBL-European Bioinformatics Institute
# Copyright [2016-2019] EMBL-European Bioinformatics Institute
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
use strict;
use warnings;
use Test::More;
use Test::Warnings;
use Test::Exception;
use File::Temp;
use Bio::EnsEMBL::Utils::IO qw/:all/;
use IO::String;
my ($tmp_fh, $file) = File::Temp::tempfile();
close($tmp_fh);
unlink $file;
my $contents = <<'EOF';
>X
AAAAGGGTTCCC
TTGGCCAAAAAA
ATTC
EOF
my $expected_array = [qw/>X AAAAGGGTTCCC TTGGCCAAAAAA ATTC/];
{
throws_ok { slurp($file) } qr/No such file/, 'File does not currently exist so die';
work_with_file($file, 'w', sub {
my ($fh) = @_;
print $fh $contents;
return;
});
my $written_contents = slurp($file);
is($contents, $written_contents, 'Contents should be the same');
my $written_contents_ref = slurp($file, 1);
is('SCALAR', ref($written_contents_ref), 'Asked for a ref so expect one back');
is($contents, $$written_contents_ref, 'Contents should be the same');
work_with_file($file, 'r', sub {
my ($fh) = @_;
my $line = <$fh>;
chomp($line);
is($line, '>X', 'First line expected to be FASTA header');
});
my $chomp = 1;
is_deeply(slurp_to_array($file, $chomp), $expected_array, 'Checking slurp to array with chomp');
$chomp = 0;
is_deeply(slurp_to_array($file, $chomp), [ map { $_."\n" } @{$expected_array}], 'Checking slurp to array with chomp');
my $iterator_counter = 0;
iterate_file($file, sub {
my ($line) = @_;
chomp($line);
is($line, $expected_array->[$iterator_counter++], sprintf('Checking line %d is ok', $iterator_counter+1));
return;
});
unlink $file;
dies_ok { slurp($file) } 'File no longer exists so die';
spurt($file, $contents);
my $rewritten_contents = slurp($file);
is($contents, $rewritten_contents, 'Contents should still be the same');
spurt($file, $contents, 'append');
$rewritten_contents = slurp($file);
is($contents.$contents, $rewritten_contents, 'Contents should be doubled');
unlink $file;
}
{
my $content = 'ABCDE1198473' x 33012;
my $src = IO::String->new($content);
{
my $trg = IO::String->new();
move_data($src, $trg);
is(${$trg->string_ref()}, $content, 'Checking copied data is as expected');
}
{
$src->setpos(0);
my $trg = IO::String->new();
move_data($src, $trg, (8*1024*1024)); #8MB
is(${$trg->string_ref()}, $content, 'Checking large buffer copied data is as expected');
}
}
{
gz_work_with_file($file, 'w', sub {
my ($fh) = @_;
print $fh $contents;
return;
});
my $written_contents = gz_slurp($file);
is($contents, $written_contents, 'Gzipped Contents should be the same');
my $non_gz_written_contents = slurp($file);
isnt($contents, $non_gz_written_contents, 'Reading normally should not return the same contents');
my $chomp = 1;
is_deeply(gz_slurp_to_array($file, $chomp), $expected_array, 'Checking slurp to array with chomp');
$chomp = 0;
is_deeply(gz_slurp_to_array($file, $chomp), [ map { $_."\n" } @{$expected_array}], 'Checking slurp to array with chomp');
unlink $file;
dies_ok { slurp($file) } 'File no longer exists so die';
}
my $tmpdir = File::Temp->newdir();
my $dirname = $tmpdir->dirname;
#
# test working with bzip2 and zip files
#
# create a dummy file
my $tmpfile = File::Temp->new(DIR => $dirname, SUFFIX => '.txt');
my $tmpfilename = $tmpfile->filename;
print $tmpfile "test data\n";
print $tmpfile "some more data.";
$tmpfile->close;
my $BZIP2_OK = 0;
eval {
require IO::Compress::Bzip2;
require IO::Uncompress::Bunzip2;
$BZIP2_OK = 1;
};
SKIP: {
skip "Cannot run Bzip2/Bunzip2 tests, install related IO::[Un]Compress modules first",
4 unless $BZIP2_OK;
# send the content of the tmpfile to another
# bzip2 compressed file
my $file_content = slurp($tmpfilename);
my $bz2tmpfile = File::Temp->new(DIR => $dirname, SUFFIX => '.bz2');
bz_work_with_file($bz2tmpfile->filename, 'w', sub {
my ($fh) = @_;
print $fh $file_content;
return;
});
# check the content of the compressed file
my $content = bz_slurp($bz2tmpfile->filename);
like($content, qr/test data/, "Bzip2: correct content");
like($content, qr/more data/, "Bzip2: more correct content");
# test bz_slurp_to_array
my $content_array = bz_slurp_to_array($bz2tmpfile->filename, 1);
ok($content_array->[0] eq 'test data', "Bzip2 slurped file first element");
ok($content_array->[1] eq 'some more data.', "Bzip2 slurped file second element");
}
my $ZIP_OK = 0;
eval {
require IO::Compress::Zip;
require IO::Uncompress::Unzip;
$ZIP_OK = 1;
};
SKIP: {
skip "Cannot run Zip/Unzip tests, install related IO::[Un]Compress modules first",
4 unless $ZIP_OK;
# send the content of the tmpfile to another
# bzip2 compressed file
my $file_content = slurp($tmpfilename);
my $ziptmpfile = File::Temp->new(DIR => $dirname, SUFFIX => '.zip');
zip_work_with_file($ziptmpfile->filename, 'w', sub {
my ($fh) = @_;
print $fh $file_content;
return;
});
# check the content of the compressed file
my $content = zip_slurp($ziptmpfile->filename);
like($content, qr/test data/, "Zip: correct content");
like($content, qr/more data/, "Zip: more correct content");
# test zip_slurp_to_array
my $content_array = zip_slurp_to_array($ziptmpfile->filename, 1);
ok($content_array->[0] eq 'test data', "Zip slurped file first element");
ok($content_array->[1] eq 'some more data.', "Zip slurped file second element");
}
#
# test filtering the content of a directory
#
my $perl_tmp_file1 = File::Temp->new(DIR => $dirname, SUFFIX => '.pl');
my $perl_tmp_file2 = File::Temp->new(DIR => $dirname, SUFFIX => '.pl');
my $perl_tmp_file3 = File::Temp->new(DIR => $dirname, SUFFIX => '.pl');
my $other_tmp_file1 = File::Temp->new(DIR => $dirname, SUFFIX => '.dat');
my $other_tmp_file2 = File::Temp->new(DIR => $dirname, SUFFIX => '.dat');
is(scalar @{Bio::EnsEMBL::Utils::IO::filter_dir($dirname, sub {
my $file = shift;
return $file if $file =~ /\.pl$/;
})}, 3, "Number of entries in filtered and sorted dir");
done_testing();
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment