## check Relationship::CascadeActions and Relationship::Accessor for compat
## tests!
+sub __new_related_find_or_new_helper {
+ my ($self, $relname, $data) = @_;
+ if ($self->__their_pk_needs_us($relname, $data)) {
+ return $self->result_source
+ ->related_source($relname)
+ ->resultset
+ ->new_result($data);
+ }
+ if ($self->result_source->pk_depends_on($relname, $data)) {
+ return $self->result_source
+ ->related_source($relname)
+ ->resultset
+ ->find_or_create($data);
+ }
+ return $self->find_or_new_related($relname, $data);
+}
+
+sub __their_pk_needs_us { # this should maybe be in resultsource.
+ my ($self, $relname, $data) = @_;
+ my $source = $self->result_source;
+ my $reverse = $source->reverse_relationship_info($relname);
+ my $rel_source = $source->related_source($relname);
+ my $us = { $self->get_columns };
+ foreach my $key (keys %$reverse) {
+ # if their primary key depends on us, then we have to
+ # just create a result and we'll fill it out afterwards
+ return 1 if $rel_source->pk_depends_on($key, $us);
+ }
+ return 0;
+}
+
sub new {
my ($class, $attrs) = @_;
$class = ref $class if ref $class;
if (my $handle = delete $attrs->{-source_handle}) {
$new->_source_handle($handle);
}
- if (my $source = delete $attrs->{-result_source}) {
+
+ my $source;
+ if ($source = delete $attrs->{-result_source}) {
$new->result_source($source);
}
foreach my $key (keys %$attrs) {
if (ref $attrs->{$key}) {
## Can we extract this lot to use with update(_or .. ) ?
- my $info = $class->relationship_info($key);
+ confess "Can't do multi-create without result source" unless $source;
+ my $info = $source->relationship_info($key);
if ($info && $info->{attrs}{accessor}
&& $info->{attrs}{accessor} eq 'single')
{
my $rel_obj = delete $attrs->{$key};
if(!Scalar::Util::blessed($rel_obj)) {
- $rel_obj = $new->find_or_new_related($key, $rel_obj);
+ $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
}
$new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
- $new->set_from_related($key, $rel_obj);
+ $new->set_from_related($key, $rel_obj) if $rel_obj->in_storage;
$related->{$key} = $rel_obj;
next;
} elsif ($info && $info->{attrs}{accessor}
my $others = delete $attrs->{$key};
foreach my $rel_obj (@$others) {
if(!Scalar::Util::blessed($rel_obj)) {
- $rel_obj = $new->new_related($key, $rel_obj);
- $new->{_rel_in_storage} = 0;
+ $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
}
$new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
+ $new->set_from_related($key, $rel_obj) if $rel_obj->in_storage;
}
$related->{$key} = $others;
next;
## 'filter' should disappear and get merged in with 'single' above!
my $rel_obj = delete $attrs->{$key};
if(!Scalar::Util::blessed($rel_obj)) {
- $rel_obj = $new->find_or_new_related($key, $rel_obj);
- $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
+ $rel_obj = $new->__new_related_find_or_new_helper($key, $rel_obj);
}
+ $new->{_rel_in_storage} = 0 unless ($rel_obj->in_storage);
$inflated->{$key} = $rel_obj;
next;
} elsif ($class->has_column($key)
an entirely new object into the database, use C<create> (see
L<DBIx::Class::ResultSet/create>).
+To fetch an uninserted row object, call
+L<new|DBIx::Class::ResultSet/new> on a resultset.
+
This will also insert any uninserted, related objects held inside this
one, see L<DBIx::Class::ResultSet/create> for more details.
%{$self->{_inflated_column} || {}});
if(!$self->{_rel_in_storage}) {
- $source->storage->txn_begin;
# The guard will save us if we blow out of this scope via die
-
- $rollback_guard = Scope::Guard->new(sub { $source->storage->txn_rollback });
+ $rollback_guard = $source->storage->txn_scope_guard;
## Should all be in relationship_data, but we need to get rid of the
## 'filter' reltype..
next REL unless (Scalar::Util::blessed($rel_obj)
&& $rel_obj->isa('DBIx::Class::Row'));
- my $cond = $source->relationship_info($relname)->{cond};
-
- next REL unless ref($cond) eq 'HASH';
-
- # map { foreign.foo => 'self.bar' } to { bar => 'foo' }
-
- my $keyhash = { map { my $x = $_; $x =~ s/.*\.//; $x; } reverse %$cond };
-
- # assume anything that references our PK probably is dependent on us
- # rather than vice versa, unless the far side is (a) defined or (b)
- # auto-increment
-
- foreach my $p (@pri) {
- if (exists $keyhash->{$p}) {
- unless (defined($rel_obj->get_column($keyhash->{$p}))
- || $rel_obj->column_info($keyhash->{$p})
- ->{is_auto_increment}) {
- next REL;
- }
- }
- }
+ next REL unless $source->pk_depends_on(
+ $relname, { $rel_obj->get_columns }
+ );
$rel_obj->insert();
$self->set_from_related($relname, $rel_obj);
}
}
- $source->storage->insert($source, { $self->get_columns });
+ my $updated_cols = $source->storage->insert($source, { $self->get_columns });
+ $self->set_columns($updated_cols);
## PK::Auto
my @auto_pri = grep {
$self->store_column($auto_pri[$_] => $ids[$_]) for 0 .. $#ids;
}
+ $self->{_dirty_columns} = {};
+ $self->{related_resultsets} = {};
+
if(!$self->{_rel_in_storage}) {
## Now do the has_many rels, that need $selfs ID.
foreach my $relname (keys %related_stuff) {
my $reverse = $source->reverse_relationship_info($relname);
foreach my $obj (@cands) {
$obj->set_from_related($_, $self) for keys %$reverse;
- $obj->insert() unless ($obj->in_storage || $obj->result_source->resultset->search({$obj->get_columns})->count);
+ my $them = { $obj->get_inflated_columns };
+ if ($self->__their_pk_needs_us($relname, $them)) {
+ $obj = $self->find_or_create_related($relname, $them);
+ } else {
+ $obj->insert();
+ }
}
}
}
- $source->storage->txn_commit;
- $rollback_guard->dismiss;
+ $rollback_guard->commit;
}
$self->in_storage(1);
- $self->{_dirty_columns} = {};
- $self->{related_resultsets} = {};
undef $self->{_orig_ident};
return $self;
}
$obj->in_storage; # Get value
$obj->in_storage(1); # Set value
-Indicates whether the object exists as a row in the database or not
+Indicates whether the object exists as a row in the database or
+not. This is set to true when L<DBIx::Class::ResultSet/find>,
+L<DBIx::Class::ResultSet/create> or L<DBIx::Class::ResultSet/insert>
+are used.
+
+Creating a row object using L<DBIx::Class::ResultSet/new>, or calling
+L</delete> on one, sets it to false.
=cut
required.
Also takes an options hashref of C<< column_name => value> pairs >> to update
-first. But be awawre that the hashref will be passed to
+first. But be aware that the hashref will be passed to
C<set_inflated_columns>, which might edit it in place, so dont rely on it being
the same after a call to C<update>. If you need to preserve the hashref, it is
sufficient to pass a shallow copy to C<update>, e.g. ( { %{ $href } } )
+If the values passed or any of the column values set on the object
+contain scalar references, eg:
+
+ $obj->last_modified(\'NOW()');
+ # OR
+ $obj->update({ last_modified => \'NOW()' });
+
+The update will pass the values verbatim into SQL. (See
+L<SQL::Abstract> docs). The values in your Row object will NOT change
+as a result of the update call, if you want the object to be updated
+with the actual values from the database, call L</discard_changes>
+after the update.
+
+ $obj->update()->discard_changes();
+
=cut
sub update {
my $self = shift;
if (ref $self) {
$self->throw_exception( "Not in database" ) unless $self->in_storage;
- my $ident_cond = $self->ident_condition;
+ my $ident_cond = $self->{_orig_ident} || $self->ident_condition;
$self->throw_exception("Cannot safely delete a row in a PK-less table")
if ! keys %$ident_cond;
foreach my $column (keys %$ident_cond) {
my $val = $obj->get_column($col);
-Gets a column value from a row object. Does not do any queries; the column
-must have already been fetched from the database and stored in the object. If
-there is an inflated value stored that has not yet been deflated, it is deflated
-when the method is invoked.
+Returns a raw column value from the row object, if it has already
+been fetched from the database or set by an accessor.
+
+If an L<inflated value|DBIx::Class::InflateColumn> has been set, it
+will be deflated and returned.
=cut
my %data = $obj->get_columns;
-Does C<get_column>, for all column values at once.
+Does C<get_column>, for all loaded column values at once.
=cut
keys %{$self->{_dirty_columns}};
}
+=head2 make_column_dirty
+
+Marks a column dirty regardless if it has really changed. Throws an
+exception if the column does not exist.
+
+=cut
+sub make_column_dirty {
+ my ($self, $column) = @_;
+
+ $self->throw_exception( "No such column '${column}'" )
+ unless exists $self->{_column_data}{$column} || $self->has_column($column);
+ $self->{_dirty_columns}{$column} = 1;
+}
+
=head2 get_inflated_columns
- my $inflated_data = $obj->get_inflated_columns;
+ my %inflated_data = $obj->get_inflated_columns;
-Similar to get_columns but objects are returned for inflated columns instead of their raw non-inflated values.
+Similar to get_columns but objects are returned for inflated columns
+instead of their raw non-inflated values.
=cut
$obj->set_column($col => $val);
-Sets a column value. If the new value is different from the old one,
+Sets a raw column value. If the new value is different from the old one,
the column is marked as dirty for when you next call $obj->update.
+If passed an object or reference, this will happily attempt store the
+value, and a later insert/update will try and stringify/numify as
+appropriate.
+
=cut
sub set_column {
my $copy = $orig->copy({ change => $to, ... });
-Inserts a new row with the specified changes.
+Inserts a new row with the specified changes. If the row has related
+objects in a C<has_many> then those objects may be copied too depending
+on the C<cascade_copy> relationship attribute.
=cut
$obj->update_or_insert
-Updates the object if it's already in the db, else inserts it.
+Updates the object if it's already in the database, according to
+L</in_storage>, else inserts it.
=head2 insert_or_update
=cut
-*insert_or_update = \&update_or_insert;
+sub insert_or_update { shift->update_or_insert(@_) }
+
sub update_or_insert {
my $self = shift;
return ($self->in_storage ? $self->update : $self->insert);
$class->mk_group_accessors('column' => $acc);
}
+=head2 get_from_storage ($attrs)
+
+Returns a new Row which is whatever the Storage has for the currently created
+Row object. You can use this to see if the storage has become inconsistent with
+whatever your Row object is.
+
+$attrs is expected to be a hashref of attributes suitable for passing as the
+second argument to $resultset->search($cond, $attrs);
+
+=cut
+
+sub get_from_storage {
+ my $self = shift @_;
+ my $attrs = shift @_;
+ my $resultset = $self->result_source->resultset;
+
+ if(defined $attrs) {
+ $resultset = $resultset->search(undef, $attrs);
+ }
+
+ return $resultset->find($self->{_orig_ident} || $self->ident_condition);
+}
=head2 throw_exception
=head2 id
Returns the primary key(s) for a row. Can't be called as a class method.
-Actually implemented in L<DBIx::Class::Pk>
+Actually implemented in L<DBIx::Class::PK>
=head2 discard_changes
This method can also be used to refresh from storage, retrieving any
changes made since the row was last read from storage. Actually
-implemented in L<DBIx::Class::Pk>
+implemented in L<DBIx::Class::PK>
=cut