#! /usr/bin/perl -w
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

######################### We start with some black magic to print on failure.

# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)

BEGIN { $| = 1; print "1..37\n"; }
END {print "not ok 1\n" unless $loaded;}
use Text::xSV;
$loaded = 1;
print "ok 1\n";

######################### End of black magic.

# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):

my $tests_done = 1;

my $csv = new Text::xSV(filename => "test.csv");
ok();

$csv->bind_header();
ok();

# With the first row test the mechanics...

# True while fetch row
$csv->get_row() ? ok() : not_ok();

my @results = $csv->extract("one", "two");
ok();

(("hello" eq $results[0] and "world" eq $results[1]))
  ? ok() : not_ok();

my %hash = $csv->extract_hash();
ok();

(("hello" eq $hash{one} and "world" eq $hash{two}))
  ? ok() : not_ok();

my $hash_ref = $csv->extract_hash();
ok();

(("hello" eq $hash_ref->{one} and "world" eq $hash_ref->{two}))
  ? ok() : not_ok();


# The field "One" is missing..until I make that an alias.
eval {
  $csv->extract("One");
};
$@ ? ok() : not_ok();
$csv->alias("one", "One");
ok();
(($csv->extract("One"))[0] eq "hello")
  ? ok()
  : not_ok();
$csv->delete("One");
ok();
eval {
  $csv->extract("One");
};
$@ ? ok() : not_ok();
my $called = 0;
$csv->add_compute("full message", sub {
  my $self = shift;
  $called++;
  return join " ", map {
    defined($_) ? $_ : "<undef>"
  } $self->extract("one", "two");
});
ok();
(($csv->extract("full message"))[0] eq "hello world")
  ? ok() : not_ok();
# Test that deep recursion doesn't stop me from calling it again.
$csv->extract("full message");
ok();
# Caching works?
(1== $called) ? ok() : not_ok();

my @headers = $csv->get_fields;
ok();
@headers = sort @headers;
("@headers" eq "full message one test two")
  ? ok() : not_ok();

# I should catch infinite recursion
$csv->add_compute("recurse", sub {(shift)->extract("recurse")});
eval {
  $csv->extract("recurse");
};
($@ =~ m/^Infinite recursion detected/)
  ? ok() : not_ok();

test_row(undef, undef);
# And caching does not carry across rows
(($csv->extract("full message"))[0] eq "<undef> <undef>")
  ? ok() : not_ok();

test_row("hello", "world");
test_row("return\nhere","quotes\"here");
test_row("","");
test_row("",undef);

test_row("abcd" x 2000, "1234");
test_row("abcd" x 100000, "ABCD");

# And now test the fetchrow version, but we will still have
# the above deep recursion error so...
my $error;

$csv->set_error_handler( sub {$error = shift} );
ok();

%hash = $csv->fetchrow_hash();
ok();

(("hello" eq $hash{one} and "world" eq $hash{two}))
  ? ok() : not_ok();

$hash{"full message"} eq "hello world"
  ? ok() : not_ok();

($error =~ /Infinite recursion/) ? ok() : not_ok();

# end of file
$csv->get_row() ? not_ok() : ok();

# Test that invalid separators are caught.
my $problem_caught = 0;
$csv = Text::xSV->new(
  error_handler => sub {
    $problem_caught++ if $_[0] =~ /not of length 1/;
  },
  sep => "too long",
);
$problem_caught ? ok() : not_ok();

sub not_ok {
  print "not ";
  ok();
}

sub ok {
  $tests_done++;
  print "ok $tests_done\n";
}

# Takes two arrays by reference, sees that they match
sub test_arrays_match {
  my ($ary_1, $ary_2) = @_;
  if (@$ary_1 != @$ary_2) {
    not_ok();
    return;
  }
  foreach (0..$#$ary_1) {
    if (
      defined($ary_1->[$_]) != defined($ary_2->[$_])
        or (
        defined($ary_1->[$_])
          and
        $ary_1->[$_] ne $ary_2->[$_]
      )
    ) {
      not_ok();
      return;
    }
  }
  ok();
}

sub test_row {
  unless ($csv->get_row()) {
    not_ok();
    return;
  } 
  #print STDERR $csv->extract("test"), "\n";
  test_arrays_match([@_], [$csv->extract("one", "two")]);
}
