From: Ash Berlin <ash_github@firemirror.com>
Date: Wed, 7 Feb 2007 15:10:07 +0000 (+0000)
Subject: abstract from code imported from DBIC::SQL::Abstract plus tests
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=83cab70b1083adb4d64f06d786792c2dbc53571c;p=scpubgit%2FQ-Branch.git

abstract from code imported from DBIC::SQL::Abstract plus tests
r2298@metis (orig r20):  matthewt | 2007-02-07 13:46:06 +0000
 r33610@cain (orig r9):  matthewt | 2006-11-13 09:14:03 +0000
---

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index a0c6b4a..cb37b1a 100644
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -184,21 +184,100 @@ sub puke (@) {
 # Utility functions
 sub _table  {
     my $self = shift;
-    my $tab  = shift;
-    if (ref $tab eq 'ARRAY') {
-        return join ', ', map { $self->_quote($_) } @$tab;
+    my $from = shift;
+    if (ref $from eq 'ARRAY') {
+        return $self->_recurse_from(@$from);
+    } elsif (ref $from eq 'HASH') {
+        return $self->_make_as($from);
     } else {
-        return $self->_quote($tab);
+        return $self->_quote($from);
     }
 }
 
+sub _recurse_from {
+    my ($self, $from, @join) = @_;
+    my @sqlf;
+    push(@sqlf, $self->_make_as($from));
+    foreach my $j (@join) {
+        push @sqlf, ', ' . $self->_quote($j) and next unless ref $j;
+        push @sqlf, ', ' . $$j and next if ref $j eq 'SCALAR';
+        my ($to, $on) = @$j;
+
+        # check whether a join type exists
+        my $join_clause = '';
+        my $to_jt = ref($to) eq 'ARRAY' ? $to->[0] : $to;
+        if (ref($to_jt) eq 'HASH' and exists($to_jt->{-join_type})) {
+            $join_clause = $self->_sqlcase(' '.($to_jt->{-join_type}).' JOIN ');
+        } else {
+            $join_clause = $self->_sqlcase(' JOIN ');
+        }
+        push(@sqlf, $join_clause);
+
+        if (ref $to eq 'ARRAY') {
+            push(@sqlf, '(', $self->_recurse_from(@$to), ')');
+        } else {
+            push(@sqlf, $self->_make_as($to));
+        }
+        push(@sqlf, $self->_sqlcase(' ON '), $self->_join_condition($on));
+    }
+    return join('', @sqlf);
+}
+
+sub _make_as {
+    my ($self, $from) = @_;
+    return $self->_quote($from) unless ref $from;
+    return $$from if ref $from eq 'SCALAR';
+    return join(' ', map { (ref $_ eq 'SCALAR' ? $$_ : $self->_quote($_)) }
+                         reverse each %{$self->_skip_options($from)});
+}
+
+sub _skip_options {
+    my ($self, $hash) = @_;
+    my $clean_hash = {};
+    $clean_hash->{$_} = $hash->{$_}
+        for grep {!/^-/} keys %$hash;
+    return $clean_hash;
+}
+
+sub _join_condition {
+    my ($self, $cond) = @_;
+    if (ref $cond eq 'HASH') {
+        my %j;
+        for (keys %$cond) {
+            my $x = '= '.$self->_quote($cond->{$_}); $j{$_} = \$x;
+        };
+        return $self->_recurse_where(\%j);
+    } elsif (ref $cond eq 'ARRAY') {
+        return join(' OR ', map { $self->_join_condition($_) } @$cond);
+    } else {
+        die "Can't handle this yet!";
+    }
+}
+
+
 sub _quote {
     my $self  = shift;
     my $label = shift;
 
+    return '' unless defined $label;
+
     return $label
       if $label eq '*';
 
+    return $label unless $self->{quote_char};
+
+    if (ref $self->{quote_char} eq "ARRAY") {
+
+        return $self->{quote_char}->[0] . $label . $self->{quote_char}->[1]
+            if !defined $self->{name_sep};
+
+        my $sep = $self->{name_sep};
+        return join($self->{name_sep},
+            map { $self->{quote_char}->[0] . $_ . $self->{quote_char}->[1] }
+              split( /\Q$sep\E/, $label ) );
+    }
+
+
     return $self->{quote_char} . $label . $self->{quote_char}
       if !defined $self->{name_sep};
 
diff --git a/t/04from.t b/t/04from.t
new file mode 100644
index 0000000..293589a
--- /dev/null
+++ b/t/04from.t
@@ -0,0 +1,74 @@
+#!/usr/bin/perl -I. -w
+
+use strict;
+use vars qw($TESTING);
+$TESTING = 1;
+use Test;
+
+# use a BEGIN block so we print our plan before SQL::Abstract is loaded
+BEGIN { plan tests => 4 }
+
+use SQL::Abstract;
+
+sub is {
+    my ($got, $expect, $msg) = @_;
+    ok($got eq $expect) or
+        warn "got [${got}]\ninstead of [${expect}]\nfor test ${msg}\n\n";
+}
+
+my $sa = new SQL::Abstract;
+
+my @j = (
+    { child => 'person' },
+    [ { father => 'person' }, { 'father.person_id' => 'child.father_id' }, ],
+    [ { mother => 'person' }, { 'mother.person_id' => 'child.mother_id' } ],
+);
+my $match = 'person child JOIN person father ON ( father.person_id = '
+          . 'child.father_id ) JOIN person mother ON ( mother.person_id '
+          . '= child.mother_id )'
+          ;
+is( $sa->_recurse_from(@j), $match, 'join 1 ok' );
+
+my @j2 = (
+    { mother => 'person' },
+    [   [   { child => 'person' },
+            [   { father             => 'person' },
+                { 'father.person_id' => 'child.father_id' }
+            ]
+        ],
+        { 'mother.person_id' => 'child.mother_id' }
+    ],
+);
+$match = 'person mother JOIN (person child JOIN person father ON ('
+       . ' father.person_id = child.father_id )) ON ( mother.person_id = '
+       . 'child.mother_id )'
+       ;
+is( $sa->_recurse_from(@j2), $match, 'join 2 ok' );
+
+my @j3 = (
+    { child => 'person' },
+    [ { father => 'person', -join_type => 'inner' }, { 'father.person_id' => 'child.father_id' }, ],
+    [ { mother => 'person', -join_type => 'inner'  }, { 'mother.person_id' => 'child.mother_id' } ],
+);
+$match = 'person child INNER JOIN person father ON ( father.person_id = '
+          . 'child.father_id ) INNER JOIN person mother ON ( mother.person_id '
+          . '= child.mother_id )'
+          ;
+
+is( $sa->_recurse_from(@j3), $match, 'join 3 (inner join) ok');
+
+my @j4 = (
+    { mother => 'person' },
+    [   [   { child => 'person', -join_type => 'left' },
+            [   { father             => 'person', -join_type => 'right' },
+                { 'father.person_id' => 'child.father_id' }
+            ]
+        ],
+        { 'mother.person_id' => 'child.mother_id' }
+    ],
+);
+$match = 'person mother LEFT JOIN (person child RIGHT JOIN person father ON ('
+       . ' father.person_id = child.father_id )) ON ( mother.person_id = '
+       . 'child.mother_id )'
+       ;
+is( $sa->_recurse_from(@j4), $match, 'join 4 (nested joins + join types) ok');