view release on metacpan or  search on metacpan

t/05remote.t  view on Meta::CPAN

      $headers{'Content-Range'} = "bytes $start-$actual_end/$total_size";
    }

    return [
      $code,
      [%headers],
      [ $$content ]
    ];
  });
  ok(defined $httpd, 'Got a web server');
  note( sprintf "You can connect to your server at %s.\n", $httpd->host_port );
  return $httpd;
};

Bio::DB::Big->init();

subtest 'Testing opening remote BigWig file' => sub {
  my $httpd = $get_server->();
  my $url_root = $httpd->endpoint;
  my $bw_file = "${url_root}/test.bw";
  note $bw_file;
  {
    my $big = Bio::DB::Big->open($bw_file);
    is($big->type(), 0, 'Type of file should be 0 i.e. a bigwig file');
  }

  {
    is(Bio::DB::Big::File->test_big_wig($bw_file), 1, 'Expect a bigwig file to report as being a bigwig');
    is(Bio::DB::Big::File->test_big_bed($bw_file), 0, 'Expect a bigwig file to report as not being a bigbed');
    my $big = Bio::DB::Big::File->open_big_wig($bw_file);
    ok($big, 'Testing we have an object');
    is($big->type(), 0, 'Type of file should be 0 i.e. a bigwig file');
  }
};

subtest 'Testing opening remote BigBed file' => sub {
  my $httpd = $get_server->();
  my $url_root = $httpd->endpoint;
  my $bb_file = "${url_root}/test.bb";
  note $bb_file;
  {
    my $big = Bio::DB::Big->open($bb_file);
    is($big->type(), 1, 'Type of file should be 0 i.e. a bigbed file');
  }
  is(Bio::DB::Big::File->test_big_wig($bb_file), 0, 'Expect a bigbed file to report as being a bigbed');
  is(Bio::DB::Big::File->test_big_bed($bb_file), 1, 'Expect a bigbed file to report as not being a bigbed');
  my $big = Bio::DB::Big::File->open_big_bed($bb_file);
  ok($big, 'Testing we have an object');
  is($big->type(), 1, 'Type of file should be 0 i.e. a bigbed file');
};

subtest 'Checking that we can influence the CURL opts' => sub {
  my $httpd = $get_server->();
  my $url_root = $httpd->endpoint;
  
  {
    my $bw_file = "${url_root}/test.bw";
  
    Bio::DB::Big->timeout(1);
  
    my $err_regex = qr/Timeout was reached/;
    stderr_like(sub {
      Bio::DB::Big::File->test_big_wig($bw_file)
    }, $err_regex, 'Checking a low timeout causes connection issues');
  
    Bio::DB::Big->timeout(0);
    stderr_unlike(sub {
      Bio::DB::Big::File->test_big_wig($bw_file)
    }, $err_regex, 'Resetting timeout to 0 makes the error go away');

  }
  
  {
    my $bw_file = "${url_root}/moved/test.bw";
    Bio::DB::Big->follow_redirects(1);
    my $bw = Bio::DB::Big::File->test_big_wig($bw_file);
    ok(defined $bw, 'Checking we can find the moved bigwig file with 302 HTTP responses');
    Bio::DB::Big->follow_redirects(0);
    Bio::DB::Big->timeout(200);
    
    # We are doing two nested tests here. 
    # First layer checks for perl exception. 
    # Second layer checks libcurl writes an error to STDERR
    dies_ok { 
      stderr_like(sub {
          Bio::DB::Big::File->open_big_wig($bw_file)
        },
        qr/timeout/i,
        'Checking we get an error from libcurl to stderr'
      );
    } 'Check that not following redirects causes an exception';
    Bio::DB::Big->timeout(0);
  }
};

done_testing();