The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/env perl
# -*- mode: perl; coding: utf-8 -*-
#----------------------------------------
use strict;
use warnings FATAL => qw(all);
use FindBin;
BEGIN {
  if (-d (my $dir = "$FindBin::RealBin/../../../../t")) {
    local (@_, $@) = $dir;
    do "$dir/t_lib.pl";
    die $@ if $@;
  }
}

use Cwd ();
my ($app_root);
BEGIN {
  if (-r __FILE__) {
    # detect where app.psgi is placed.
    $app_root = dirname(dirname(File::Spec->rel2abs(__FILE__)));
  } else {
    # older uwsgi do not set __FILE__ correctly, so use cwd instead.
    $app_root = Cwd::cwd();
  }
}
#----------------------------------------
use 5.010;

use YATT::Lite::Breakpoint;
use YATT::Lite::Test::XHFTest2;
use base qw(YATT::Lite::Test::XHFTest2);
use fields qw(base_url);
use YATT::Lite::Util qw(lexpand);
use YATT::t::t_preload; # To make Devel::Cover happy.

my MY $tests = MY->load_tests([dir => "$FindBin::Bin/../html"]
			      , @ARGV ? @ARGV : $FindBin::Bin);
$tests->enter;

plan $tests->test_plan;

$tests->mechanized(new WWW::Mechanize(max_redirect => 0));

sub test_plan {
  my MY $tests = shift;
  unless (eval {require WWW::Mechanize}) {
    return skip_all => 'WWW::Mechanize is not installed';
  }

  unless (-d "cgi-bin" and grep {-x "cgi-bin/runyatt.$_"} qw(cgi fcgi)) {
    return skip_all => "Can't find cgi-bin/runyatt.cgi";
  }

  unless (-r ".htaccess") {
    return skip_all => "Can't find .htaccess";
  }

  unless (my $cgi_url = $tests->find_yatt_handler('.htaccess')) {
    return skip_all => "Can't find cgi-url from .htaccess";
  } else {
    ($tests->{base_url} = $cgi_url) =~ s|/cgi-bin/\w+\.f?cgi$|/|;
  }

  $tests->SUPER::test_plan;
}

sub base_url {
  my MY $tests = shift;
  "http://localhost$tests->{base_url}";
}

sub ntests_per_item {
  (my MY $tests, my Item $item) = @_;
  lexpand($item->{cf_HEADER})/2
    + (($item->{cf_BODY} || $item->{cf_ERROR}) ? 1 : 0);
}

sub find_yatt_handler {
  my $pack = shift;
  local $_;
  foreach my $fn (@_) {
    open my $fh, '<', $fn or do { warn "$fn: $!"; next };
    while (<$fh>) {
      next unless m/^Action\s+x-yatt-handler\s+(\S+)/;
      return $1;
    }
  }
}