view release on metacpan or  search on metacpan

t/t_schema/02_tangram.t  view on Meta::CPAN

	my $schema = Tangram::Relational->schema( { classes => $class_schema,normalize => sub { $_[0] =~ s/::/_/; $_[0] } } );

	my $dbh = DBI->connect( ) or die;

	{
		my $aref_result = $dbh->selectcol_arrayref( q{SHOW TABLES} ) or die $DBI::errstr;

		my %tables;

		@tables{ @$aref_result } = 1;

		Tangram::Relational->deploy( $schema, $dbh ) unless exists $tables{'tangram'};
	}

	# To delete all tangram tables of this schema
	#
	# Tangram::Relational->retreat( $schema, $dbh );

	my $storage = Tangram::Relational->connect( $schema, @ENV{ qw(DBI_DSN DBI_USER DBI_PASS) }, { dbh => $dbh } ) or die;

	my $tbl = $storage->remote( 'Human::Group' );

	my ($group) = $storage->select( $tbl, $tbl->{name} eq 'dbadmin' );

	unless( $group )
	{
		$group = new Human::Group( -name => 'dbadmin', -desc => 'database administrators' );

		print Dumper $group;

		$storage->insert( $group );
	}

	$tbl = $storage->remote( 'Human' );

	my @users = map { new User( -age => (0 .. 100)[rand 99], -konto => int rand 99, -group => $group ) } (1..3);

	print $users[0]->to_xml;

	my @id = $storage->insert(

			@users,

			new Human( -firstname => 'test_person' ),

		) or die q{insert failed..};

	println 'Scanning for teenagers (age<18)...';

	map { $_->info() } $storage->select( $tbl, $tbl->{age} < 18 );

	println 'Scanning finished.';

		# list all instances

	my %class_hash = @$class_schema;

	foreach my $class ( keys %class_hash )
	{
		my $cursor = $storage->cursor( $class );

		my $inst_cnt = 0;

		while(my $obj = $cursor->current())
		{
			#$obj->info() if $obj->can('info');

			$inst_cnt++;

			$cursor->next();
		}

		println qq{'$inst_cnt' instance(s) of class '$class' detected.};

		$cursor->close();
	}

	eval
	{
		1;
	};

	if($@)
	{
		croak $@;

		print 'not ';
	}

printf "ok %d\n", ++$loaded;


=head1 Method B<intelligent_deploy>

Test whether tangram is installed, otherwise deploy the schema into the db.

=cut