[Dbix-class] Set a resultset_class for a result_class from within a component loaded by the result_class

[Peter Rabbitson]

David Ihnen wrote:
> For these purposes I found this sneaky little ResultSetManager extension.
> 
> You put ResultSetManager in your load_components and you put your custom
> plugin for resultset into a load_resultset_components call.  An example
> from one of my classes.

Isn't ResultSetManager deprecated to the point of removal?

> Nothing is actually a plugin that impliments the 'Nothing' design
> pattern - that is - instead of returning null when referencing a row in
> an empty resultset (particularly ->single and ->first, which I use many
> times when NOT looping over results, hence resulting in undef
> dereference errors on empty) it instead returns a magical 'Nothing'
> object which has characteristics like - (->is_nothing === 1, ->id === 0,
> @list = $rs->method === (), $row = $rs->method === bless({}, Nothing). 

Cool, I am not the only one who finds this cool and uses it lots :)
Here is my version if you are interested. File name is Null/Pattern.pm,
used by simply __PACKAGE__->load_components (qw/Null::Pattern/)

package DBIx::Class::Null;

use warnings;
use strict;

use Scalar::Util ();
use Carp ();

use overload (
    'bool'  => sub { 0 },
    '""'    => sub { '' },
    '0+'    => sub { 0 },
    '+'     => sub { $_[2] ? $_[1] || 0 : $_[2] || 0  },
    '-'     => sub { $_[2] ? $_[1] : - $_[1] },
    '*'     => sub { 0 },
    '**'    => sub { $_[2] ? 1 : 0 },
    '/'     => sub { ($_[2] or ( Scalar::Util::blessed ($_[1]) and $_[1]->isa (__PACKAGE__) ) )
        ? Carp::croak 'Illegal division by zero'
        : 0
    },
    '<=>'   => sub { $_[2]
        ? $_[1] <=> 0
        : 0 <=> $_[1]
    },
    cmp => sub { $_[2]
        ? $_[1] cmp 0
        : 0 cmp $_[1]
    },
);

my $null;
sub AUTOLOAD {
    $null = bless ( \ do{ 0 }, shift ) unless defined $null;
    return $null;
}

sub import {
    my $class = shift;
    my $caller = caller(0);

    no strict 'refs';
    no warnings qw/uninitialized/;
    while (@_) {
        my $arg = shift;
        if ($arg eq 'is_defined') {
            *{"$caller\::is_defined"} = sub ($) {
                if (defined $_[0] and not ( Scalar::Util::blessed ($_[0]) and $_[0]->isa (__PACKAGE__) ) ) {
                    return 1;
                }
                esle {
                    return 0;
                }
            };
        }
        else {
            Carp::croak (qq/"$arg" is not exported by the $class module/);
        }
    }
}

sub all { return () }   # so for ($rs->all) will work correctly

sub DESTROY {}

1;
package DBIx::Class::Null::Pattern;

use warnings;
use strict;

use base qw/DBIx::Class/;

use DBIx::Class::Null qw/is_defined/;

sub _inflated_column {
    if (defined $_[2]) {
        return next::method (@_);
    }
    return DBIx::Class::Null->new;
}

sub find_or_new_related {
    my $self = shift;
    my $obj = $self->find_related(@_);
    return is_defined $obj ? $obj : $self->new_related(@_);
}

sub find_or_create_related {
    my $self = shift;
    my $obj = $self->find_related(@_);
    return is_defined $obj ? $obj : $self->create_related(@_);
}

__PACKAGE__->load_components (qw/Core/);
__PACKAGE__->table ('bogus');
__PACKAGE__->resultset_class ('DBIx::Class::Resultset::Null::Pattern');

1;

package DBIx::Class::Resultset::Null::Pattern;

use warnings;
use strict;

use base qw/DBIx::Class::ResultSet/;

use DBIx::Class::Null qw/is_defined/;
use Data::Dumper;
use Devel::StackTrace;

sub single {
    my $obj = shift->next::method (@_);
    return is_defined $obj ? $obj : DBIx::Class::Null->new;
}

sub first {
    my $obj = shift->next::method (@_);
    return is_defined $obj ? $obj : DBIx::Class::Null->new;
}

sub find_or_new {
    my $self     = shift;
    my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
    my $hash     = ref $_[0] eq 'HASH' ? shift : {@_};
    my $exists   = $self->find($hash, $attrs);
    return is_defined $exists ? $exists : $self->new_result($hash);
}

sub find_or_create {
    my $self     = shift;
    my $attrs    = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
    my $hash     = ref $_[0] eq 'HASH' ? shift : {@_};
    my $exists   = $self->find($hash, $attrs);
    return is_defined $exists ? $exists : $self->create($hash);
}

1;