- moved inflation to inflate_result in Row.pm
- added $rs->search_related
- split compose_namespace out of compose_connection in Schema
+ - ResultSet now handles find
+ - various *_related methods are now ->search_related->*
+ - added new_result to ResultSet
0.04999_01 2005-12-27 03:33:42
- search and related methods moved to ResultSet
}
sub ident_condition {
- my ($self) = @_;
+ my ($self, $alias) = @_;
my %cond;
- $cond{$_} = $self->get_column($_) for $self->primary_columns;
+ $cond{(defined $alias ? "${alias}.$_" : $_)} = $self->get_column($_) for $self->primary_columns;
return \%cond;
}
sub create_related {
my $class = shift;
- return $class->new_related(@_)->insert;
+ my $rel = shift;
+ return $class->search_related($rel)->create(@_);
}
=head2 new_related
sub new_related {
my ($self, $rel, $values, $attrs) = @_;
- $self->throw( "Can't call new_related as class method" )
- unless ref $self;
- $self->throw( "new_related needs a hash" )
- unless (ref $values eq 'HASH');
- my $rel_obj = $self->_relationships->{$rel};
- $self->throw( "No such relationship ${rel}" ) unless $rel_obj;
- $self->throw( "Can't abstract implicit create for ${rel}, condition not a hash" )
- unless ref $rel_obj->{cond} eq 'HASH';
- $attrs = { %{$rel_obj->{attrs}}, %{$attrs || {}}, _action => 'convert' };
-
- my %fields = %{$self->resolve_condition($rel_obj->{cond},$attrs)};
- $fields{$_} = $values->{$_} for keys %$values;
-
- return $self->resolve_class($rel_obj->{class})->new(\%fields);
+ return $self->search_related($rel)->new($values, $attrs);
}
=head2 find_related
my $self = shift;
my $rel = shift;
return $self->search_related($rel)->find(@_);
-
- # Marked for death.
- my $rel_obj = $self->_relationships->{$rel};
- $self->throw( "No such relationship ${rel}" ) unless $rel_obj;
- my ($cond) = $self->resolve_condition($rel_obj->{cond}, { _action => 'convert' });
- $self->throw( "Invalid query: @_" ) if (@_ > 1 && (@_ % 2 == 1));
- my $attrs = { };
- if (@_ > 1 && ref $_[$#_] eq 'HASH') {
- $attrs = { %{ pop(@_) } };
- }
- my $query = ((@_ > 1) ? {@_} : shift);
- $query = ($query ? { '-and' => [ $cond, $query ] } : $cond);
- return $self->resolve_class($rel_obj->{class})->find($query);
}
=head2 find_or_create_related
=cut
sub new {
- my ($class, $source, $attrs) = @_;
+ my $class = shift;
+ $class->new_result(@_) if ref $class;
+ my ($source, $attrs) = @_;
#use Data::Dumper; warn Dumper(@_);
- $class = ref $class if ref $class;
$attrs = { %{ $attrs || {} } };
my %seen;
my $alias = ($attrs->{alias} ||= 'me');
}
$attrs->{as} ||= [ map { m/^$alias\.(.*)$/ ? $1 : $_ } @{$attrs->{select}} ];
#use Data::Dumper; warn Dumper(@{$attrs}{qw/select as/});
- $attrs->{from} ||= [ { $alias => $source->name } ];
+ $attrs->{from} ||= [ { $alias => $source->from } ];
if (my $join = delete $attrs->{join}) {
foreach my $j (ref $join eq 'ARRAY'
? (@{$join}) : ($join)) {
$attrs->{where} = $where;
}
- my $rs = $self->new($self->{source}, $attrs);
+ my $rs = (ref $self)->new($self->{source}, $attrs);
return (wantarray ? $rs->all : $rs);
}
$attrs->{offset} ||= 0;
$attrs->{offset} += $min;
$attrs->{rows} = ($max ? ($max - $min + 1) : 1);
- my $slice = $self->new($self->{source}, $attrs);
+ my $slice = (ref $self)->new($self->{source}, $attrs);
return (wantarray ? $slice->all : $slice);
}
# offset, order by and page are not needed to count
delete $attrs->{$_} for qw/rows offset order_by page pager/;
- ($self->{count}) = $self->new($self->{source}, $attrs)->cursor->next;
+ ($self->{count}) = (ref $self)->new($self->{source}, $attrs)->cursor->next;
}
return 0 unless $self->{count};
my $count = $self->{count};
my ($self, $page) = @_;
my $attrs = { %{$self->{attrs}} };
$attrs->{page} = $page;
- return $self->new($self->{source}, $attrs);
+ return (ref $self)->new($self->{source}, $attrs);
+}
+
+=head2 new_result(\%vals)
+
+Creates a result in the resultset's result class
+
+=cut
+
+sub new_result {
+ my ($self, $values) = @_;
+ $self->{source}->result_class->throw( "new_result needs a hash" )
+ unless (ref $values eq 'HASH');
+ $self->{source}->result_class->throw( "Can't abstract implicit construct, condition not a hash" )
+ if ($self->{cond} && !(ref $self->{cond} eq 'HASH'));
+ my %new = %$values;
+ my $alias = $self->{attrs}{alias};
+ foreach my $key (keys %{$self->{cond}||{}}) {
+ $new{$1} = $self->{cond}{$key} if ($key =~ m/^(?:$alias\.)?([^\.]+)$/);
+ }
+ return $self->{source}->result_class->new(\%new);
+}
+
+=head2 create(\%vals)
+
+Inserts a record into the resultset and returns the object
+
+Effectively a shortcut for ->new_result(\%vals)->insert
+
+=cut
+
+sub create {
+ my ($self, $attrs) = @_;
+ $self->{source}->result_class->throw( "create needs a hashref" ) unless ref $attrs eq 'HASH';
+ return $self->new_result($attrs)->insert;
}
=head1 ATTRIBUTES
sub count { shift->resultset_instance->count(@_); }
sub count_literal { shift->resultset_instance->count_literal(@_); }
sub find { shift->resultset_instance->find(@_); }
+sub create { shift->resultset_instance->create(@_); }
1;
return $self->{_in_storage};
}
-=head2 create
-
- my $new = My::Class->create($attrs);
-
-A shortcut for My::Class->new($attrs)->insert;
-
-=cut
-
-sub create {
- my ($class, $attrs) = @_;
- $class->throw( "create needs a hashref" ) unless ref $attrs eq 'HASH';
- return $class->new($attrs)->insert;
-}
-
=head2 update
$obj->update;
$self->throw( "Not in database" ) unless $self->in_storage;
my %to_update = $self->get_dirty_columns;
return -1 unless keys %to_update;
- my $rows = $self->storage->update($self->_table_name, \%to_update,
+ my $rows = $self->storage->update($self->result_source->from, \%to_update,
$self->ident_condition);
if ($rows == 0) {
$self->throw( "Can't update ${self}: row not found" );
if (ref $self) {
$self->throw( "Not in database" ) unless $self->in_storage;
#warn $self->_ident_cond.' '.join(', ', $self->_ident_values);
- $self->storage->delete($self->_table_name, $self->ident_condition);
+ $self->storage->delete($self->result_source->from, $self->ident_condition);
$self->in_storage(undef);
#$self->store_column($_ => undef) for $self->primary_columns;
# Should probably also arrange to trash PK if auto
sub resultset {
my $self = shift;
- my $rs_class = $self->resultset_class;
- eval "use $rs_class;";
- return $rs_class->new($self);
+ return $self->{resultset} ||= $self->resultset_class->new($self);
}
=head2 has_column
return @{shift->_primaries||[]};
}
+=head2 from
+
+Returns the FROM entry for the table (i.e. the table name)
+
+=cut
+
+sub from { return shift->name(@_); }
+
1;