view release on metacpan or  search on metacpan

lib/AtteanX/Store/DBI.pm  view on Meta::CPAN

				rename_mapping => \%rename_mapping,
				bindings => \@bind,
				variables => \%source_table_for_var,
			);
		}

		return;
	}

=item C<< cost_for_plan( $plan ) >>

Returns the estimated cost for a DBI-specific query plan, undef otherwise.

=cut

	sub cost_for_plan {
		my $self	= shift;
		my $plan	= shift;
		if ($plan->isa('AtteanX::Store::DBI::Plan')) {
			return 1; # TODO: actually estimate cost here
		}
		return;
	}

}

package AtteanX::Store::DBI::Plan 0.012 {
	use Moo;
	use Type::Tiny::Role;
	use Types::Standard qw(HashRef ArrayRef InstanceOf Str);
	use namespace::clean;
	
	has store			=> (is => 'ro', isa => InstanceOf['AtteanX::Store::DBI'], required => 1);
	has rename_mapping	=> (is => 'ro', isa => HashRef[Str], default => sub { +{} });
	has variables		=> (is => 'ro', isa => HashRef, required => 1);
	has bindings		=> (is => 'ro', isa => ArrayRef, required => 1);
	has select			=> (is => 'ro', isa => ArrayRef, required => 1);
	has where			=> (is => 'ro', isa => ArrayRef, required => 1);
	has tables			=> (is => 'ro', isa => ArrayRef[ArrayRef[Str]], required => 1);
	
	with 'Attean::API::BindingSubstitutionPlan', 'Attean::API::NullaryQueryTree';
	
	sub plan_as_string {
		my $self	= shift;
		my ($sql, @bind)	= $self->sql();
		return sprintf('DBI BGP { %s ← (%s) }', $sql, join(', ', @bind));
	}
	
	sub sql {
		my $self	= shift;
		my $bind	= shift;

		my $store	= $self->store;
		my $dbh		= $store->dbh;
		my @bind	= @{ $self->bindings };
		my @where	= @{ $self->where };
		if ($bind) {
			foreach my $var ($bind->variables) {
				my $id	= $store->_get_term_id($bind->value($var));
				return unless defined($id);
				if (my $cdata = $self->variables->{ $var }) {
					my ($table, $col)	= @$cdata;
					push(@where, sprintf("%s.%s = ?", $table, $col));
					push(@bind, $id);
				}
			}
		}
		
		my @select	= map { sprintf("%s.%s AS %s", map { $dbh->quote_identifier( $_ ) } @$_) } @{ $self->select };
		unless (scalar(@select)) {
			push(@select, '1');
		}
		
		
		my @sql;
		push(@sql, 'SELECT');
		push(@sql, join(', ', @select));

		push(@sql, 'FROM');
		push(@sql, join(', ', map { join(' ', @$_) } @{ $self->tables }));

		if (scalar(@where)) {
			push(@sql, 'WHERE');
			push(@sql, join(' AND ', map { "($_)" } @where));
		}
		
		my $sql	= join(" ", @sql);
		return ($sql, @bind);
	}
	
	sub substitute_impl {
		my $self	= shift;
		my $model	= shift;
		my ($sql, @bind)	= $self->sql(@_);
		my $store	= $self->store;
		my $dbh		= $store->dbh;

# 		warn "TODO: generatee SQL for BGP: $sql\n";
# 		warn "======================================================================\n";
# 		warn "$sql\n";
# 		warn "======================================================================\n";

		my $vars	= $self->in_scope_variables;
		my $sth		= $dbh->prepare($sql);
		return sub {
# 			warn "Generating impl by executing SQL";
			my $rv	= $sth->execute(@bind);
			unless ($rv) {
				warn '*** SQL error: ' . $sth->errstr;
				die;
			}
			my $sub	= sub {
# 				warn '=== Iterator invoked';
# 				use Data::Dumper;
# 				warn Dumper($sql, \@bind);
				if (my $row = $sth->fetchrow_hashref) {
# 					warn '@@@ Iterator got row';
# 					warn Dumper($row);
					
					my %bindings;
					foreach my $k (@$vars) {
						my $key			= $self->rename_mapping->{$k} // $k;