# blog posts (also threaded) package MyApp::Schema::DB::post; use base qw/ DBIx::Class /; __PACKAGE__->load_components qw( PK::Auto Core ); __PACKAGE__->table('post'); # ... missing some regular set-up code __PACKAGE__->add_columns(qw/ id user parent title body golive created updated /); __PACKAGE__->belongs_to('parent' => 'MyApp::Schema::DB::post'); __PACKAGE__->has_many('children' => 'MyApp::Schema::DB::post' => 'parent', { order_by => "golive" } ); # ... missing some other methods sub parents { my ( $self, @parents ) = @_; my $parent = $self->parent; return @parents unless $parent; unshift @parents, $parent; die "Unterminating lineage loop suspected!" if @parents > 50; $parent->parents(@parents); } # comments ... threaded, attached either to a # parent comment or directly to a post package MyApp::Schema::DB::comment; use base qw/ DBIx::Class /; __PACKAGE__->load_components qw( PK::Auto Core ); __PACKAGE__->table('comment'); __PACKAGE__->add_columns(qw/ id post user parent title body created updated /); __PACKAGE__->belongs_to('post' => 'Yesh::Schema::DB::post'); __PACKAGE__->belongs_to('parent' => 'MyApp::Schema::DB::comment'); __PACKAGE__->has_many('replies' => 'MyApp::Schema::DB::comment' => 'parent'); sub depth { my $self = shift; return 1 + scalar $self->parents; } sub parents { my ( $self, @parents ) = @_; my $parent = $self->parent; return @parents unless $parent; push @parents, $parent; die "Unterminating lineage loop suspected!" if @parents > 100; $parent->parents(@parents); }