view release on metacpan or  search on metacpan

t/07-methodmaker.t  view on Meta::CPAN

    my $char = 'a';
    my $loc1 = $s->Location_t->insert( values => { location_id => 1,
						   location => $a++ } );

    isa_ok( $loc1, 'Alzabo::MM::Test::Row' );

    $s->Location_t->insert( values => { location_id => 2,
					location => $a++,
					parent_location_id => 1 } );
    $s->Location_t->insert( values => { location_id => 3,
					location => $a++,
					parent_location_id => 1 } );
    $s->Location_t->insert( values => { location_id => 4,
					location => $a++,
					parent_location_id => 2 } );
    my $loc5 = $s->Location_t->insert( values => { location_id => 5,
						   location => $a++,
						   parent_location_id => 4 } );

    ok( ! defined $loc1->parent,
	"First location should not have a parent" );

    my @c = $loc1->children( order_by => $s->Location_t->location_id_c ) ->all_rows;
    is( scalar @c, 2,
	"First location should have 2 children" );

    is( $c[0]->location_id, 2,
	"First child location id should be 2" );

    is( $c[1]->location_id, 3,
	"Second child location id should be 3" );

    is( $loc5->parent->location_id, 4,
	"Location 5's parent should be 4" );

    $loc1->location('Set method');
    is( $loc1->location, 'Set method',
	"Update location column via ->location method" );
}

{
    eval { $s->Location_t->insert( values => { location_id => 666,
					       location => 'pre_die' } ) };
    my $e = $@;
    isa_ok( $e, 'Alzabo::Exception',
	    "Exception thrown from pre_insert" );
    is( $e->error, 'PRE INSERT TEST',
	"pre_insert error message should be PRE INSERT TEST" );

    eval { $s->Location_t->insert( values => { location_id => 666,
					       location => 'post_die' } ) };
    $e = $@;
    isa_ok( $e, 'Alzabo::Exception',
	    "Exception thrown by post_insert" );
    is( $e->error, 'POST INSERT TEST',
	"pre_insert error message should be POST INSERT TEST" );

    my $tweaked = $s->Location_t->insert( values => { location_id => 54321,
						      location => 'insert tweak me' } );
    is ( $tweaked->select('location'), 'insert tweaked',
	 "pre_insert should change the value of location to 'insert tweaked'" );

    eval { $tweaked->update( location => 'pre_die' ) };
    $e = $@;
    isa_ok( $e, 'Alzabo::Exception',
	    "Exception thrown from pre_update" );
    is( $e->error, 'PRE UPDATE TEST',
	"pre_update error message should be PRE UPDATE TEST" );

    eval { $tweaked->update( location => 'post_die' ) };
    $e = $@;
    isa_ok( $e, 'Alzabo::Exception',
	    "Exception thrown by post_update" );
    is( $e->error, 'POST UPDATE TEST',
	"post_update error message should be POST UPDATE TEST" );

    $tweaked->update( location => 'update tweak me' );
    is ( $tweaked->select('location'), 'update tweaked',
	 "pre_update should change the value of location to 'update tweaked'" );

    eval { $tweaked->select('pre_sel_die') };
    $e = $@;
    isa_ok( $e, 'Alzabo::Exception',
	    "Exception thrown by pre_select" );
    is( $e->error, 'PRE SELECT TEST',
	"pre_select error message should be PRE SELECT TEST" );

    $tweaked->update( location => 'post_sel_die' );

    eval { $tweaked->select('location') };
    $e = $@;
    isa_ok( $e, 'Alzabo::Exception',
	    "Exception thrown by post_select" );
    is( $e->error, 'POST SELECT TEST',
	"post_select error message should be POST SELECT TEST" );

    eval { $tweaked->select_hash('location') };
    $e = $@;
    isa_ok( $e, 'Alzabo::Exception',
	    "Exception thrown by post_select" );
    is( $e->error, 'POST SELECT TEST',
	"post_select error message should be POST SELECT TEST" );

    $tweaked->update( location => 'select tweak me' );
    is( $tweaked->select('location'), 'select tweaked',
	 "post_select should change the value of location to 'select tweaked'" );

    my %d = $tweaked->select_hash('location');
    is( $d{location}, 'select tweaked',
	 "post_select_hash should change the value of location to 'select tweaked'" );

    $s->ToiletType_t->insert( values => { toilet_type_id => 1,
					  material => 'porcelain',
					  quality => 5 } );
    my $t = $s->Toilet_t->insert( values => { toilet_id => 1,
					      toilet_type_id => 1 } );

    is( $t->material, 'porcelain',
	"New toilet's material method should return 'porcelain'" );
    is( $t->quality, 5,
	"New toilet's quality method should return 5" );

    $s->Location_t->insert( values => { location_id => 100,
					location => '# 100!' } );
    $s->ToiletLocation_t->insert( values => { toilet_id => 1,
					      location_id => 100 } );

    $s->ToiletLocation_t->insert( values => { toilet_id => 1,
					      location_id => 1 } );

    my @l = $t->Locations( order_by => $s->Location_t->location_id_c )->all_rows;

    is( scalar @l, 2,
	"The toilet should have two locations" );

    is( $l[0]->location_id, 1,
	"The first location id should be 1" );

    is( $l[1]->location_id, 100,
	"The second location id should be 2" );

    my @t = $l[0]->Toilets->all_rows;
    is( scalar @t, 1,
	"The location should have one toilet" );

    is( $t[0]->toilet_id, 1,
	"Location's toilet id should be 1" );

    my @tl = $t->ToiletLocations( order_by => $s->ToiletLocation_t->location_id_c )->all_rows;

    is( scalar @tl, 2,
	"The toilet should have two ToiletLocation rows" );

    is( $tl[0]->location_id, 1,
	"First row's location id should be 1" );
    is( $tl[0]->toilet_id, 1,
	"First row's toilet id should 1" );
    is( $tl[1]->location_id, 100,
 	"Second row's location id should be 100" );
    is( $tl[1]->toilet_id, 1,
	"Second row's toilet id should 1" );

    my $row = $s->Toilet_t->row_by_pk( pk => 1 );
    isa_ok( $row, 'Alzabo::MM::Test::Row::Toilet',
	    "The Toilet object" );

    my $p_row = $s->Location_t->potential_row;
    isa_ok( $p_row, 'Alzabo::MM::Test::Row::Location',
	    "Potential row object" );

    $p_row->location( 'zzz' );
    $p_row->location_id( 999 );
    is( $p_row->location_id, 999,
 	"location_id of potential object should be 99" );
    is( $p_row->location, 'zzz',
 	"Location name of potential object should be 'zzz'" );

    eval { $p_row->update( location => 'pre_die' ); };
    $e = $@;
    isa_ok( $e, 'Alzabo::Exception',
	    "Exception thrown by pre_update" );

    eval { $p_row->update( location => 'post_die' ); };
    $e = $@;
    isa_ok( $e, 'Alzabo::Exception',
	    "Exception thrown by post_update" );

    $p_row->update( location => 'update tweak me' );
    is ( $p_row->select('location'), 'update tweaked',
	 "pre_update should change the value of location to 'update tweaked'" );

    eval { $p_row->select('pre_sel_die') };
    $e = $@;
    isa_ok( $e, 'Alzabo::Exception',
	    "Exception thrown by pre_select" );

    $p_row->update( location => 'select tweak me' );
    is( $p_row->select('location'), 'select tweaked',
	 "post_select should change the value of location to 'select tweaked'" );

    %d = $p_row->select_hash('location');
    is( $d{location}, 'select tweaked',
	 "post_select_hash should change the value of location to 'select tweaked'" );

    $p_row->make_live;
    is( $p_row->location_id, 999,
	"Check that live row has same location id" );

    my $alias = $s->Toilet_t->alias;

    can_ok( $alias, 'toilet_id_c' );
    is( $alias->toilet_id_c->name, $s->Toilet_t->toilet_id_c->name,
	"Alias column has the same name as real table's column" );
    is( $alias->toilet_id_c->table, $alias,
	"The alias column's table should be the alias" );

    # self-linking
    {
        $s->Toilet_t->insert( values =>
                              { toilet_id => $_,
                                toilet_type_id => 1,
                              } ) for ( 100 .. 110 );

        $s->ToiletToilet_t->insert( values =>
                                    { toilet_id => 100,
                                      toilet_id_2 => 106,
                                    } );

        $s->ToiletToilet_t->insert( values =>
                                    { toilet_id => 100,
                                      toilet_id_2 => 107,
                                    } );

        $s->ToiletToilet_t->insert( values =>
                                    { toilet_id => 101,
                                      toilet_id_2 => 106,
                                    } );

        $s->ToiletToilet_t->insert( values =>
                                    { toilet_id => 102,
                                      toilet_id_2 => 107,
                                    } );

        {
            my $t100 = $s->Toilet_t->row_by_pk( pk => 100 );

            my @child_ids = sort map { $_->toilet_id } $t100->child_toilets->all_rows;

            is( @child_ids, 2, 'there should be two children' );
            is( $child_ids[0], 106, 'first child is 106' );
            is( $child_ids[1], 107, 'second child is 107' );
        }

        {
            my $t106 = $s->Toilet_t->row_by_pk( pk => 106 );

            my @parent_ids = sort map { $_->toilet_id } $t106->parent_toilets->all_rows;

            is( @parent_ids, 2, 'there should be two parents' );
            is( $parent_ids[0], 100, 'first parent is 100' );
            is( $parent_ids[1], 101, 'second parent is 101' );
        }

t/07-methodmaker.t  view on Meta::CPAN

	}
    }

    if ( $p{type} eq 'linking_table' )
    {
        if ( $p{foreign_key}->table_from eq $p{foreign_key_2}->table_to )
        {
            if ( ($p{foreign_key}->columns_to)[0]->name eq 'toilet_id' )
            {
                return 'child_toilets';
            }
            else
            {
                return 'parent_toilets';
            }
        }

	my $method = $p{foreign_key}->table_to->name;
	my $tname = $p{foreign_key}->table_from->name;
	$method =~ s/^$tname\_?//;
	$method =~ s/_?$tname$//;

	return my_PL($method);
    }

    if ( $p{type} eq 'lookup_columns' )
    {
        return if $p{column}->table->name eq 'Toilet' && $p{column}->name eq 'toilet_type_id';

        return $p{column}->name;
    }

    return $p{column}->name if $p{type} eq 'lookup_columns';

    return $p{parent} ? 'parent' : 'children'
	if $p{type} eq 'self_relation';

    die "unknown type in call to naming sub: $p{type}\n";
}

sub my_PL
{
    return shift() . 's';
}

{
    package Alzabo::MM::Test::Table::Location;
    sub pre_insert
    {
	my $self = shift;
	my $p = shift;
	Alzabo::Exception->throw( error => "PRE INSERT TEST" ) if $p->{values}->{location} eq 'pre_die';

	$p->{values}->{location} = 'insert tweaked' if $p->{values}->{location} eq 'insert tweak me';
    }

    sub post_insert
    {
	my $self = shift;
	my $p = shift;
	Alzabo::Exception->throw( error => "POST INSERT TEST" ) if $p->{row}->select('location') eq 'post_die';
    }
}

{
    package Alzabo::MM::Test::Row::Location;
    sub pre_update
    {
	my $self = shift;
	my $p = shift;
	Alzabo::Exception->throw( error => "PRE UPDATE TEST" ) if $p->{location} && $p->{location} eq 'pre_die';

	$p->{location} = 'update tweaked' if $p->{location} && $p->{location} eq 'update tweak me';
    }

    sub post_update
    {
	my $self = shift;
	my $p = shift;
	Alzabo::Exception->throw( error => "POST UPDATE TEST" ) if $p->{location} && $p->{location} eq 'post_die';
    }

    sub pre_select
    {
	my $self = shift;
	my $cols = shift;

	Alzabo::Exception->throw( error => "PRE SELECT TEST" ) if grep { $_ eq 'pre_sel_die' } @$cols;
    }

    sub post_select
    {
	my $self = shift;
	my $data = shift;

	Alzabo::Exception->throw( error => "POST SELECT TEST" ) if exists $data->{location} && $data->{location} eq 'post_sel_die';

	$data->{location} = 'select tweaked' if exists $data->{location} && $data->{location} eq 'select tweak me';
    }

    sub pre_delete
    {
	my $self = shift;
	Alzabo::Exception->throw( error => "PRE DELETE TEST" ) if $self->select('location') eq 'pre_del_die';
    }

    sub post_delete
    {
	my $self = shift;
#	Alzabo::Exception->throw( error => "POST DELETE TEST" );
    }
}

1;