From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sun, 18 Sep 2005 17:58:03 +0000 (+0000)
Subject: Moved might_have compat back out into a CDBICompat class and documented stuff
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=503536d5b216b4d85ed3f5420f3db93d4c033d86;p=dbsrgits%2FDBIx-Class-Historic.git

Moved might_have compat back out into a CDBICompat class and documented stuff
---

diff --git a/lib/DBIx/Class.pm b/lib/DBIx/Class.pm
index 83064ce..db6eda0 100644
--- a/lib/DBIx/Class.pm
+++ b/lib/DBIx/Class.pm
@@ -61,7 +61,7 @@ yo load the approriate PK::Auto subclass - e.g.
 interface)
 
 If you fancy playing around with DBIx::Class from scratch, then read the docs
-for ::Table and ::Relationship,
+for DBIx::Class::Table, ::Row, ::Schema, ::DB and ::Relationship,
 
   use base qw/DBIx::Class/;
   __PACKAGE__->load_components(qw/Core DB/);
diff --git a/lib/DBIx/Class/CDBICompat.pm b/lib/DBIx/Class/CDBICompat.pm
index daf5822..88c0818 100644
--- a/lib/DBIx/Class/CDBICompat.pm
+++ b/lib/DBIx/Class/CDBICompat.pm
@@ -18,6 +18,7 @@ __PACKAGE__->load_own_components(qw/
   ColumnCase
   HasMany
   HasA
+  MightHave
   LazyLoading
   AutoUpdate
   TempColumns
diff --git a/lib/DBIx/Class/CDBICompat/MightHave.pm b/lib/DBIx/Class/CDBICompat/MightHave.pm
new file mode 100644
index 0000000..e661f6b
--- /dev/null
+++ b/lib/DBIx/Class/CDBICompat/MightHave.pm
@@ -0,0 +1,16 @@
+package DBIx::Class::CDBICompat::MightHave;
+
+use strict;
+use warnings;
+
+sub might_have {
+  my ($class, $rel, $f_class, @columns) = @_;
+  if (ref $columns[0] || !defined $columns[0]) {
+    return $class->NEXT::might_have($rel, $f_class, @columns);
+  } else {
+    return $class->NEXT::might_have($rel, $f_class, undef,
+                                     { proxy => \@columns });
+  }
+}
+
+1;
diff --git a/lib/DBIx/Class/DB.pm b/lib/DBIx/Class/DB.pm
index 905b908..a758b8f 100644
--- a/lib/DBIx/Class/DB.pm
+++ b/lib/DBIx/Class/DB.pm
@@ -14,13 +14,14 @@ DBIx::Class::DB - Simple DBIx::Class Database connection by class inheritance
   package MyDB;
 
   use base qw/DBIx::Class/;
-  __PACKAGE__->load_components('Core');
+  __PACKAGE__->load_components('DB');
 
   __PACKAGE__->connection('dbi:...', 'user', 'pass', \%attrs);
 
   package MyDB::MyTable;
 
   use base qw/MyDB/;
+  __PACKAGE__->load_components('Core');
 
   ...
 
diff --git a/lib/DBIx/Class/Relationship.pm b/lib/DBIx/Class/Relationship.pm
index d7d1675..dce0036 100644
--- a/lib/DBIx/Class/Relationship.pm
+++ b/lib/DBIx/Class/Relationship.pm
@@ -29,10 +29,53 @@ This class handles relationships between the tables in your database
 model. It allows your to set up relationships, and to perform joins
 on searches.
 
+This POD details only the convenience methods for setting up standard
+relationship types. For more information see ::Relationship::Base
+
 =head1 METHODS
 
+All convenience methods take a signature of the following format -
+
+  __PACKAGE__>method_name('relname', 'Foreign::Class', $join?, $attrs?);
+
+
+
 =over 4
 
+=item has_one
+
+  my $f_obj = $obj->relname;
+
+Creates a one-one relationship with another class; defaults to PK-PK for
+the join condition unless a condition is specified.
+
+=item might_have
+
+  my $f_obj = $obj->relname;
+
+Creates an optional one-one relationship with another class; defaults to PK-PK
+for the join condition unless a condition is specified.
+
+=item has_many
+
+  my @f_obj = $obj->relname($cond?, $attrs?);
+  my $f_result_set = $obj->relname($cond?, $attrs?);
+
+  $obj->add_to_relname(\%col_data);
+
+Creates a one-many relationship with another class; 
+
+=item belongs_to
+
+  my $f_obj = $obj->relname;
+
+  $obj->relname($new_f_obj);
+
+Creates a relationship where we store the foreign class' PK; if $join is a
+column name instead of a condition that is assumed to be the FK, if not
+has_many assumes the FK is the relname is that is a column on the current
+class.
+
 =cut
 
 1;
diff --git a/lib/DBIx/Class/Relationship/Base.pm b/lib/DBIx/Class/Relationship/Base.pm
index 0b12a3b..c7fa861 100644
--- a/lib/DBIx/Class/Relationship/Base.pm
+++ b/lib/DBIx/Class/Relationship/Base.pm
@@ -23,6 +23,19 @@ on searches.
 
 =over 4
 
+=item add_relationship
+
+  __PACKAGE__->add_relationship('relname', 'Foreign::Class', $cond, $attrs);
+
+The condition needs to be an SQL::Abstract-style representation of the
+join between the tables - for example if you're creating a rel from Foo to Bar
+
+  { 'foreign.foo_id' => 'self.id' }
+
+will result in a JOIN clause like
+
+  foo me JOIN bar bar ON bar.foo_id = me.id
+
 =cut
 
 sub add_relationship {
@@ -140,11 +153,23 @@ sub _cond_value {
   return $self->NEXT::ACTUAL::_cond_value($attrs, $key, $value)
 }
 
+=item search_related
+
+  My::Table->search_related('relname', $cond, $attrs);
+
+=cut
+
 sub search_related {
   my $self = shift;
   return $self->_query_related('search', @_);
 }
 
+=item count_related
+
+  My::Table->count_related('relname', $cond, $attrs);
+
+=cut
+
 sub count_related {
   my $self = shift;
   return $self->_query_related('count', @_);
@@ -176,11 +201,23 @@ sub _query_related {
            )->$meth($query, $attrs);
 }
 
+=item create_related
+
+  My::Table->create_related('relname', \%col_data);
+
+=cut
+
 sub create_related {
   my $class = shift;
   return $class->new_related(@_)->insert;
 }
 
+=item new_related
+
+  My::Table->new_related('relname', \%col_data);
+
+=cut
+
 sub new_related {
   my ($self, $rel, $values, $attrs) = @_;
   $self->throw( "Can't call new_related as class method" ) 
@@ -199,6 +236,12 @@ sub new_related {
   return $self->resolve_class($rel_obj->{class})->new(\%fields);
 }
 
+=item find_related
+
+  My::Table->find_related('relname', @pri_vals | \%pri_vals);
+
+=cut
+
 sub find_related {
   my $self = shift;
   my $rel = shift;
@@ -215,11 +258,23 @@ sub find_related {
   return $self->resolve_class($rel_obj->{class})->find($query);
 }
 
+=item find_or_create_related
+
+  My::Table->find_or_create_related('relname', \%col_data);
+
+=cut
+
 sub find_or_create_related {
   my $self = shift;
   return $self->find_related(@_) || $self->create_related(@_);
 }
 
+=item set_from_related
+
+  My::Table->set_from_related('relname', $rel_obj);
+
+=cut
+
 sub set_from_related {
   my ($self, $rel, $f_obj) = @_;
   my $rel_obj = $self->_relationships->{$rel};
@@ -243,12 +298,24 @@ sub set_from_related {
   return 1;
 }
 
+=item update_from_related
+
+  My::Table->update_from_related('relname', $rel_obj);
+
+=cut
+
 sub update_from_related {
   my $self = shift;
   $self->set_from_related(@_);
   $self->update;
 }
 
+=item delete_related
+
+  My::Table->delete_related('relname', $cond, $attrs);
+
+=cut
+
 sub delete_related {
   my $self = shift;
   return $self->search_related(@_)->delete;
diff --git a/lib/DBIx/Class/Relationship/BelongsTo.pm b/lib/DBIx/Class/Relationship/BelongsTo.pm
index 4acb8fe..cda5fb8 100644
--- a/lib/DBIx/Class/Relationship/BelongsTo.pm
+++ b/lib/DBIx/Class/Relationship/BelongsTo.pm
@@ -39,4 +39,12 @@ sub belongs_to {
   return 1;
 }
 
+=head1 AUTHORS
+
+Alexander Hartmaier <Alexander.Hartmaier@t-systems.at>
+
+Matt S. Trout <mst@shadowcatsystems.co.uk>
+
+=cut
+
 1;
diff --git a/lib/DBIx/Class/Relationship/CascadeActions.pm b/lib/DBIx/Class/Relationship/CascadeActions.pm
index 53f15b0..b26345b 100644
--- a/lib/DBIx/Class/Relationship/CascadeActions.pm
+++ b/lib/DBIx/Class/Relationship/CascadeActions.pm
@@ -12,7 +12,7 @@ sub delete {
   my %rels = %{ $self->_relationships };
   my @cascade = grep { $rels{$_}{attrs}{cascade_delete} } keys %rels;
   foreach my $rel (@cascade) {
-    $_->delete for $self->search_related($rel);
+    $self->search_related($rel)->delete;
   }
   return $ret;
 }
diff --git a/lib/DBIx/Class/Relationship/HasOne.pm b/lib/DBIx/Class/Relationship/HasOne.pm
index ea97e7d..9f821a4 100644
--- a/lib/DBIx/Class/Relationship/HasOne.pm
+++ b/lib/DBIx/Class/Relationship/HasOne.pm
@@ -12,11 +12,8 @@ sub has_one {
 }
 
 sub _has_one {
-  my ($class, $join_type, $rel, $f_class, @columns) = @_;
-  my $cond;
-  if (ref $columns[0]) {
-    $cond = shift @columns;
-  } else {
+  my ($class, $join_type, $rel, $f_class, $cond, $attrs) = @_;
+  unless ($cond) {
     my ($pri, $too_many) = keys %{ $class->_primaries };
     $class->throw( "might_have/has_one can only infer join for a single primary key; ${class} has more" )
       if $too_many;
@@ -28,20 +25,14 @@ sub _has_one {
       $class->throw( "might_have/has_one can only infer join for a single primary key; ${f_class} has more" )
         if $too_many;
     }
-    $cond = { "foreign.${f_key}" => "self.${pri}" },
+    $cond = { "foreign.${f_key}" => "self.${pri}" };
   }
-  shift(@columns) unless defined $columns[0]; # Explicit empty condition
-  my %attrs;
-  if (ref $columns[0] eq 'HASH') {
-    %attrs = %{shift @columns};
-  }
-  shift(@columns) unless defined $columns[0]; # Explicit empty attrs
   $class->add_relationship($rel, $f_class,
    $cond,
-   { accessor => 'single', (@columns ? (proxy => \@columns) : ()),
+   { accessor => 'single',
      cascade_update => 1, cascade_delete => 1,
      ($join_type ? ('join_type' => $join_type) : ()),
-     %attrs });
+     %{$attrs || {}} });
   1;
 }
 
diff --git a/t/lib/DBICTest/Schema/HelperRels.pm b/t/lib/DBICTest/Schema/HelperRels.pm
index 590c99f..bd74259 100644
--- a/t/lib/DBICTest/Schema/HelperRels.pm
+++ b/t/lib/DBICTest/Schema/HelperRels.pm
@@ -12,7 +12,8 @@ DBICTest::Schema::CD->belongs_to('artist', 'DBICTest::Schema::Artist');
 DBICTest::Schema::CD->has_many(tracks => 'DBICTest::Schema::Track');
 DBICTest::Schema::CD->has_many(tags => 'DBICTest::Schema::Tag');
 
-DBICTest::Schema::CD->might_have(liner_notes => 'DBICTest::Schema::LinerNotes' => qw/notes/);
+DBICTest::Schema::CD->might_have(liner_notes => 'DBICTest::Schema::LinerNotes',
+                                  undef, { proxy => [ qw/notes/ ] });
 
 DBICTest::Schema::SelfRefAlias->belongs_to(
   self_ref => 'DBICTest::Schema::SelfRef');