concept to realize complex joins on DBIC backend

We implemented dbic style joins by extending the config of a single schema:

      'x-dbic' => {
        join => 'OfficeEmployee',
        'x-inject-properties' => {
          'OfficeEmployee' => [ qw( firstname ) ],
        },
      }

The properties are injected into the resulting schema by fetching them from referenced schema. Only those properties which are listed are injected.

The join really happens in the DBIC backend, currently on the list request:

sub list {
    my ( $self, $schema_name, $params, $opt ) = @_;
    $params ||= {}; $opt ||= {};
    my $schema = $self->schema->{ $schema_name };
    my $real_schema = ( $schema->{'x-view'} || {} )->{schema} // $schema_name;
    my $props = $schema->{properties}
        || $self->schema->{ $real_schema }{properties};
    my %rs_opt = (
        order_by => $opt->{order_by},
        select => [ keys %$props ],
    );

# >>>
    if (my $dbic = $schema->{ 'x-dbic' } || $self->schema->{ $real_schema }{ 'x-dbic' }) {
        $rs_opt{ prefetch } = $dbic->{ 'x-join' };

        # update order_by setting
        $rs_opt{ order_by } = [
            map +{ (%$_)[0] => index( (%$_)[1], '.' ) >= 0 ? (%$_)[1] : 'me.' . (%$_)[1] },
            @{$rs_opt{ order_by }}
        ];
    }
# <<<

    if ( $opt->{limit} ) {
        die "Limit must be number" if !looks_like_number $opt->{limit};
        $rs_opt{ rows } = $opt->{limit};
    }
    if ( $opt->{offset} ) {
        die "Offset must be number" if !looks_like_number $opt->{offset};
        $rs_opt{ offset } = $opt->{offset};
    }
    my $rs = $self->_rs( $schema_name, $params, \%rs_opt );
    return {
        items => [ map $self->_normalize( $schema_name, $_ ), $rs->all ],
        total => $self->_rs( $schema_name, $params )->count,
    };
}

The schema is prepared during post processing, which currently is called after setting up the Yancy Mojolicious plugin:

We have coded this in a custom plugin, thus you see $self. Our DBIC schema is available via $self->app->database.

sub postprocess_schema {
    my ($self) = @_;

    for my $name (keys %{$self->app->yancy->schema}) {
        my $schema = $self->app->yancy->schema( $name );
        my $real_schema = $schema->{ 'x-view' }
            ? $self->app->yancy->schema( $schema->{ 'x-view' }->{schema} )
            : undef;

        if (my $dbic = $schema->{ 'x-dbic' }) {

            # Clone properties if 'x-view' without properties
            $schema->{properties} = dclone($real_schema->{properties})
                if ($real_schema && !defined $schema->{properties});

            die (sprintf "'x-dbic/join' setting is missing for schema '%s'.", $name)
                unless defined $dbic->{ 'join' };
            $dbic->{ 'x-join' } = $self->_rewrite_join_structure( $dbic->{ 'join' } );

            for my $inject_name ( keys %{$dbic->{ 'x-inject-properties' } || {}} ) {
                my $inject_schema = $self->app->yancy->schema( $inject_name );
                die (sprintf "Cannot inject properties from unknown schema '%s'.", $inject_name)
                    unless $inject_schema;

                my $injectable_properties = keys %{$inject_schema->{properties}};
                my $inject_properties = $dbic->{ 'x-inject-properties' }->{ $inject_name };
                for my $inject_property_name ( @{$inject_properties || []} ) {
                    die (sprintf "Cannot inject unknown property '%s' from schema '%s'.", $inject_property_name, $inject_name)
                        unless (defined $inject_schema->{properties}->{ $inject_property_name });
                }
                # inject all properties by default
                $inject_properties ||= $injectable_properties;

                # inject with extended name
                my $table_name = $self->app->database->source($inject_name)->name;
                map {
                    $schema->{properties}->{ $table_name . '.' . $_ } =
                      $inject_schema->{properties}->{ $_ };
                } @$inject_properties;
            }

            # Update schema
            $self->app->yancy->schema ( $name, $schema );
        }
    }
}

sub _rewrite_join_structure {
    my ($self, $struct) = @_;

    if (ref($struct) eq 'HASH') {
        die "Unexpected hash element count while rewriting 'x-dbic/join' structure"
            if scalar keys %$struct > 1;
        return {
            _rewrite_join_structure( (%$struct)[0] ) => _rewrite_join_structure( (%$struct)[1] )
        };
    } elsif (ref($struct) eq 'ARRAY') {
        return [
            map { _rewrite_join_structure( $_ ) }
            @$struct
        ];
    } else {
        return $self->app->database->source( $struct )->name;
    }
}

We use this only on x-view schemas, so we have no problem rewriting schemas that might be injected themself.

The implementation of get will follow most likely.

Currently we are not looking forward to implement setter methods as this way more complex. If someone wants to implement these setters a source of inspiration could be HTML::FormFu::Model::DBIC which implemented all this complex form handling stuff with regard to DBIC data.

preaction / Yancy

concept to realize complex joins on DBIC backend #123