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

# (c) 2004 by Murat Uenalan. All rights reserved. Note: This program is
# free software; you can redistribute it and/or modify it under the same
# terms as perl itself

# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
#########################

# change 'tests => 1' to 'tests => last_test_to_print';

use Test;

BEGIN { plan tests => 1 };

use Data::Type qw(:all +DB +Bio +Perl +Perl6);

use Data::Type::Query;

use strict;

use warnings;

ok(1); # If we made it this far, we're ok.

#########################
# Insert your test code below, the Test module is use()ed here so read
# its man page ( perldoc Test ) for help writing this test script.

	$Data::Type::debug = 0;

print "Supported languages are ", join( ', ', Data::Type::l18n_list() ), "\n";

print "Current language is '", Data::Type->current_locale, "'\n";

my $query = Data::Type::Query->new;

foreach my $what ( $query->tables )
{
    print "\n\n$what\n";

    my $sth = $query->dbh->prepare( "SELECT * FROM $what" ) || die "$DBI::err";
    
    $sth->execute or die "$DBI::errstr";
    
    while( my $href = $sth->fetchrow_hashref )
    {
	#print Data::Dumper->Dump( [ $href  ] );
    }
}

#	print catalog(), "\n", toc();

print "\n\nLISTING ALL DEPENDENCIES:\n\n";

print Data::Dumper->Dump( [ Data::Type::Query->depends() ] );

   {
       local $Error::Depth += 2;

       $Error::Debug = 1;

    	try
    	{
	    valid( 'on e two three', DB::VARCHAR( 20 ) );

	    valid( 'on e two three', Data::Type::Facet::match( qw/one/ ) );
    	}
    	catch Error with
    	{
    		return;

    		my $e = shift;

    		print "-" x 100, "\n";

    		Data::Type::printfln "Exception '%s' caught", ref $e;

    		Data::Type::printfln "Expected '%s' %s at %s line %s", $e->value, $e->type->info, $e->file, $e->line;
    	};
   }

   {
       $Error::Debug = 1;

    	try
    	{
    		valid( 'test|test.de', STD::EMAIL );
    	}
    	catch Error with
    	{
           print "stacktrace: ", $_[0]->stacktrace, "\n";

    		print Data::Dumper->Dump( [ \@_ ] );

    		return;
    	};

       $Error::Debug = 0;
   }


	$Data::Type::debug = 0;

	Data::Type::println "=" x 100;

	foreach my $type ( STD::URI, STD::EMAIL, STD::IP( 'V4' ), DB::VARCHAR(80), STD::YESNO, STD::DOMAIN )
	{
		Data::Type::println "\n" x 2, "Describing ", $type->info;

		foreach my $entry ( Data::Type::summary( '', $type ) )
		{
			Data::Type::printfln "\texpecting it %s %s ", $entry->expected ? 'is' : 'is NOT', Data::Type::strlimit( $entry->object->info() );
		}
	}

	Data::Type::println "Now summary for DOMAIN given C<www.test.com>";
	
	foreach my $entry ( Data::Type::summary( 'www.test.com', STD::DOMAIN ) )
	{
		Data::Type::printfln "\texpecting it %s %s ", $entry->expected ? 'is' : 'is NOT', Data::Type::strlimit( $entry->object->info() );
	}

	print "\n", STD::CREDITCARD()->usage, "\n";

	print "\n", STD::YESNO::DE()->info, "\n";

print join( "\n", STD::ZIP()->info, STD::ZIP()->usage, STD::ZIP()->doc ), "\n";

# Test whether pkgname is sufficient for summary()
	Data::Type::println "Now summary via pkg for Data::Type::Object::bio_codon";

        my $type = 'Data::Type::Object::bio_codon';

	Data::Type::println "\n" x 2, "Describing ", $type->info;

	foreach my $entry ( Data::Type::summary( '', $type ) )
        {
	    Data::Type::printfln "\texpecting it %s %s ", $entry->expected ? 'is' : 'is NOT', Data::Type::strlimit( $entry->object->info() );
	  }


	Data::Type::println "TESTING TYPS";

#$Data::Type::debug = 1;

dvalid "bbbbbbb", BIO::DNA or warn "no dna";

print Data::Dumper->Dump( [ \@Data::Type::err ] );

dvalid "ACTTTTT", BIO::DNA and warn "dna detected";

$_ = "XXXKKKKLLLL";

warn "ALIENS DETECETD" unless is BIO::DNA;

is BIO::DNA or warn "not DNA";

	# Thanks to sudoer(at)users.sf.net for this test

	try 
        { 
	    valid('mike_web.oakley.com', STD::EMAIL);
		
	    warn "Problem make_web.oakley.com is valid ??????";  
	} 
        catch Error with  
        { 
 	     warn "correct warning about make_web.oakley.com";  

             print STDERR Data::Dumper->Dump( [ \@_ ] );
        };

package Bob;

	Data::Type::try { Data::Type::valid('mike_web.oakley.com', STD::EMAIL ) } catch Error Data::Type::with { print STDERR Data::Dumper->Dump( [ \@_ ] ) };

__END__