# Vend::Table::LDAP - Interchange LDAP pseudo-table access
#
# Copyright (C) 2002-2007 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
#
# This program was originally based on Vend 0.2 and 0.3
# Copyright 1995 by Andrew M. Wilcox <amw@wilcoxsolutions.com>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public
# License along with this program; if not, write to the Free
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA  02110-1301  USA.

package Vend::Table::LDAP;
@ISA = qw/Vend::Table::Common/;
$VERSION = '2.17';
use strict;

use vars qw(
				$CONFIG
				$FILENAME
				$COLUMN_NAMES
				$COLUMN_INDEX
				$KEY_INDEX
				$TIE_HASH
				$EACH
			);
(
	$CONFIG,
	$FILENAME,
	$COLUMN_NAMES,
	$COLUMN_INDEX,
	$KEY_INDEX,
	$TIE_HASH,
	$EACH,
	) = (0 .. 6);

sub import_db {
	my($s) = @_;
	my @caller = caller();
#::logDebug("importing, caller=@caller TIE_HASH index=$TIE_HASH TIE_HASH value=$s->[$TIE_HASH]");
	my $db = Vend::Data::import_database($s->[0], 1);
#::logDebug("failed to import " . ::uneval($s)) if ! $db;
	return undef if ! $db;
	$Vend::Database{$s->[0]{name}} = $db;
	Vend::Data::update_productbase($s->[0]{name});
	return $db;
}

sub config {
	my ($self, $key, $value) = @_;
	return $self->[$CONFIG]{$key} unless defined $value;
	$self->[$CONFIG]{$key} = $value;
}

sub close_table {
	my ($s) = @_;
#::logDebug("closing LDAP table");
	return 1 if ! defined $s->[$TIE_HASH];
#::logDebug("closing LDAP table $s->[$FILENAME]");
	my $do = $s->[$TIE_HASH]->unbind;
	undef $s->[$TIE_HASH];
	return $do;
}

sub open_table {
	my ($class, $config, $tablename) = @_;
#::logDebug("LDAP open_table $tablename" . ::uneval($config));
	$tablename = $config->{name} || $tablename;
	my $ldap;
	my $column_index;
	my $columns;

	# LDAP doesn't do these
	undef $config->{Transactions};
	$config->{_Auto_number} = 1 if $config->{AUTO_NUMBER};
  DOCONNECT: {
	my $base = $config->{BASE_DN};
	my $host = $config->{LDAP_HOST};
	my $port = 389;
	my $alt_index = 0;
	($host, $port) = split /:/, $host if ($host =~ /:/);
	unless( $ldap = Net::LDAP->new($host, port => $port) ) {
		if($config->{ALTERNATE_LDAP_HOST}[$alt_index]) {
			for(qw/LDAP_HOST BASE_DN BIND_DN BIND_PW/) {
				$config->{$_} = $config->{"ALTERNATE_$_"}[$alt_index] || $config->{$_};
			}
			$alt_index++;
			redo DOCONNECT;
		}
		die ::errmsg("Unable to connect to LDAP server %s", "$host:$port");
	}
	$ldap->bind(
		dn => $config->{BIND_DN},
		password => $config->{BIND_PW},
	);
	my $m = $ldap->search(
		base => $base,
		filter => "(&(objectclass=mv_database)(db=$tablename))",
	);
#::logDebug('after search m=' . ::uneval($m));
	my $c = $m->count;
	my $co = $m->code;
#::logDebug("count=$c code=$co");

	my $e = $m->entry(0);
#::logDebug('after entry e=' . ::uneval($e));
	$columns = $e->get('columns');
	my $ki = $e->get('key');
	unshift @$columns, pop @$ki;
	@$columns = map { lc $_ } @$columns;
#::logDebug('columns=' . ::uneval($columns));
	$column_index = Vend::Table::Common::create_columns($columns, $config);
  }
	my $s = [
				$config,
				$config->{name},
				$columns,
				$column_index,
				$config->{KEY_INDEX},
				$ldap
			];
	return bless $s, $class;
}

sub create {
	my ($class, $config, $columns, $tablename) = @_;

	$config = {} unless defined $config;

	die ::errmsg("columns argument %s is not an array ref", $columns)
		unless CORE::ref($columns) eq 'ARRAY';

	my $base = $config->{BASE_DN};
	my $host = $config->{LDAP_HOST};
	my $port = 389;
	($host, $port) = split /:/, $host if ($host =~ /:/);
	my $column_index = Vend::Table::Common::create_columns($columns, $config);
	my $ldap = Net::LDAP->new($host, port => $port)
		or die ::errmsg("Unable to connect to LDAP server %s", "$host:$port");
#::logDebug("created object " . ::uneval($ldap));
	$ldap->bind(
		dn => $config->{BIND_DN},
		password => $config->{BIND_PW},
	);
#::logDebug("bound object");
	my (@tmpcols) = @$columns;
	shift @tmpcols;
	require Net::LDAP::Entry;
	my $e = Net::LDAP::Entry->new;
	$e->dn('db=' . $config->{name} . ', ' . $base);
	$e->add( 'objectclass' => 'mv_database',
			'db' => $config->{name},
			'key' => $config->{KEY},
			'columns' => \@tmpcols,
	);
	my $m = $ldap->add($e);
#::logDebug("added entry");
	my $s = [
				$config,
				$config->{name},
				$columns,
				$column_index,
				$config->{KEY_INDEX},
				$ldap,
			];
#::logDebug("Created database $config->{name}" . ::uneval($s));
#::logDebug("Created database $config->{name}");
	bless $s, $class;
}

sub new {
	my ($class, $obj) = @_;
	bless [$obj], $class;
}

sub field {
	my ($s, $key, $column) = @_;
	$s = $s->import_db() if ! defined $s->[$TIE_HASH];
#::logDebug("LDAP field $key $column");
	my $ki = $s->[$CONFIG]->{KEY};
	my $n = $s->[$FILENAME];
	my $b = $s->[$CONFIG]->{BASE_DN};
	my $m = $s->[$TIE_HASH]->search(
		base => "db=$n, $b",
		filter => "(&(objectclass=mv_data)($ki=$key))",
	);
    die $s->log_error(
					"There is no row with index '%s' in database %s",
					$key,
					$s->[$FILENAME],
			) unless ($m->count > 0);
	my $e = $m->entry(0);
	my $d = $e->get($column);
	return (pop @$d);
}

sub row {
	my ($s, $key) = @_;
	$s = $s->import_db() if ! defined $s->[$TIE_HASH];
	my $rh = row_hash($key);
	my @a = ();
	@a = @$rh->{@{$s->[$COLUMN_NAMES]}};
	return @a;
}

sub row_hash {
	my ($s, $key) = @_;
#::logDebug("LDAP row_hash $key");
	$s = $s->import_db() if ! defined $s->[$TIE_HASH];
	my $ki = $s->[$CONFIG]->{KEY};
	my $n = $s->[$FILENAME];
	my $b = $s->[$CONFIG]->{BASE_DN};
	my $m = $s->[$TIE_HASH]->search(
		base => "db=$n, $b",
		filter => "(&(objectclass=mv_data)($ki=$key))",
	);
    die $s->log_error(
					"There is no row with index '%s' in database %s",
					$key,
					$s->[$FILENAME],
			) unless ($m->count > 0);
	my $e = $m->entry(0);
	my %row;
	my $c;
	foreach $c (@{$s->[$COLUMN_NAMES]})
	{
		my $d = $e->get($c);
		$row{$c} = pop @$d;
	}
	return \%row;
}

*row_array = \&row;

sub columns {
	my ($s) = @_;
	$s = $s->import_db() if ! defined $s->[$TIE_HASH];
	return @{$s->[$COLUMN_NAMES]};
}


sub field_settor {
	my ($s, $column) = @_;
	$s = $s->import_db() if ! defined $s->[$TIE_HASH];
	return sub {
		my ($key, $value) = @_;
		my $n = $s->[$FILENAME];
		my $b = $s->[$CONFIG]->{BASE_DN};
		my $ki = $s->[$CONFIG]->{KEY};
		my $code;
		if ($s->record_exists($key)) {
			my $m = $s->[$TIE_HASH]->modify(
				dn => "$ki=$key, db=$n, $b",
				modify => [ $column => $value ],
			);
			$code = $m->code;
		}
		else {
			my $m = $s->[$TIE_HASH]->add(
				dn => "$ki=$key, db=$n, $b",
				attr => [ objectclass => 'mv_data',
					  db => $n,
					  $ki => $key,
					  $column => $value ],
			);
			$code = $m->code;
		}
		if($code) {
			$s->log_error(
				"Failed to set row %s=%s: %s",
				$ki, $key, $s->[$FILENAME], $code,
			);
		return undef;
		}
	};
}

sub set_slice {
	my ($s, $key, $fary, $vary) = @_;
	$s = $s->import_db() if ! defined $s->[$TIE_HASH];
	if($s->[$CONFIG]{Read_only}) {
		$s->log_error(
			"Attempt to set %s in read-only table %s",
			$key,
			$s->[$CONFIG]{name},
		);
		return undef;
	}

	my $opt;
	if (ref ($key) eq 'ARRAY') {
		$opt = shift @$key;
		$key = shift @$key;
	}
	$opt = {}
		unless ref ($opt) eq 'HASH';

	$opt->{dml} = 'upsert'
		unless defined $opt->{dml};

	if(ref $fary ne 'ARRAY') {
		my $href = $fary;
		if(ref $href ne 'HASH') {
			$href = { splice (@_, 2) };
		}
		$vary = [ values %$href ];
		$fary = [ keys   %$href ];
	}

	if ($s->record_exists($key)) {
		if ($opt->{dml} eq 'insert') {
			$s->log_error(
				"Duplicate key on set_slice insert for key '$key' on table %s",
				$s->[$CONFIG]{name},
			);
			return undef;
		}
	}
	elsif ($opt->{dml} eq 'update') {
		$s->log_error(
			"No record to update set_slice for key '$key' on table %s",
			$s->[$CONFIG]{name},
		);
		return undef;
	}

	for( my $i = 0; $i < @$fary; $i++) {
		$s->set_field($key, $fary->[$i], $vary->[$i]);
	}

	return 1;
}

sub set_field {
	my ($s, $key, $column, $value) = @_;
	$s = $s->import_db() if ! defined $s->[$TIE_HASH];
	if($s->[$CONFIG]{Read_only}) {
		$s->log_error(
			"Attempt to write %s in read-only table",
			"$s->[$CONFIG]{name}::${column}::$key",
		);
		return undef;
	}
	my %row;
	my $code;
	my $ki = $s->[$CONFIG]->{KEY};
	my $n = $s->[$CONFIG]{name};
	my $b = $s->[$CONFIG]->{BASE_DN};
	my $m;
#::logDebug("DN is db=$n, $b" );
	if($s->record_exists($key)) {
		$m = $s->[$TIE_HASH]->modify(
			"$ki=$key, db=$n, $b",
			replace => {$column => $value},
		);
		$code = $m->code;
	}
	else {
		$m = $s->[$TIE_HASH]->add(
			dn => "$ki=$key, db=$n, $b",
			attr => [
						objectclass => 'mv_data',
						db => $n,
						$ki => $key,
						$column => $value,
					],
		);
		$code = $m->code;
	}
	if($code) {
		$s->log_error(
					"Failed to set row %s=%s: %s errnum=%s errstr=%s",
					$ki, $key, $value, $code, $m->error(),
				);
		return undef;
	}
	$value;
}

sub set_row {
	my ($s, @fields) = @_;
#	my $x = 0;
#	my $subname;
#	while ((undef, undef, undef, $subname) = caller($x++))
#	{
#::logDebug("x=$x subname=$subname");
#	}
	$s = $s->import_db() if ! defined $s->[$TIE_HASH];
	my $ki = $s->[$CONFIG]->{KEY};
	my $n = $s->[$FILENAME];
	my $b = $s->[$CONFIG]->{BASE_DN};
	my $key = $fields[$ki];
	my @fh = ( objectclass => 'mv_data',
			   db => $n, );
	my $f;
	my $x = 0;
	foreach $f (@{$s->[$COLUMN_NAMES]})
	{
		push @fh, $f, $fields[$x++];
	}
	my $code;
	my $op;
	if (	!$s->[$CONFIG]{Clean_start}
			and $s->record_exists($key)
	) {
		$op = 'modify';
		my $m = $s->[$TIE_HASH]->modify(
			dn => "$ki=$key, db=$n, $b",
			replace => \@fh,
		);
		$code = $m->code;
	}
	else {
		$op = 'add';
		my $m = $s->[$TIE_HASH]->add(
			dn => "$ki=$key, db=$n, $b",
			attr => \@fh,
		);
		$code = $m->code;
	}
	if($code) {
		$s->log_error(
			"Failed to set row %s=%s in %s, op=%s: %s",
			$ki, $key, $s->[$FILENAME], $op, $code,
		);
		return undef;
	}
	return $ki;
}

sub inc_field {
	my ($s, $key, $column, $adder) = @_;
	$s = $s->import_db() if ! defined $s->[$TIE_HASH];
	my $f = field($key, $column);
	$f += $adder;
	set_field($key, $column, $f);
}

sub each_record {
	my ($s) = @_;
	$s = $s->import_db() if ! defined $s->[$TIE_HASH];
	my $key;
	my @r;
	my $ki = $s->[$CONFIG]->{KEY};
	unless (defined $s->[$EACH]) {
		my $n = $s->[$CONFIG]->{name};
		my $b = $s->[$CONFIG]->{BASE_DN};
#::logDebug("DN is db=$n, $b" );
		my $m = $s->[$TIE_HASH]->search(
			base => "db=$n, $b",
			filter => "(objectclass=mv_data)",
		);
		my $ref = $m->as_struct;
#::logDebug("count is " . $m->count() );
		my $data;
		my $repos = {};
		my $i = 0;
		my @repos;
		my @names = @{$s->[$COLUMN_NAMES]};
		for(;;) {
			last unless defined ($data = $m->entry($i++));
			my $k = $data->get($ki)->[0];
			my (@record) = $k;
			for(@names) {
				push @record, $data->get($_)->[0];
			}
			push @repos, \@record;
		}
		$s->[$EACH] = \@repos;
#::logDebug("each is " . ::uneval($s->[$EACH]) );
	}
	my $val;
	unless (defined $s->[$EACH][0]) {
		undef $s->[$EACH];
		return ();
	}
	return @{ shift @{$s->[$EACH]} };
}

sub each_nokey {
	my (@ary) = each_record(@_);
	shift @ary;
	return \@ary;
}

sub record_exists {
	my ($s, $key) = @_;
	$s = $s->import_db() if ! defined $s->[$TIE_HASH];
	my $ki = $s->[$CONFIG]->{KEY};
	my $n = $s->[$CONFIG]{name};
	my $b = $s->[$CONFIG]->{BASE_DN};
	my $m = $s->[$TIE_HASH]->search(
		base => "db=$n, $b",
		filter => "(&(objectclass=mv_data)($ki=$key))",
	);
	if ($m->count > 0)
	{
#::logDebug("$ki=$key, db=$n, $b exists");
	}
	return $m->count;
}

*test_record = \&record_exists;

sub delete_record {
	my ($s, $key) = @_;
        $s = $s->import_db() if ! defined $s->[$TIE_HASH];
        my $ki = $s->[$CONFIG]->{KEY};
        my $n = $s->[$CONFIG]{name};
        my $b = $s->[$CONFIG]->{BASE_DN};
        my $m = $s->[$TIE_HASH]->delete("$ki=$key,db=$n,$b");
}

sub clear_table {
	my ($s) = @_;
#::logDebug("clear table not impl.");
}

sub touch {
	1
}

sub ref {
	my $s = shift;
	$s = $s->import_db() if ! defined $s->[$TIE_HASH];
	return $s;
}

sub query {
	my($s, $opt, $text, @arg) = @_;

	if(! CORE::ref($opt) ) {
		unshift @arg, $text;
		$text = $opt;
		$opt = {};
	}

	$s = $s->import_db() if ! defined $s->[$TIE_HASH];
	$opt->{query} = $opt->{sql} || $text if ! $opt->{query};

#::logDebug("receieved query. object=" . ::uneval($opt));

	if(defined $opt->{values}) {
		@arg = $opt->{values} =~ /['"]/
				? ( Text::ParseWords::shellwords($opt->{values})  )
				: (grep /\S/, split /\s+/, $opt->{values});
		@arg = @{$::Values}{@arg};
	}

	if($opt->{type}) {
		$opt->{$opt->{type}} = 1 unless defined $opt->{$opt->{type}};
	}

	my $query;
	$query = ! scalar @arg
			? $opt->{query}
			: sprintf_substitute ($s, $opt->{query}, \@arg);

	my $codename = defined $s->[$CONFIG]{KEY} ? $s->[$CONFIG]{KEY} : 'code';
	my $ref;
	my $relocate;
	my $return;
	my $spec;
	my $stmt;
	my $update;
	my %nh;
	my @na;
	my @out;

	if($opt->{STATEMENT}) {
		 $stmt = $opt->{STATEMENT};
		 $spec = $opt->{SPEC};
#::logDebug('rerouted. Command is ' . $stmt->command());
	}
	else {
		eval {
			($spec, $stmt) = Vend::Scan::sql_statement($query, $ref);
		};
		if($@) {
			my $msg = ::errmsg("SQL query failed: %s\nquery was: %s", $@, $query);
			$s->log_error($msg);
			Carp::croak($msg) if $Vend::Try;
			return ($opt->{failure} || undef);
		}
		my @additions = grep length($_) == 2, keys %$opt;
		if(@additions) {
			@{$spec}{@additions} = @{$opt}{@additions};
		}
	}
	my @tabs = @{$spec->{rt} || $spec->{fi}};

	if (! defined $s || $tabs[0] ne $s->[$CONFIG]{name}) {
		my $newdb = Vend::Data::database_exists_ref($tabs[0])
			or do {
				$s->log_error("Table %s not found in databases", $tabs[0]);
			return $opt->{failure} || undef;
			};
#::logDebug("rerouting to $tabs[0]");
		$opt->{STATEMENT} = $stmt;
		$opt->{SPEC} = $spec;
		return $newdb->query($opt, $text);
	}

eval {

	if($stmt->command() ne 'SELECT') {
		if(defined $s and $s->[$CONFIG]{Read_only}) {
			$s->log_error(
					"Attempt to write read-only table %s",
					$s->[$CONFIG]{name},
			);
			return undef;
		}
		$update = $stmt->command();
	}
	my @vals = $stmt->row_values();
	
	@na = @{$spec->{rf}}     if $spec->{rf};

	$spec->{fn} = [$s->columns];
	if(! @na) {
		@na = ! $update || $update eq 'INSERT' ? '*' : $codename;
	}
	@na = @{$spec->{fn}}       if $na[0] eq '*';
	$spec->{rf} = [@na];

#::logDebug("tabs='@tabs' columns='@na' vals='@vals' update=$update"); 

	my $search;
	if ("\L$opt->{st}" eq 'db' ) {
        require Vend::DbSearch;
		$search = new Vend::DbSearch;
#::logDebug("created DbSearch object: " . ::uneval($search));
	}
	else {
        require Vend::TextSearch;
		$search = new Vend::TextSearch;
#::logDebug("created TextSearch object: " . ::uneval($search));
	}

	my %fh;
	my $i = 0;
	%nh = map { (lc $_, $i++) } @na;
	$i = 0;
	%fh = map { ($_, $i++) } @{$spec->{fn}};

#::logDebug("field hash: " . Vend::Util::uneval(\%fh)); 
	for ( qw/rf sf/ ) {
		next unless defined $spec->{$_};
		map { $_ = $fh{$_} } @{$spec->{$_}};
	}

	if($update) {
#::logDebug("Updating, update=$update");
		$opt->{row_count} = 1;
		die "Reached update query without object"
			if ! $s;
		my $sub = $update eq 'DELETE'
					? sub { delete_record($s, @_) }
					: $s->row_settor(@na);
#::logDebug("Update operation is $update, sub=$sub");
		die "Bad row settor for columns @na"
			if ! $sub;
		if($update eq 'INSERT') {
			&$sub(@vals);
			$ref = [$vals[0]];
		}
		else {
#::logDebug("Supposed to search..., spec=" . ::uneval($spec));
			$ref = $search->array($spec);
#::logDebug("Returning ref=" . ::uneval($ref));
			for(@{$ref}) {
				&$sub($_->[0], @vals);
			}
		}
	}
	elsif ($opt->{hashref}) {
		$ref = $Vend::Interpolate::Tmp->{$opt->{hashref}} = $search->hash($spec);
	}
	else {
#::logDebug(	" \$Vend::Interpolate::Tmp->{$opt->{arrayref}}");
		$ref = $Vend::Interpolate::Tmp->{$opt->{arrayref}} = $search->array($spec);
		$opt->{object} = $search;
		$opt->{prefix} = 'sql' unless defined $opt->{prefix};
	}
};
#::logDebug("search spec: " . Vend::Util::uneval($spec));
#::logDebug("name hash: " . Vend::Util::uneval(\%nh));
#::logDebug("ref returned: " . substr(Vend::Util::uneval($ref), 0, 100));
#:logDebug("opt is: " . Vend::Util::uneval($opt));
	if($@) {
		$s->log_error(
				"MVSQL query failed for %s: %s\nquery was: %s",
				$opt->{table},
				$@,
				$query,
			);
		$return = $opt->{failure} || undef;
	}

	if($opt->{search_label}) {
		$::Instance->{SearchObject}{$opt->{search_label}} = {
			mv_results => $ref,
			mv_field_names => \@na,
		};
	}

	return scalar @{$ref || []}
		if $opt->{row_count};
	return Vend::Interpolate::region($opt, $text)
		if $opt->{list};
	return Vend::Interpolate::html_table($opt, $ref, \@na)
		if $opt->{html};
	return Vend::Util::uneval($ref)
		if $opt->{textref};
	return wantarray ? ($ref, \%nh, \@na) : $ref;
}

# Unfortunate hack need for Safe searches
*column_index	= \&Vend::Table::Common::column_index;
*column_exists	= \&Vend::Table::Common::column_exists;
*errstr     	= \&Vend::Table::Common::errstr;
*log_error  	= \&Vend::Table::Common::log_error;
*name			= \&Vend::Table::Common::name;
*numeric		= \&Vend::Table::Common::numeric;
*isopen			= \&Vend::Table::Common::isopen;
*reset			= \&Vend::Table::Common::reset;
*suicide		= \&Vend::Table::Common::suicide;
*test_column	= \&Vend::Table::Common::test_column;

1;
