From: Robert Sedlacek <r.sedlacek@shadowcat.co.uk>
Date: Fri, 25 Sep 2015 14:51:25 +0000 (+0000)
Subject: first documented version
X-Git-Tag: v0.000001~13
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=638c15338d8800fe902a7ddd5f9f49c4e09180f3;p=dbsrgits%2FDBIx-Class-ParameterizedJoinHack.git

first documented version
---

638c15338d8800fe902a7ddd5f9f49c4e09180f3
diff --git a/lib/DBIx/Class/ParameterizedJoinHack.pm b/lib/DBIx/Class/ParameterizedJoinHack.pm
new file mode 100644
index 0000000..b0a5d7f
--- /dev/null
+++ b/lib/DBIx/Class/ParameterizedJoinHack.pm
@@ -0,0 +1,197 @@
+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.
diff --git a/lib/DBIx/Class/ResultSet/ParameterizedJoinHack.pm b/lib/DBIx/Class/ResultSet/ParameterizedJoinHack.pm
new file mode 100644
index 0000000..14ed789
--- /dev/null
+++ b/lib/DBIx/Class/ResultSet/ParameterizedJoinHack.pm
@@ -0,0 +1,112 @@
+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
diff --git a/t/00basic.t b/t/00basic.t
new file mode 100644
index 0000000..f24197b
--- /dev/null
+++ b/t/00basic.t
@@ -0,0 +1,40 @@
+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';
diff --git a/t/lib/My/Schema.pm b/t/lib/My/Schema.pm
new file mode 100644
index 0000000..36f995b
--- /dev/null
+++ b/t/lib/My/Schema.pm
@@ -0,0 +1,9 @@
+package My::Schema;
+
+use strict;
+use warnings;
+use base qw(DBIx::Class::Schema);
+
+__PACKAGE__->load_namespaces;
+
+1;
diff --git a/t/lib/My/Schema/Result/Person.pm b/t/lib/My/Schema/Result/Person.pm
new file mode 100644
index 0000000..e38c12f
--- /dev/null
+++ b/t/lib/My/Schema/Result/Person.pm
@@ -0,0 +1,37 @@
+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;
diff --git a/t/lib/My/Schema/Result/Task.pm b/t/lib/My/Schema/Result/Task.pm
new file mode 100644
index 0000000..7165b1a
--- /dev/null
+++ b/t/lib/My/Schema/Result/Task.pm
@@ -0,0 +1,23 @@
+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;
diff --git a/t/lib/My/Schema/ResultSet/Person.pm b/t/lib/My/Schema/ResultSet/Person.pm
new file mode 100644
index 0000000..ad3e6f9
--- /dev/null
+++ b/t/lib/My/Schema/ResultSet/Person.pm
@@ -0,0 +1,9 @@
+package My::Schema::ResultSet::Person;
+
+use strict;
+use warnings;
+use base qw(DBIx::Class::ResultSet);
+
+__PACKAGE__->load_components(qw(ResultSet::ParameterizedJoinHack));
+
+1;