<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package DBIx::Class::CDBICompat::SQLTransformer;

use strict;
use warnings;

=head1 NAME

DBIx::Class::CDBICompat::SQLTransformer - Transform SQL

=head1 DESCRIPTION

This is a copy of L&lt;Class::DBI::SQL::Transformer&gt; from Class::DBI 3.0.17.
It is here so we can be compatible with L&lt;Class::DBI&gt; without having it
installed.

=cut

sub new {
    my ($me, $caller, $sql, @args) = @_;
    bless {
        _caller      =&gt; $caller,
        _sql         =&gt; $sql,
        _args        =&gt; [@args],
        _transformed =&gt; 0,
    } =&gt; $me;
}

sub sql {
    my $self = shift;
    $self-&gt;_do_transformation if !$self-&gt;{_transformed};
    return $self-&gt;{_transformed_sql};
}

sub args {
    my $self = shift;
    $self-&gt;_do_transformation if !$self-&gt;{_transformed};
    return @{ $self-&gt;{_transformed_args} };
}

sub _expand_table {
    my $self = shift;
    my ($class, $alias) = split /=/, shift, 2;
    my $caller = $self-&gt;{_caller};
    my $table = $class ? $class-&gt;table : $caller-&gt;table;
    $self-&gt;{cmap}{ $alias || $table } = $class || ref $caller || $caller;
    ($alias ||= "") &amp;&amp;= " $alias";
    return $table . $alias;
}

sub _expand_join {
    my $self  = shift;
    my $joins = shift;
    my @table = split /\s+/, $joins;

    my $caller = $self-&gt;{_caller};
    my %tojoin = map { $table[$_] =&gt; $table[ $_ + 1 ] } 0 .. $#table - 1;
    my @sql;
    while (my ($t1, $t2) = each %tojoin) {
        my ($c1, $c2) = map $self-&gt;{cmap}{$_}
            || $caller-&gt;_croak("Don't understand table '$_' in JOIN"), ($t1, $t2);

        my $join_col = sub {
            my ($c1, $c2) = @_;
            my $meta = $c1-&gt;meta_info('has_a');
            my ($col) = grep $meta-&gt;{$_}-&gt;foreign_class eq $c2, keys %$meta;
            $col;
        };

        my $col = $join_col-&gt;($c1 =&gt; $c2) || do {
            ($c1, $c2) = ($c2, $c1);
            ($t1, $t2) = ($t2, $t1);
            $join_col-&gt;($c1 =&gt; $c2);
        };

        $caller-&gt;_croak("Don't know how to join $c1 to $c2") unless $col;
        push @sql, sprintf " %s.%s = %s.%s ", $t1, $col, $t2, $c2-&gt;primary_column;
    }
    return join " AND ", @sql;
}

sub _do_transformation {
    my $me     = shift;
    my $sql    = $me-&gt;{_sql};
    my @args   = @{ $me-&gt;{_args} };
    my $caller = $me-&gt;{_caller};

    $sql =~ s/__TABLE\(?(.*?)\)?__/$me-&gt;_expand_table($1)/eg;
    $sql =~ s/__JOIN\((.*?)\)__/$me-&gt;_expand_join($1)/eg;
    $sql =~ s/__ESSENTIAL__/join ", ", $caller-&gt;_essential/eg;
    $sql =~
        s/__ESSENTIAL\((.*?)\)__/join ", ", map "$1.$_", $caller-&gt;_essential/eg;
    if ($sql =~ /__IDENTIFIER__/) {
        my $key_sql = join " AND ", map "$_=?", $caller-&gt;primary_columns;
        $sql =~ s/__IDENTIFIER__/$key_sql/g;
    }

    $me-&gt;{_transformed_sql}  = $sql;
    $me-&gt;{_transformed_args} = [@args];
    $me-&gt;{_transformed}      = 1;
    return 1;
}

=head1 FURTHER QUESTIONS?

Check the list of L&lt;additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT&gt;.

=head1 COPYRIGHT AND LICENSE

This module is free software L&lt;copyright|DBIx::Class/COPYRIGHT AND LICENSE&gt;
by the L&lt;DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS&gt;. You can
redistribute it and/or modify it under the same terms as the
L&lt;DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE&gt;.

=cut

1;
</pre></body></html>