I  fail to implement the following scenario properly with DBIC

| User1
|       Test1
|       Test2
|             Step1
|             Step2
|       Test3

-) There are Users.
-) A User has_many Tests.
-) A Test has_many Steps.
-) Steps have a 'type' attribute.
-) A Step of type 'SubTest' references a Test.
-) If a Step with a reference to a Test is deleted the Test is deleted.
-) If a Test referenced by a Step is deleted the Test is deleted.
-) If a Step of type 'SubTest' is created it copies the Test it is
supposed to reference and references the copy instead.


I almost got a working solution but it produces faulty results when I
call  $user->copy.

Attached is an .tgz archive with my schema and some tests. you can run
the tests and the tempfiles for the sqlite database are deleted
automatically after the tests have finished.


But here is the interesting part of my "solution" ...

###############################
# Test.pm
###############################
__PACKAGE__->might_have(
    'step',
    'EPPlication::Schema::Result::Step',
    'subtest_id',
);

###############################
# Step.pm
###############################

__PACKAGE__->belongs_to('test', 'EPPlication::Schema::Result::Test', 'test_id');

# a Test belongs to $step if $step->type eq 'SubTest'
# but it's optional so we pass "join_type => 'left'"
__PACKAGE__->belongs_to(
    'subtest',
    'EPPlication::Schema::Result::Test',
    'subtest_id',
    {   join_type      => 'left',
        cascade_delete => 1,
    },
);

sub insert {
    my ($self, @args) = @_;
    my $row;
    if ($self->type eq 'SubTest') {
        my $schema       = $self->result_source->schema;
        my $guard        = $schema->txn_scope_guard;
        my $template_id  = $self->subtest_id;
        my $template     = $schema->resultset('Test')->find($template_id);
        my $subtest_name = $template->name . ' (' . $self->test->name . ')';
        my $subtest = $template->copy(
            {   name     => $subtest_name,
                type     => 'SubTest',
                position => undef,
            }
        );
        $self->subtest($subtest);
        $row = $self->next::method(@args);
        $guard->commit;
    } else {
        $row = $self->next::method(@args);
    }
    return $row;
}

Attachment: davewood.tgz
Description: GNU Zip compressed data

_______________________________________________
List: http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-class
IRC: irc.perl.org#dbix-class
SVN: http://dev.catalyst.perl.org/repos/bast/DBIx-Class/
Searchable Archive: http://www.grokbase.com/group/dbix-class@lists.scsys.co.uk

Reply via email to