File Coverage

blib/lib/WebAPI/DBIC/Resource/ActiveModel/Role/DBIC.pm

Criterion	Covered	Total	%
statement	12	93	12.9
branch	0	24	0.0
condition	0	12	0.0
subroutine	4	13	30.7
pod	0	6	0.0
total	16	148	10.8

package WebAPI::DBIC::Resource::ActiveModel::Role::DBIC;
$WebAPI::DBIC::Resource::ActiveModel::Role::DBIC::VERSION = '0.004001';

use Carp qw(croak confess);
use Devel::Dwarn;
use JSON::MaybeXS qw(JSON);

use Moo::Role;


requires 'get_url_for_item_relationship';
requires 'render_item_as_plain_hash';
requires 'path_for_item';
requires 'add_params_to_url';
requires 'prefetch';
requires 'type_namer';



sub activemodel_type {
    my ($self) = @_;
    return $self->type_namer->type_name_for_resultset($self->set);
}




sub render_activemodel_prefetch_rel {
    my ($self, $set, $parent_relname, $relname, $rel_sets, $item_edit_rel_hooks) = @_;

    my $parent_class = $set->result_class;
    my $child_class = $parent_class->relationship_info($relname)->{class} || die "panic";

    my @idcolumns = $child_class->unique_constraint_columns('primary'); # XXX wrong
    if (@idcolumns > 1) { # eg many-to-many that doesn't have a separate id
        warn "Child result class $child_class has multiple keys (@idcolumns) so relations like $relname won't have links generated.\n"
            unless our $warn_once->{"$child_class $relname"}++;
        return;
    }

    my $rel_typename = $self->type_namer->type_name_for_result_class($child_class);

    return if $item_edit_rel_hooks->{$parent_relname}->{$relname};

    $item_edit_rel_hooks->{$parent_relname}->{$relname} = sub {
        my ($activemodel_obj, $row) = @_;

        my $subitem = $row->$relname();

        my $rel_set = $rel_sets->{$rel_typename} ||= {};

        my $rel_ids;
        if (not defined $subitem) {
            $rel_ids = undef;
        }
        elsif ($subitem->isa('DBIx::Class::ResultSet')) { # one-to-many rel
            $rel_ids = [];
            while (my $subrow = $subitem->next) {
                my $id = $subrow->id;
                push @$rel_ids, $id;
                my $rel_object = $self->render_row_as_activemodel_resource_object($subrow, undef, sub {
                    my ($activemodel_obj, $row) = @_;
                    $_->($activemodel_obj, $row) for values %{$item_edit_rel_hooks->{$relname}};
                });
                # In case this object has been pulled in before, do what we can
                # to preserve the existing keys and add to them as appropriate.
                $rel_set->{$id} //= {};
                $rel_set->{$id} = { %{$rel_object}, %{$rel_set->{$id}} };
            }
        }
        elsif ($subitem->isa('DBIx::Class::Row')) { # one-to-one rel
            $rel_ids = $subitem->id;
            my $rel_object = $self->render_row_as_activemodel_resource_object($subitem, undef, sub {
                my ($activemodel_obj, $row) = @_;
                $_->($activemodel_obj, $row) for values %{$item_edit_rel_hooks->{$relname}};
            });
                # In case this object has been pulled in before, do what we can
                # to preserve the existing keys and add to them as appropriate.
            $rel_set->{$subitem->id} //= {};
            $rel_set->{$subitem->id} = { %{$rel_object}, %{$rel_set->{$subitem->id}} };
        }
        else {
            die "panic: don't know how to handle $row $relname value $subitem";
        }

        # XXX We could either create a 'relationship_namer' similar to the 'type_namer',
        # or create a mechanism to facilitate adapter/serializer classes.
        # Per http://emberjs.com/api/data/classes/DS.ActiveModelAdapter.html:
        # This should use the relationship name, singularized, and suffixed with
        # '_id' for belongsTo relationships or '_ids' for hasMany relationships.
        if ($rel_ids) {
            my $suffix = ref($rel_ids) ? '_ids' : '_id';
            my $relname_id = Lingua::EN::Inflect::Number::to_S($relname).$suffix;
            $activemodel_obj->{$relname_id} = $rel_ids;
        }
    }
}


sub render_activemodel_response { # return top-level document hashref
    my ($self) = @_;

    my $set = $self->set;
    my $prefetch = $self->prefetch;

    my $rel_sets = {};
    my $item_edit_rel_hooks = {};

    $self->traverse_prefetch($set, [ 'top' ], $prefetch, sub {
        my ($self, $set, $parent_rel, $prefetch) = @_;
        #warn "$self: $set, $parent_rel, $prefetch\n";
        $self->render_activemodel_prefetch_rel($set, $parent_rel->[-1], $prefetch, $rel_sets, $item_edit_rel_hooks)
    });

    my $result_class = $set->result_class;
    my $set_data = $self->render_set_as_array_of_activemodel_resource_objects($set, undef, sub {
        my ($activemodel_obj, $row) = @_;
        $_->($activemodel_obj, $row) for values %{$item_edit_rel_hooks->{'top'}};
    });

    # construct top document to return
    my $top_set_key = ($self->param('distinct')) ? 'data' : $self->activemodel_type;
    my $top_doc = { # http://jsonapi.org/format/#document-structure-top-level
        $top_set_key => $set_data,
    };

    if (keys %$rel_sets) {
        while ( my ($k, $v) = each %$rel_sets) {
            # sort just for test stability,
            $top_doc->{$k} = [ @{$v}{ sort keys %$v } ];
        }
    }

    my $total_items;
    if (($self->param('with')||'') =~ /count/) { # XXX
        $total_items = $set->pager->total_entries;
        $top_doc->{meta}{count} = $total_items; # XXX detail not in spec
    }

    return $top_doc;
}



sub render_item_as_activemodel_hash {
    my ($self, $item) = @_;

    my $data = $self->render_item_as_plain_hash($item);

    return $data;
}


sub render_set_as_array_of_activemodel_resource_objects {
    my ($self, $set, $render_method, $edit_hook) = @_;

    my @activemodel_objs;
    while (my $row = $set->next) {
        push @activemodel_objs, $self->render_row_as_activemodel_resource_object($row, $render_method, $edit_hook);
    }

    return \@activemodel_objs;
}

sub render_row_as_activemodel_resource_object {
    my ($self, $row, $render_method, $edit_hook) = @_;
    $render_method ||= 'render_item_as_activemodel_hash';

    my $obj = $self->$render_method($row);
    $edit_hook->($obj, $row) if $edit_hook;

    return $obj;
}





1;

__END__

=pod

=encoding UTF-8

=head1 NAME

WebAPI::DBIC::Resource::ActiveModel::Role::DBIC

=head1 VERSION

version 0.004001

=head1 NAME

WebAPI::DBIC::Resource::ActiveModel::Role::DBIC - a role with core methods for DBIx::Class resources

=head1 AUTHOR

Tim Bunce <[e-mail]>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2015 by Tim Bunce.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut