=cut
-## NB (JER) - this assumes set_from_related can cope with multi-rels
## It needs to store the new objects somewhere, and call insert on that list later when insert is called on this object. We may need an accessor for these so the user can retrieve them, if just doing ->new().
## This only works because DBIC doesnt yet care to check whether the new_related objects have been passed all their mandatory columns
## When doing the later insert, we need to make sure the PKs are set.
## tests!
sub new {
- my ($class, $attrs, $source) = @_;
+ my ($class, $attrs) = @_;
$class = ref $class if ref $class;
my $new = { _column_data => {} };
bless $new, $class;
- $new->_source_handle($source) if $source;
+ if (my $handle = delete $attrs->{-source_handle}) {
+ $new->_source_handle($handle);
+ }
+ if (my $source = delete $attrs->{-result_source}) {
+ $new->result_source($source);
+ }
if ($attrs) {
$new->throw_exception("attrs must be a hashref")
unless ref($attrs) eq 'HASH';
my ($related,$inflated);
+ ## Pretend all the rels are actual objects, unset below if not, for insert() to fix
+ $new->{_rel_in_storage} = 1;
+ print STDERR "Attrs: ", Dumper($attrs), "\n";
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);
if ($info && $info->{attrs}{accessor}
&& $info->{attrs}{accessor} eq 'single')
{
- my $rel_obj = $attrs->{$key};
- $new->{_rel_in_storage} = 1;
+ my $rel_obj = delete $attrs->{$key};
+ print STDERR "REL: $key ", ref($rel_obj), "\n";
if(!Scalar::Util::blessed($rel_obj)) {
$rel_obj = $new->new_related($key, $rel_obj);
+ print STDERR "REL: $key ", ref($rel_obj), "\n";
$new->{_rel_in_storage} = 0;
}
- $new->set_from_related($key, $attrs->{$key});
- $related->{$key} = $attrs->{$key};
+ $new->set_from_related($key, $rel_obj);
+ $related->{$key} = $rel_obj;
next;
} elsif ($info && $info->{attrs}{accessor}
&& $info->{attrs}{accessor} eq 'multi'
&& ref $attrs->{$key} eq 'ARRAY') {
- my $others = $attrs->{$key};
- $new->{_rel_in_storage} = 1;
+ 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;
}
}
- $new->set_from_related($key, $others);
- $related->{$key} = $attrs->{$key};
+ $related->{$key} = $others;
+ next;
} elsif ($class->has_column($key)
&& exists $class->column_info($key)->{_inflate_info})
{
## 'filter' should disappear and get merged in with 'single' above!
my $rel_obj = $attrs->{$key};
- $new->{_rel_in_storage} = 1;
if(!Scalar::Util::blessed($rel_obj)) {
$rel_obj = $new->new_related($key, $rel_obj);
$new->{_rel_in_storage} = 0;
next;
}
}
+ use Data::Dumper;
+ print STDERR "Key: ", Dumper($key), "\n";
$new->throw_exception("No such column $key on $class")
unless $class->has_column($key);
$new->store_column($key => $attrs->{$key});
}
- if (my $source = delete $attrs->{-result_source}) {
- $new->result_source($source);
- }
$new->{_relationship_data} = $related if $related;
$new->{_inflated_column} = $inflated if $inflated;
if $self->can('result_source_instance');
$self->throw_exception("No result_source set on this object; can't insert")
unless $source;
- #use Data::Dumper; warn Dumper($self);
+
# Check if we stored uninserted relobjs here in new()
$source->storage->txn_begin if(!$self->{_rel_in_storage});
%{$self->{_inflated_column} || {}});
## Should all be in relationship_data, but we need to get rid of the
## 'filter' reltype..
+ ## These are the FK rels, need their IDs for the insert.
foreach my $relname (keys %related_stuff) {
my $relobj = $related_stuff{$relname};
if(ref $relobj ne 'ARRAY') {
$relobj->insert() if(!$relobj->in_storage);
+ print STDERR "Inserting: ", ref($relobj), "\n";
$self->set_from_related($relname, $relobj);
}
}
- $source->storage->insert($source->from, { $self->get_columns });
+ $source->storage->insert($source, { $self->get_columns });
+
+ ## PK::Auto
+ my ($pri, $too_many) = grep { !defined $self->get_column($_) ||
+ ref($self->get_column($_)) eq 'SCALAR'} $self->primary_columns;
+ if(defined $pri) {
+ $self->throw_exception( "More than one possible key found for auto-inc on ".ref $self )
+ if defined $too_many;
+
+ my $storage = $self->result_source->storage;
+ $self->throw_exception( "Missing primary key but Storage doesn't support last_insert_id" )
+ unless $storage->can('last_insert_id');
+ my $id = $storage->last_insert_id($self->result_source,$pri);
+ $self->throw_exception( "Can't get last insert id" ) unless $id;
+ $self->store_column($pri => $id);
+ }
+ ## Now do the has_many rels, that need $selfs ID.
foreach my $relname (keys %related_stuff) {
my $relobj = $related_stuff{$relname};
if(ref $relobj eq 'ARRAY') {
my $info = $self->relationship_info($relname);
## What about multi-col FKs ?
my $key = $1 if($info && (keys %{$info->{cond}})[0] =~ /^foreign\.(\w+)/);
+ print STDERR "Inserting: ", ref($obj), "\n";
$obj->set_from_related($key, $self);
$obj->insert() if(!$obj->in_storage);
}
=head2 update
- $obj->update;
+ $obj->update \%columns?;
Must be run on an object that is already in the database; issues an SQL
UPDATE query to commit any changes to the object to the database if
required.
+Also takes an options hashref of C<< column_name => value> pairs >> to update
+first. But be aware that this hashref might be edited in place, so dont rely on
+it being the same after a call to C<update>.
+
=cut
sub update {
my $ident_cond = $self->ident_condition;
$self->throw_exception("Cannot safely update a row in a PK-less table")
if ! keys %$ident_cond;
+
if ($upd) {
foreach my $key (keys %$upd) {
if (ref $upd->{$key}) {
my $rel = delete $upd->{$key};
$self->set_from_related($key => $rel);
$self->{_relationship_data}{$key} = $rel;
- }
+ } elsif ($info && $info->{attrs}{accessor}
+ && $info->{attrs}{accessor} eq 'multi'
+ && ref $upd->{$key} eq 'ARRAY') {
+ my $others = delete $upd->{$key};
+ foreach my $rel_obj (@$others) {
+ if(!Scalar::Util::blessed($rel_obj)) {
+ $rel_obj = $self->create_related($key, $rel_obj);
+ }
+ }
+ $self->{_relationship_data}{$key} = $others;
+# $related->{$key} = $others;
+ next;
+ }
elsif ($self->has_column($key)
&& exists $self->column_info($key)->{_inflate_info})
{
my %to_update = $self->get_dirty_columns;
return $self unless keys %to_update;
my $rows = $self->result_source->storage->update(
- $self->result_source->from, \%to_update, $self->{_orig_ident} || $ident_cond);
+ $self->result_source, \%to_update,
+ $self->{_orig_ident} || $ident_cond
+ );
if ($rows == 0) {
$self->throw_exception( "Can't update ${self}: row not found" );
} elsif ($rows > 1) {
unless exists $self->{_column_data}{$column};
}
$self->result_source->storage->delete(
- $self->result_source->from, $ident_cond);
+ $self->result_source, $ident_cond);
$self->in_storage(undef);
} else {
$self->throw_exception("Can't do class delete without a ResultSource instance")
projects / dbsrgits/DBIx-Class-Historic.git / blobdiff