The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

use strict;

# check if we can run Test::Exception
BEGIN
{
  eval { require Test::Exception; Test::Exception->import };
  if ($@)
  {
    print "1..0 # Skipped: no Test::Exception\n";
    exit;
  }
}

use Test::More tests => 10;
use Test::Exception;

use Test::DatabaseRow;

# check we get the correct error message
throws_ok { row_ok }
  qr/No dbh passed and no default dbh set/, "no dbh";

# define a new default database
$Test::DatabaseRow::dbh = FakeDBI->new;

# no table test
throws_ok { row_ok }
  qr/No 'table' passed as an argument/, "no table";

# no where test
throws_ok { row_ok( table => "foo" ) }
  qr/No 'where' passed as an argument/, "no where";

# bad where tests
throws_ok { row_ok( table => "foo",
                    where => \"wibble" ) }
  qr/Can't understand the argument passed in 'where'/, "bad where";

throws_ok { row_ok( table => "foo",
                    where => { foo => [ this => "wrong" ] } ) }
  qr/Can't understand the argument passed in 'where'/, "bad where 2";

# no tests - this is okay now
#throws_ok { row_ok( table => "foo",
#                    where => [ fooid => 123 ] ) }
#  qr/No 'tests' passed as an arguement/, "no tests";

# odd tests
throws_ok { row_ok( table => "foo",
                    where => [ fooid => 123 ] ,
                    tests => \"fish" ) }
  qr/Can't understand the argument passed in 'tests'/, "bad tests";

# odd tests
throws_ok { row_ok( table => "foo",
                    where => [ fooid => 123 ] ,
                    tests => { foo => [ bar => "baz" ] } );
          }
  qr/Can't understand the argument passed in 'tests'/, "bad tests 2";

throws_ok { row_ok( table => "foo",
		    where => [ fooid => 123 ] ,
		    tests => [ notpresent => 1 ] )
	  }
  qr/No column 'notpresent' returned from table 'foo'/, "no col from build";

throws_ok { row_ok( sql   => "some sql",
		    tests => [ notpresent => 1 ] )
	  }
  qr/No column 'notpresent' returned from sql/, "no col from sql";

dies_ok { row_ok( dbh    => FakeDBI->new(fallover => 1, "hello" => "there"),
         	  sql    => "any old gumph",
	          tests  => [ fooid => 1 ]) } "handles problems with sql";



# fake database package
package FakeDBI;
use Data::Dumper;
sub new
{
  my $class = shift;
  return bless { @_ }, $class
}
sub quote { return "qtd<$_[1]>" };

sub prepare
{
  my $this = shift;

  # die if we need to
  if ($this->fallover)
    { die "Khaaaaaaaaaaaaan!" }

  return FakeSTH->new($this);
}

sub nomatch  { return $_[0]->{nomatch}  }
sub fallover { return $_[0]->{fallover} }

package FakeSTH;
sub new { return bless { parent => $_[1] }, $_[0] };
sub execute { return 1 };
sub fetchrow_hashref
{
  my $this = shift;
  my $parent = $this->{parent};

  # return undef after the first call)
  if ($this->{called})
    { return undef }
  else
    { $this->{called} = 1 }

  return
    ($parent->nomatch)
     ?  undef
     : { fooid => 123, name => "fred" }
}