view release on metacpan or  search on metacpan

lib/DBIx/Class/ResultSet/Void.pm  view on Meta::CPAN

package DBIx::Class::ResultSet::Void;
$DBIx::Class::ResultSet::Void::VERSION = '0.07';
# ABSTRACT: improve DBIx::Class::ResultSet with void context

use strict;
use warnings;
use Carp::Clan qw/^DBIx::Class/;
use Try::Tiny;

use base qw(DBIx::Class::ResultSet);

sub exists {
    my ($self, $query) = @_;

    return $self->search(
        $query,
        {
            rows   => 1,
            select => [\'1']})->single;
}

sub find_or_create {
    my $self = shift;

    return $self->next::method(@_) if (defined wantarray);

    my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
    my $hash = ref $_[0] eq 'HASH' ? shift : {@_};

    my $query = $self->___get_primary_or_unique_key($hash, $attrs);
    my $exists = $self->exists($query);
    $self->create($hash) unless $exists;
}

sub update_or_create {
    my $self = shift;

    return $self->next::method(@_) if (defined wantarray);

    my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
    my $cond = ref $_[0] eq 'HASH' ? shift : {@_};

    my $query = $self->___get_primary_or_unique_key($cond, $attrs);
    my $exists = $self->exists($query);

    if ($exists) {
        # dirty hack, to remove WHERE cols from SET
        my $query_array = ref $query eq 'ARRAY' ? $query : [$query];
        foreach my $_query (@$query_array) {
            foreach my $_key (keys %$_query) {
                delete $cond->{$_key};
                delete $cond->{$1} if $_key =~ /\w+\.(\w+)/;    # $alias.$col
            }
        }
        $self->search($query)->update($cond) if keys %$cond;
    } else {
        $self->create($cond);
    }
}

# mostly copied from sub find
sub ___get_primary_or_unique_key {
    my $self = shift;
    my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});

    my $rsrc = $self->result_source;

    my $constraint_name;
    if (exists $attrs->{key}) {
        $constraint_name =
            defined $attrs->{key}
            ? $attrs->{key}
            : $self->throw_exception("An undefined 'key' resultset attribute makes no sense");
    }

    # Parse out the condition from input
    my $call_cond;

    if (ref $_[0] eq 'HASH') {
        $call_cond = {%{$_[0]}};
    } else {
        # if only values are supplied we need to default to 'primary'
        $constraint_name = 'primary' unless defined $constraint_name;

        my @c_cols = $rsrc->unique_constraint_columns($constraint_name);

        $self->throw_exception("No constraint columns, maybe a malformed '$constraint_name' constraint?") unless @c_cols;

        $self->throw_exception('find() expects either a column/value hashref, or a list of values '
                . "corresponding to the columns of the specified unique constraint '$constraint_name'")
            unless @c_cols == @_;

        @{$call_cond}{@c_cols} = @_;
    }