1package Tangram::Expr::Select; 2 3use strict; 4use Tangram::Expr::Filter; 5use Carp; 6 7use vars qw(@ISA); 8 @ISA = qw( Tangram::Expr ); 9 10sub new 11{ 12 my ($type, %args) = @_; 13 14 my $cols = join ', ', map 15 { 16 confess "column specification must be a Tangram::Expr" unless $_->isa('Tangram::Expr'); 17 $_->expr; 18 } @{$args{cols}}; 19 20 my $filter = $args{filter} || $args{where} || Tangram::Expr::Filter->new; 21 22 my $objects = Set::Object->new(); 23 24 if (exists $args{from}) 25 { 26 # XXX - not tested by test suite 27 $objects->insert( map { $_->object } @{ $args{from} } ); 28 } 29 else 30 { 31 $objects->insert( $filter->objects(), map { $_->objects } @{ $args{cols} } ); 32 $objects->remove( @{ $args{exclude} } ) if exists $args{exclude}; 33 } 34 35 my $from = join ', ', map { $_->from } $objects->members; 36 37 my $where = join ' AND ', 38 $filter->expr ? "(".$filter->expr.")" : (), 39 map { $_->where } $objects->members; 40 41 my $sql = "SELECT"; 42 $sql .= ' DISTINCT' if $args{distinct}; 43 $sql .= " $cols"; 44 if (exists $args{order}) { 45 # XXX - not tested by test suite 46 $sql .= join("", map {", $_"} 47 grep { $sql !~ m/ \Q$_\E(?:,|$)/ } 48 map { $_->expr } @{$args{order}}); 49 } 50 $sql .= "\nFROM $from" if $from; 51 $sql .= "\nWHERE $where" if $where; 52 53 if (exists $args{order}) 54 { 55 $sql .= "\nORDER BY " . join ', ', map { $_->expr } @{$args{order}}; 56 } 57 58 my $self = $type->SUPER::new(Tangram::Type::Integer->instance, "($sql)"); 59 60 $self->{cols} = $args{cols}; 61 62 return $self; 63} 64 65# XXX - not tested by test suite 66sub from 67{ 68 my ($self) = @_; 69 my $from = $self->{from}; 70 return $from ? $from->members : $self->SUPER::from; 71} 72 73# XXX - not tested by test suite 74sub where 75{ 76} 77 78sub execute 79{ 80 my ($self, $storage, $conn) = @_; 81 return Tangram::Cursor::Data->open($storage, $self, $conn); 82} 83 84 851; 86