$attrs->{as} ||= [ map { m/^\Q$alias.\E(.+)$/ ? $1 : $_ } @{$attrs->{select}} ];
if (my $include = delete $attrs->{include_columns}) {
push(@{$attrs->{select}}, @$include);
- push(@{$attrs->{as}}, map { m/([^\.]+)$/; $1; } @$include);
+ push(@{$attrs->{as}}, map { m/([^.]+)$/; $1; } @$include);
}
#use Data::Dumper; warn Dumper(@{$attrs}{qw/select as/});
my $attrs = { %{$self->{attrs}} };
my $having = delete $attrs->{having};
- if (@_ > 1 && ref $_[$#_] eq 'HASH') {
- $attrs = { %$attrs, %{ pop(@_) } };
- }
+ $attrs = { %$attrs, %{ pop(@_) } } if @_ > 1 and ref $_[$#_] eq 'HASH';
my $where = (@_
? ((@_ == 1 || ref $_[0] eq "HASH")
: {@_}))
: undef());
if (defined $where) {
- $where = (defined $attrs->{where}
+ $attrs->{where} = (defined $attrs->{where}
? { '-and' =>
[ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
$where, $attrs->{where} ] }
: $where);
- $attrs->{where} = $where;
}
if (defined $having) {
- $having = (defined $attrs->{having}
+ $attrs->{having} = (defined $attrs->{having}
? { '-and' =>
[ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
$having, $attrs->{having} ] }
: $having);
- $attrs->{having} = $having;
}
$rs = (ref $self)->new($self->result_source, $attrs);
}
else {
$rs = $self;
- $rs->reset();
+ $rs->reset;
}
return (wantarray ? $rs->all : $rs);
}
my @cols = $self->result_source->primary_columns;
if (exists $attrs->{key}) {
my %uniq = $self->result_source->unique_constraints;
- $self->( "Unknown key " . $attrs->{key} . " on " . $self->name )
+ $self->throw_exception( "Unknown key $attrs->{key} on $self->name" )
unless exists $uniq{$attrs->{key}};
@cols = @{ $uniq{$attrs->{key}} };
}
} else {
$query = {@vals};
}
- foreach (keys %$query) {
- next if m/\./;
- $query->{$self->{attrs}{alias}.'.'.$_} = delete $query->{$_};
+ foreach my $key (grep { ! m/\./ } keys %$query) {
+ $query->{"$self->{attrs}{alias}.$key"} = delete $query->{$key};
}
#warn Dumper($query);
sub cursor {
my ($self) = @_;
- my ($attrs) = $self->{attrs};
- $attrs = { %$attrs };
+ my $attrs = { %{$self->{attrs}} };
return $self->{cursor}
||= $self->result_source->storage->select($self->{from}, $attrs->{select},
$attrs->{where},$attrs);
=cut
sub single {
- my ($self, $extra) = @_;
- my ($attrs) = $self->{attrs};
- $attrs = { %$attrs };
- if ($extra) {
+ my ($self, $where) = @_;
+ my $attrs = { %{$self->{attrs}} };
+ if ($where) {
if (defined $attrs->{where}) {
$attrs->{where} = {
- '-and'
- => [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
- delete $attrs->{where}, $extra ]
+ '-and' =>
+ [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
+ $where, delete $attrs->{where} ]
};
} else {
- $attrs->{where} = $extra;
+ $attrs->{where} = $where;
}
}
my @data = $self->result_source->storage->select_single(
=cut
sub search_like {
- my $class = shift;
- my $attrs = { };
- if (@_ > 1 && ref $_[$#_] eq 'HASH') {
- $attrs = pop(@_);
- }
- my $query = ref $_[0] eq "HASH" ? { %{shift()} }: {@_};
+ my $class = shift;
+ my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
+ my $query = ref $_[0] eq 'HASH' ? { %{shift()} }: {@_};
$query->{$_} = { 'like' => $query->{$_} } for keys %$query;
return $class->search($query, { %$attrs });
}
sub next {
my ($self) = @_;
- my $cache;
- if( @{$cache = $self->{all_cache} || []}) {
+ if (@{$self->{all_cache} || []}) {
$self->{all_cache_position} ||= 0;
- my $obj = $cache->[$self->{all_cache_position}];
- $self->{all_cache_position}++;
- return $obj;
+ return $self->{all_cache}->[$self->{all_cache_position}++];
}
if ($self->{attrs}{cache}) {
$self->{all_cache_position} = 1;
sub _construct_object {
my ($self, @row) = @_;
my @as = @{ $self->{attrs}{as} };
-
+
my $info = $self->_collapse_result(\@as, \@row);
-
+
my $new = $self->result_class->inflate_result($self->result_source, @$info);
-
+
$new = $self->{attrs}{record_filter}->($new)
if exists $self->{attrs}{record_filter};
-
return $new;
}
if (defined $prefix) {
if ($this_as =~ m/^\Q${prefix}.\E(.+)$/) {
my $remain = $1;
- $remain =~ /^(?:(.*)\.)?([^\.]+)$/;
+ $remain =~ /^(?:(.*)\.)?([^.]+)$/;
$const{$1||''}{$2} = $val;
}
} else {
- $this_as =~ /^(?:(.*)\.)?([^\.]+)$/;
+ $this_as =~ /^(?:(.*)\.)?([^.]+)$/;
$const{$1||''}{$2} = $val;
}
}
$tree = $self->_collapse_result($as, $row, $c_prefix);
#warn Data::Dumper::Dumper($tree, $row);
}
- @{$target} = @final;
+ @$target = @final;
}
return $info;
sub count {
my $self = shift;
- return $self->search(@_)->count if @_ && defined $_[0];
+ return $self->search(@_)->count if @_ and defined $_[0];
unless (defined $self->{count}) {
- return scalar @{ $self->get_cache }
- if @{ $self->get_cache };
- my $group_by;
- my $select = { 'count' => '*' };
+ return scalar @{ $self->get_cache } if @{ $self->get_cache };
+ my $select = { count => '*' };
my $attrs = { %{ $self->{attrs} } };
- if( $group_by = delete $attrs->{group_by} ) {
+ if (my $group_by = delete $attrs->{group_by}) {
delete $attrs->{having};
my @distinct = (ref $group_by ? @$group_by : ($group_by));
# todo: try CONCAT for multi-column pk
my @pk = $self->result_source->primary_columns;
- if( scalar(@pk) == 1 ) {
- my $pk = shift(@pk);
- my $alias = $attrs->{alias};
- my $re = qr/^($alias\.)?$pk$/;
- foreach my $column ( @distinct) {
- if( $column =~ $re ) {
- @distinct = ( $column );
+ if (@pk == 1) {
+ foreach my $column (@distinct) {
+ if ($column =~ qr/^(?:\Q$attrs->{alias}.\E)?$pk[0]$/) {
+ @distinct = ($column);
last;
}
}
}
- $select = { count => { 'distinct' => \@distinct } };
+ $select = { count => { distinct => \@distinct } };
#use Data::Dumper; die Dumper $select;
}
$attrs->{select} = $select;
- $attrs->{as} = [ 'count' ];
+ $attrs->{as} = [qw/count/];
# offset, order by and page are not needed to count. record_filter is cdbi
delete $attrs->{$_} for qw/rows offset order_by page pager record_filter/;
my $count = $self->{count};
$count -= $self->{attrs}{offset} if $self->{attrs}{offset};
$count = $self->{attrs}{rows} if
- ($self->{attrs}{rows} && $self->{attrs}{rows} < $count);
+ $self->{attrs}{rows} and $self->{attrs}{rows} < $count;
return $count;
}
sub all {
my ($self) = @_;
- return @{ $self->get_cache }
- if @{ $self->get_cache };
+ return @{ $self->get_cache } if @{ $self->get_cache };
my @obj;
push(@obj, $self->_construct_object(@row));
}
} else {
- @obj = map { $self->_construct_object(@$_); }
- $self->cursor->all;
- }
-
- if( $self->{attrs}->{cache} ) {
- $self->set_cache( \@obj );
+ @obj = map { $self->_construct_object(@$_) } $self->cursor->all;
}
+ $self->set_cache(\@obj) if $self->{attrs}{cache};
return @obj;
}
if (ref $self->{cond} eq 'ARRAY') {
$del = [ map { my %hash;
foreach my $key (keys %{$_}) {
- $key =~ /([^\.]+)$/;
+ $key =~ /([^.]+)$/;
$hash{$1} = $_->{$key};
}; \%hash; } @{$self->{cond}} ];
} elsif ((keys %{$self->{cond}})[0] eq '-and') {
$del->{-and} = [ map { my %hash;
foreach my $key (keys %{$_}) {
- $key =~ /([^\.]+)$/;
+ $key =~ /([^.]+)$/;
$hash{$1} = $_->{$key};
}; \%hash; } @{$self->{cond}{-and}} ];
} else {
foreach my $key (keys %{$self->{cond}}) {
- $key =~ /([^\.]+)$/;
+ $key =~ /([^.]+)$/;
$del->{$1} = $self->{cond}{$key};
}
}
my %new = %$values;
my $alias = $self->{attrs}{alias};
foreach my $key (keys %{$self->{cond}||{}}) {
- $new{$1} = $self->{cond}{$key} if ($key =~ m/^(?:$alias\.)?([^\.]+)$/);
+ $new{$1} = $self->{cond}{$key} if ($key =~ m/^(?:\Q${alias}.\E)?([^.]+)$/);
}
my $obj = $self->result_class->new(\%new);
$obj->result_source($self->result_source) if $obj->can('result_source');
- $obj;
+ return $obj;
}
=head2 create
sub find_or_create {
my $self = shift;
my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
- my $hash = ref $_[0] eq "HASH" ? shift : {@_};
+ my $hash = ref $_[0] eq 'HASH' ? shift : {@_};
my $exists = $self->find($hash, $attrs);
- return defined($exists) ? $exists : $self->create($hash);
+ return defined $exists ? $exists : $self->create($hash);
}
=head2 update_or_create
sub update_or_create {
my $self = shift;
-
my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
- my $hash = ref $_[0] eq "HASH" ? shift : {@_};
+ my $hash = ref $_[0] eq 'HASH' ? shift : {@_};
my %unique_constraints = $self->result_source->unique_constraints;
my @constraint_names = (exists $attrs->{key}
if (scalar keys %unique_hash == scalar @unique_cols);
}
- my $row;
if (@unique_hashes) {
- $row = $self->search(\@unique_hashes, { rows => 1 })->first;
- if ($row) {
+ my $row = $self->single(\@unique_hashes);
+ if (defined $row) {
$row->set_columns($hash);
$row->update;
+ return $row;
}
}
- unless ($row) {
- $row = $self->create($hash);
- }
-
- return $row;
+ return $self->create($hash);
}
=head2 get_cache
=cut
sub get_cache {
- my $self = shift;
- return $self->{all_cache} || [];
+ shift->{all_cache} || [];
}
=head2 set_cache
=cut
sub clear_cache {
- my $self = shift;
- $self->set_cache([]);
+ shift->set_cache([]);
}
=head2 related_resultset
sub related_resultset {
my ( $self, $rel, @rest ) = @_;
$self->{related_resultsets} ||= {};
- my $resultsets = $self->{related_resultsets};
- if( !exists $resultsets->{$rel} ) {
- #warn "fetching related resultset for rel '$rel'";
- my $rel_obj = $self->result_source->relationship_info($rel);
- $self->throw_exception(
- "search_related: result source '" . $self->result_source->name .
- "' has no such relationship ${rel}")
- unless $rel_obj; #die Dumper $self->{attrs};
- my $rs = $self->search(undef, { join => $rel });
- #if( $self->{attrs}->{cache} ) {
- # $rs = $self->search(undef);
- #}
- #else {
- #}
- #use Data::Dumper; die Dumper $rs->{attrs};#$rs = $self->search( undef );
- #use Data::Dumper; warn Dumper $self->{attrs}, Dumper $rs->{attrs};
- my $alias = (defined $rs->{attrs}{seen_join}{$rel}
- && $rs->{attrs}{seen_join}{$rel} > 1
- ? join('_', $rel, $rs->{attrs}{seen_join}{$rel})
- : $rel);
- $resultsets->{$rel} =
+ return $self->{related_resultsets}{$rel} ||= do {
+ #warn "fetching related resultset for rel '$rel'";
+ my $rel_obj = $self->result_source->relationship_info($rel);
+ $self->throw_exception(
+ "search_related: result source '" . $self->result_source->name .
+ "' has no such relationship ${rel}")
+ unless $rel_obj; #die Dumper $self->{attrs};
+
+ my $rs = $self->search(undef, { join => $rel });
+ my $alias = defined $rs->{attrs}{seen_join}{$rel}
+ && $rs->{attrs}{seen_join}{$rel} > 1
+ ? join('_', $rel, $rs->{attrs}{seen_join}{$rel})
+ : $rel;
+
$self->result_source->schema->resultset($rel_obj->{class}
)->search( undef,
{ %{$rs->{attrs}},
alias => $alias,
- select => undef(),
- as => undef() }
- )->search(@rest);
- }
- return $resultsets->{$rel};
+ select => undef,
+ as => undef }
+ )->search(@rest);
+ };
}
=head2 throw_exception
projects / dbsrgits/DBIx-Class.git / commitdiff