--- /dev/null
+package DBIx::Class::ParameterizedJoinHack;
+
+use strict;
+use warnings;
+use base qw(DBIx::Class);
+
+our $VERSION = '0.000001'; # 0.0.1
+$VERSION = eval $VERSION;
+
+our $STORE = '_parameterized_join_hack_meta_info';
+
+__PACKAGE__->mk_group_accessors(inherited => $STORE);
+
+sub parameterized_has_many {
+ my ($class, $rel, $f_source, $cond, $attrs) = @_;
+ {
+ my $cond_ref = ref($cond);
+ die "Condition needs to be [ \\\@args, \$code ], not ${cond_ref}"
+ unless $cond_ref eq 'ARRAY';
+ }
+ my ($args, $code) = @$cond;
+ my $store = $class->$STORE({
+ %{$class->$STORE||{}},
+ $rel => { params => {}, args => $args },
+ });
+ my $wrapped_code = sub {
+ my $params = $store->{$rel}{params};
+ my @missing = grep !exists $params->{$_}, @$args;
+ die "Attempted to use parameterized rel ${rel} for ${class} without"
+ ." passing parameters ".join(', ', @missing) if @missing;
+ local *_ = $params;
+ &$code;
+ };
+ $class->has_many($rel, $f_source, $wrapped_code, $attrs);
+ return; # no, you are not going to accidentally rely on a return value
+}
+
+1;
+
+=head1 NAME
+
+DBIx::Class::ParameterizedJoinHack - Parameterized Relationship Joins
+
+=head1 SYNOPSIS
+
+ #
+ # The Result class we want to allow to join with a dynamic
+ # condition.
+ #
+ package MySchema::Result::Person;
+ use base qw(DBIx::Class::Core);
+
+ __PACKAGE__->load_components(qw(ParameterizedJoinHack));
+ __PACKAGE__->table('person');
+ __PACKAGE__->add_columns(
+ id => {
+ data_type => 'integer',
+ is_nullable => 0,
+ is_auto_increment => 1,
+ },
+ name => {
+ data_type => 'text',
+ is_nullable => 0,
+ }
+ );
+
+ ...
+
+ __PACKAGE__->parameterized_has_many(
+ priority_tasks => 'MySchema::Result::Task',
+ [['min_priority'] => sub {
+ my $args = shift;
+ return +{
+ "$args->{foreign_alias}.owner_id" => {
+ -ident => "$args->{self_alias}.id",
+ },
+ "$args->{foreign_alias}.priority" => {
+ '>=' => $_{min_priority},
+ },
+ };
+ }],
+ );
+
+ 1;
+
+ #
+ # The ResultSet class belonging to your Result
+ #
+ package MySchema::ResultSet::Person;
+ use base qw(DBIx::Class::ResultSet);
+
+ __PACKAGE__->load_components(qw(ResultSet::ParameterizedJoinHack));
+
+ 1;
+
+ #
+ # A Result class to join against.
+ #
+ package MySchema::Result::Task;
+ use base qw(DBIx::Class::Core);
+
+ __PACKAGE__->table('task');
+ __PACKAGE__->add_columns(
+ id => {
+ data_type => 'integer',
+ is_nullable => 0,
+ is_auto_increment => 1,
+ },
+ owner_id => {
+ data_type => 'integer',
+ is_nullable => 0,
+ },
+ priority => {
+ data_type => 'integer',
+ is_nullable => 0,
+ },
+ );
+
+ ...
+
+ 1;
+
+ #
+ # Using the parameterized join.
+ #
+ my @urgent = MySchema
+ ->connect(...)
+ ->resultset('Person')
+ ->with_parameterized_join(
+ priority_tasks => {
+ min_priority => 300,
+ },
+ )
+ ->all;
+
+=head1 DESCRIPTION
+
+This L<DBIx::Class> component allows to declare dynamically parameterized
+has-many relationships.
+
+Add the component to your Result class as usual:
+
+ __PACKAGE__->load_components(qw( ParameterizedJoinHack ));
+
+See L<parameterized_has_many> for details on declaring relations.
+
+See L<DBIx::Class::ResultSet::ParameterizedJoinHack> for ResultSet usage.
+
+=head1 METHODS
+
+=head2 parameterized_has_many
+
+ __PACKAGE__->parameterized_has_many(
+ $relation_name,
+ $foreign_source,
+ [\@join_arg_names, \&join_builder],
+ $attrs,
+ );
+
+The C<$relation_name>, C<$foreign_source>, and C<$attrs> are passed
+through to C<has_many> as usual. The third argument is an array reference
+containing an (array reference) list of argument names and a code
+reference used to build the join conditions.
+
+The code reference will be called with the same arguments as if it had
+been passed to C<has_many> directly, but the global C<%_> hash will
+contain the named arguments for the join.
+
+See the L</SYNOPSIS> for an example of a definition.
+
+=head1 SPONSORS
+
+Development of this module was sponsored by
+
+=over
+
+=item * Ctrl O L<http://ctrlo.com>
+
+=back
+
+=head1 AUTHOR
+
+ Matt S. Trout <mst@shadowcat.co.uk>
+
+=head1 CONTRIBUTORS
+
+None yet.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2015 the DBIx::Class::ParameterizedJoinHack L</AUTHOR> and L</CONTRIBUTORS>
+as listed above.
+
+=head1 LICENSE
+
+This library is free software and may be distributed under the same terms
+as perl itself.
--- /dev/null
+package DBIx::Class::ResultSet::ParameterizedJoinHack;
+
+use strict;
+use warnings;
+use DBIx::Class::ParameterizedJoinHack;
+use base qw(DBIx::Class::ResultSet);
+
+sub _parameterized_join_store {
+ $_[0]->result_source->result_class
+ ->$DBIx::Class::ParameterizedJoinHack::STORE
+}
+
+sub with_parameterized_join {
+ my ($self, $rel, $params) = @_;
+ $self->search_rs(
+ {},
+ { join => $rel,
+ join_parameters => {
+ %{$self->{attrs}{join_parameters}||{}},
+ $rel => $params
+ }
+ },
+ );
+}
+
+sub call_with_parameters {
+ my ($self, $method, @args) = @_;
+ my %params = %{$self->{attrs}{join_parameters}||{}};
+ my $store = $self->_parameterized_join_store;
+ local @{$store}{keys %params} = map {
+ +{ %{$store->{$_}}, params => $params{$_} }
+ } keys %params;
+ return $self->$method(@args);
+}
+
+sub _resolved_attrs { my $self = shift; $self->call_with_parameters($self->next::can, @_) }
+sub related_resultset { my $self = shift; $self->call_with_parameters($self->next::can, @_) }
+
+1;
+
+=head1 NAME
+
+DBIx::Class::ResultSet::ParameterizedJoinHack
+
+=head1 SYNOPSIS
+
+ package MySchema::ResultSet::Person;
+ use base qw(DBIx::Class::ResultSet);
+
+ __PACKAGE__->load_components(qw(ResultSet::ParameterizedJoinHack));
+
+ 1;
+
+=head1 DESCRIPTION
+
+This is a ResultSet component allowing you to access the dynamically
+parameterized relations declared with
+L<DBIx::Class::ParameterizedJoinHack>.
+
+Enable the component as usual with:
+
+ __PACKAGE__->load_components(qw( ResultSet::ParameterizedJoinHack ));
+
+in your ResultSet class.
+
+See L<DBIx::Class::ParameterizedJoinHack> for declaration documentation,
+a general overview, and examples.
+
+=head1 METHODS
+
+=head2 with_parameterized_join
+
+ my $joined_rs = $resultset->with_parameterized_join(
+ $relation_name,
+ $parameters,
+ );
+
+This method constructs a ResultSet joined with the given C<$relation_name>
+by the passed C<$parameters>. The C<$relation_name> is the name as
+declared on the Result, C<$parameters> is a hash reference with the keys
+being the parameter names, and the values being the arguments to the join
+builder.
+
+=head1 SPONSORS
+
+Development of this module was sponsored by
+
+=over
+
+=item * Ctrl O L<http://ctrlo.com>
+
+=back
+
+=head1 AUTHOR
+
+ Matt S. Trout <mst@shadowcat.co.uk>
+
+=head1 CONTRIBUTORS
+
+None yet.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2015 the DBIx::Class::ParameterizedJoinHack L</AUTHOR> and L</CONTRIBUTORS>
+as listed above.
+
+=head1 LICENSE
+
+This library is free software and may be distributed under the same terms
+as perl itself.
+
+=cut
--- /dev/null
+use strict;
+use warnings;
+use lib 't/lib';
+use Test::More qw(no_plan);
+use My::Schema;
+
+my $schema = My::Schema->connect('dbi:SQLite:dbname=:memory:');
+
+$schema->deploy;
+
+my $people = $schema->resultset('Person');
+
+my $bob = $people->create({
+ name => 'Bob Testuser',
+});
+
+$bob->create_related(assigned_tasks => {
+ summary => 'Task A',
+ urgency => 10,
+});
+$bob->create_related(assigned_tasks => {
+ summary => 'Task B',
+ urgency => 20,
+});
+$bob->create_related(assigned_tasks => {
+ summary => 'Task C',
+ urgency => 30,
+});
+
+my $test_rs = $schema
+ ->resultset('Person')
+ ->search({ 'me.name' => { -like => 'Bob%' } });
+
+is $test_rs->with_parameterized_join(
+ urgent_assigned_tasks => { urgency_threshold => 20 },
+)->count, 1, 'joined';
+
+is $test_rs->with_parameterized_join(
+ urgent_assigned_tasks => { urgency_threshold => 200 },
+)->count, 1, 'not joined';
--- /dev/null
+package My::Schema;
+
+use strict;
+use warnings;
+use base qw(DBIx::Class::Schema);
+
+__PACKAGE__->load_namespaces;
+
+1;
--- /dev/null
+package My::Schema::Result::Person;
+
+use strict;
+use warnings;
+use base qw(DBIx::Class::Core);
+
+__PACKAGE__->load_components(qw(ParameterizedJoinHack));
+
+__PACKAGE__->table('people');
+
+__PACKAGE__->add_columns(
+ id => { data_type => 'integer', is_nullable => 0, is_auto_increment => 1 },
+ name => { data_type => 'text', is_nullable => 0 }
+);
+
+__PACKAGE__->set_primary_key('id');
+
+__PACKAGE__->has_many(
+ assigned_tasks => 'My::Schema::Result::Task',
+ { 'foreign.assigned_to_id' => 'self.id' },
+);
+
+__PACKAGE__->parameterized_has_many(
+ urgent_assigned_tasks => 'My::Schema::Result::Task',
+ [ [ qw(urgency_threshold) ], sub {
+ my $args = shift;
+ +{
+ "$args->{foreign_alias}.assigned_to_id" =>
+ { -ident => "$args->{self_alias}.id" },
+ "$args->{foreign_alias}.urgency" =>
+ { '>', $_{urgency_threshold} }
+ }
+ }
+ ]
+);
+
+1;
--- /dev/null
+package My::Schema::Result::Task;
+
+use strict;
+use warnings;
+use base qw(DBIx::Class::Core);
+
+__PACKAGE__->table('tasks');
+
+__PACKAGE__->add_columns(
+ id => { data_type => 'integer', is_nullable => 0, is_auto_increment => 1 },
+ summary => { data_type => 'text', is_nullable => 0 },
+ assigned_to_id => { data_type => 'integer', is_nullable => 0 },
+ urgency => { data_type => 'integer', is_nullable => 0 },
+);
+
+__PACKAGE__->set_primary_key('id');
+
+__PACKAGE__->belongs_to(
+ assigned_to => 'My::Schema::Result::Person',
+ { 'foreign.id' => 'self.assigned_to_id' }
+);
+
+1;
--- /dev/null
+package My::Schema::ResultSet::Person;
+
+use strict;
+use warnings;
+use base qw(DBIx::Class::ResultSet);
+
+__PACKAGE__->load_components(qw(ResultSet::ParameterizedJoinHack));
+
+1;
projects / dbsrgits/DBIx-Class-ParameterizedJoinHack.git / commitdiff