CatalystX::CRUD::Model::RDBO - Rose::DB::Object CRUD

 package MyApp::Model::Foo;
 use base qw( CatalystX::CRUD::Model::RDBO );
 __PACKAGE__->config( 
            name                => 'My::RDBO::Foo', 
            manager             => 'My::RDBO::Foo::Manager',
            load_with           => [qw( bar )],
            related_load_with   => {
                bars => ['doof']
            },
            page_size           => 50,
            );
 1;

 my $foo = $c->model('Foo')->fetch( id => 1234 );
 if (@{ $c->error })
 {
    # do something to deal with the error
 }

 my $foo = $c->model('Foo')->new_object( id => 1234 );
 $foo->load_speculative;
 if ($foo->not_found)
 {
   # do something
 }

    perldoc CatalystX::CRUD::Model::RDBO

package CatalystX::CRUD::Model::RDBO;
use strict;
use warnings;
use base qw( CatalystX::CRUD::Model CatalystX::CRUD::Model::Utils );
use CatalystX::CRUD::Iterator;
use MRO::Compat;
use mro 'c3';
use Carp;
use Data::Dump qw( dump );

our $VERSION = '0.22';

__PACKAGE__->mk_ro_accessors(
    qw( name manager treat_like_int load_with related_load_with ));
__PACKAGE__->config( object_class => 'CatalystX::CRUD::Object::RDBO' );

sub Xsetup {
    my $self = shift;

    $self->next::method(@_);

    $self->{name} = $self->config->{name};
    if ( !$self->name ) {
        return if $self->throw_error("need to configure a Rose class name");
    }

    $self->{manager} = $self->config->{manager} || $self->name . '::Manager';

    my $name = $self->name;
    my $mgr  = $self->manager;

    eval "require $name";
    if ($@) {
        return if $self->throw_error($@);
    }

    # what kind of db driver are we using. makes a difference in make_query().
    my $db = $name->new->db;
    $self->use_ilike(1) if $db->driver eq 'pg';

    # rdbo sql uses 'ne' for not equal
    $self->ne_sign('ne');

    # cache the treat_like_int hash
    $self->_treat_like_int;

    # load the Manager
    eval "require $mgr";

    # don't fret -- just use RDBO::Manager
    if ($@) {
        $self->{manager} = 'Rose::DB::Object::Manager';
        require Rose::DB::Object::Manager;
    }

    # turn on debugging help
    if ( $ENV{CATALYST_DEBUG} && $ENV{CATALYST_DEBUG} > 1 ) {
        $Rose::DB::Object::QueryBuilder::Debug = 1;
        $Rose::DB::Object::Debug               = 1;
        $Rose::DB::Object::Manager::Debug      = 1;
    }

}

sub new_object {
    my $self = shift;
    my $rdbo = $self->name;
    my $obj;
    eval { $obj = $rdbo->new(@_) };
    if ( $@ or !$obj ) {
        my $err = defined($obj) ? $obj->error : $@;
        return if $self->throw_error("can't create new $rdbo object: $err");
    }
    return $self->next::method( delegate => $obj );
}

sub fetch {
    my $self = shift;
    my $obj = $self->new_object(@_) or return;

    if (@_) {
        my %v = @_;
        my $ret;
        my $name = $self->name;
        my @arg  = ();
        eval { $ret = $obj->read(@arg); };
        if ( $@ or !$ret ) {
            return
                if $self->throw_error( join( " : ", $@, "no such $name" ) );
        }

        # special handling of fetching
        # e.g. Catalyst::Plugin::Session::Store::DBI records.
        if ( $v{id} ) {

            # stringify in case it's a char instead of int
            # as is the case with session ids
            my $pid = $obj->delegate->id;
            $pid =~ s,\s+$,,;
            unless ( $pid eq $v{id} ) {

                return
                    if $self->throw_error(
                          "Error fetching correct id:\nfetched: $v{id} "
                        . length( $v{id} )
                        . "\nbut got: $pid"
                        . length($pid) );
            }
        }
    }

    return $obj;
}

sub search {
    my $self = shift;
    my $objs = $self->_get_objects( 'get_objects', @_ );

    # save ourselves lots of method-call overhead.
    my $class = $self->object_class;

    my @wrapped = map { $class->new( delegate => $_ ) } @$objs;
    return wantarray ? @wrapped : \@wrapped;
}

sub count {
    my $self = shift;
    return $self->_get_objects( 'get_objects_count', @_ );
}

sub iterator {
    my $self = shift;
    my $iter = $self->_get_objects( 'get_objects_iterator', @_ );
    return CatalystX::CRUD::Iterator->new( $iter, $self->object_class );
}

sub _related_query {
    my ( $self, $obj, $rel_name ) = @_;
    my $relationship = $self->has_relationship( $obj, $rel_name )
        or $self->throw_error("no relationship for $rel_name");

    # set the param so sort is correctly mangled in make_query()
    if ($relationship->isa(
            'Rose::DB::Object::Metadata::Relationship::ManyToMany')
        )
    {
        $self->context->req->params->{'cxc-m2m'} = 1;
    }
    my $query = $self->make_query;
    my @arg;
    if ( @{ $query->{query} } ) {
        @arg = ( query => $query->{query} );
    }
    for (qw( limit offset sort_by )) {
        if ( exists $query->{$_} and length $query->{$_} ) {
            push( @arg, $_ => $query->{$_} );
        }
    }
    if ( $self->related_load_with
        && exists $self->related_load_with->{$rel_name} )
    {
        push(
            @arg,
            with_objects  => $self->related_load_with->{$rel_name},
            multi_many_ok => 1
        );
    }

    #warn dump \@arg;
    return @arg;
}

sub search_related {
    my ( $self, $obj, $rel ) = @_;
    return $obj->$rel( $self->_related_query( $obj, $rel ) );
}

sub iterator_related {
    my ( $self, $obj, $rel ) = @_;
    my $method = $rel . '_iterator';
    return $obj->$method( $self->_related_query( $obj, $rel ) );
}

sub count_related {
    my ( $self, $obj, $rel ) = @_;
    my $method = $rel . '_count';
    return $obj->$method( $self->_related_query( $obj, $rel ) );
}

sub _get_rel_meta {
    my ( $self, $obj, $rel_name ) = @_;

    my $rel = $self->has_relationship( $obj, $rel_name )
        or $self->throw_error("no such relationship $rel_name");

    if ( $rel->isa('Rose::DB::Object::Metadata::Relationship::ManyToMany') ) {

        my $map_class = $rel->map_class;
        my $mcm       = $map_class->meta;
        my @map_to    = $mcm->relationship( $rel->map_to )->column_map;
        my @map_from  = $mcm->relationship( $rel->map_from )->column_map;
        my %m         = (
            map_to    => \@map_to,
            map_from  => \@map_from,
            map_class => $map_class,
        );

        #carp dump \%m;

        return \%m;

    }
    else {
        $self->throw_error( "unsupport relationship type: " . ref($rel) );
    }
}

sub has_relationship {
    my ( $self, $obj, $rel_name ) = @_;
    return $obj->delegate->meta->relationship($rel_name);
}

sub add_related {
    my ( $self, $obj, $rel_name, $fk_val ) = @_;
    my $addmethod = 'add_' . $rel_name;
    my $meta      = $self->_get_rel_meta( $obj, $rel_name );
    my $fpk       = $meta->{map_to}->[1];
    $obj->$addmethod( { $fpk => $fk_val } );
    $obj->save;

    # so next access reflects change.
    $obj->forget_related($rel_name);
}

sub rm_related {
    my ( $self, $obj, $rel_name, $fk_val ) = @_;

    my $meta = $self->_get_rel_meta( $obj, $rel_name );
    my $obj_method = $obj->delegate->meta->column_accessor_method_name(
        $meta->{map_from}->[1] );
    my $query = [
        $meta->{map_from}->[0] => $obj->$obj_method,
        $meta->{map_to}->[0]   => $fk_val,
    ];

    #carp dump $query;

    $self->manager->delete_objects(
        object_class => $meta->{map_class},
        where        => $query,
    );

    # so next access reflects change
    $obj->forget_related($rel_name);
    return $obj;
}

sub _get_field_names {
    my $self = shift;
    return $self->{_field_names} if $self->{_field_names};
    my @cols = $self->name->meta->column_names;
    $self->{_field_names} = \@cols;
    return \@cols;
}

sub _treat_like_int {
    my $self = shift;
    return $self->{treat_like_int} if $self->{treat_like_int};
    $self->{treat_like_int} = {};
    my $col_names = $self->_get_field_names;

    # treat wildcard timestamps like ints not text (>= instead of ILIKE)
    for my $name (@$col_names) {
        my $col = $self->name->meta->column($name);
        if ( $col->type =~ m/date|time|boolean|int/ ) {
            $self->{treat_like_int}->{$name} = 1;
        }
    }

    return $self->{treat_like_int};
}

sub _join_with_table_prefix {
    my ( $self, $q, $prefix ) = @_;
    return join( ', ',
        map     { $prefix . '.' . $_->[0] . ' ' . $_->[1] }
            map { [%$_] } @{ $q->{sort_order} } );
}

sub make_query {
    my $self        = shift;
    my $c           = $self->context;
    my $field_names = shift || $self->_get_field_names;
    my $q           = $self->make_sql_query($field_names);

    # many2many relationships always have two tables,
    # and we are sorting my the 2nd one. The 1st one is the mapper.
    # however, we leave sort_by alone if it already has . in it,
    # since then we assume the request knew enough to ask.
    if ( length( $q->{sort_by} ) && !( $q->{sort_by} =~ m/\./ ) ) {
        if ( $c->req->params->{'cxc-m2m'} ) {
            if ( !( $q->{sort_by} =~ m/t\d\./ ) ) {
                $q->{sort_by} = $self->_join_with_table_prefix( $q, 't2' );
            }
        }
        else {
            if ( !( $q->{sort_by} =~ m/t\d\./ ) ) {
                $q->{sort_by} = $self->_join_with_table_prefix( $q, 't1' );
            }
        }
    }

    $c->log->debug("make_query: WHERE $q->{query_obj} ORDER BY $q->{sort_by}")
        if $c->debug;

    return $q;
}

sub _get_objects {
    my $self    = shift;
    my $method  = shift || 'get_objects';
    my @args    = @_;
    my $manager = $self->manager;
    my $name    = $self->name;
    my @params  = ( object_class => $name );    # not $self->object_class

    if ( ref $args[0] eq 'HASH' ) {
        push( @params, %{ $args[0] } );
    }
    elsif ( ref $args[0] eq 'ARRAY' ) {
        push( @params, @{ $args[0] } );
    }
    else {
        push( @params, @args );
    }

    push(
        @params,
        with_objects  => $self->load_with,
        multi_many_ok => 1
    ) if $self->load_with;

    return $manager->$method(@params);
}

1;

__END__