package Bod::CRM;

use DBI;
use Bod::Variables;

use strict;
use warnings;


=head1 Name

Bod::CRM

=head1 Synopsis

Bod::CRM provides simple methods to access the Lets Delight CRM.

	use Bod::CRM;
	
	my $crm = Bod::CRM->new();
	my $vars = {
		'firstname'	=> 'John',
		'lastname'	=> 'Smith',
		'pri_email'	=> 'john.smith@example.com',
	};
	$crm->add($vars);
	
	my $vars = {
		'firstname'	=> 'John',
	};
	my @contacts = $crm->find($vars);
	
	print $crm->error;

=head2 Error Handling

Except where otherwise documented, methods return zero to indicate an error.
The error message can be found by calling the B<error()> method.

=head2 Description

=cut

=head4 new(environment);

=over 1

Creates a new connection to the CRM.  If I<environment> is 'prod' or 'test', that environment is used.  If I<environment> is omitted, an attempt is made to find the environment from the C<$ENV{'HTTP_HOST'}> variable.

Returns a B<Bod::CRM> object or I<undef> if unsuccessful.
Unsuccessful means either the environment was wrong or the connection to the database failed for another reason.

=back

=cut

sub new {
	my ($class, $env) = @_;
	if (!$env and $ENV{'HTTP_HOST'} =~ /^(.*?)\./) {
		$env = $1;
	}
	$env = 'prod' if $env eq 'www';
	my $dbh = DBI->connect("dbi:mysql:$Bod::Variables::db_prefix$env:localhost:3306", "$Bod::Variables::db_username", "$Bod::Variables::db_password");
	if (!$dbh) {
		warn("Unable to connect to $env database - " . $DBI::errstr);
		return undef;
	}
	my @schema_fields;
	my $query = $dbh->prepare("SELECT COLUMN_NAME FROM information_schema.`COLUMNS` WHERE TABLE_SCHEMA = '$Bod::Variables::db_prefix$env' AND TABLE_NAME = '$Bod::Variables::C_Table'");
	$query->execute;
	while (my ($field) = $query->fetchrow_array) {
		push @schema_fields, $field;
	}
	my $self = bless {
		'env'	=> $env,
		'dbh'	=> $dbh,
		'error'	=> '',
		'field'	=> \@schema_fields
	}, $class;
	return $self;
}

=head4 error();

=over 1

Return a string detailing the last error.

=back

=cut

sub error {
	my ($self) = @_;
	return $self->{error};
}

=head4 find(fields, blanks);

=over 1

Finds a list of people in the CRM matching all the I<fields> passed as a hash reference.  Empty strings are not matched unless the optional I<blanks> parameter is true.
Returns an array of people IDs that match all keys as fields to values as contents.

=back

=cut

sub find {
	my ($self, $fields, $blanks) = @_;
	my $where;
	my @place;
	my $flag = 0;
	foreach my $field(keys(%$fields)) {
		next unless $fields->{$field} or $blanks;
		$where .= " AND " if $flag;
		$where .= "$field = ?";
		push @place, $fields->{$field};
		$flag = 1;
	}
	my @ids;
	my $query = $self->{'dbh'}->prepare("SELECT idContact FROM $Bod::Variables::C_Table WHERE $where");
	$query->execute(@place);
	while (my $id = $query->fetchrow_array) {
		push @ids, $id;
	}
	return @ids;
}

=head4 get(id);

=over 1

Get information about the person with given I<id>
Returns a hash reference containing keys with the values of the CRM field names.

=back

=cut

sub get {
	my ($self, $id) = @_;
	return $self->{'dbh'}->selectrow_hashref("SELECT * FROM $Bod::Variables::C_Table WHERE id$Bod::Variables::C_Table = ?", undef, $id);
}

=head4 add(fields);

=over 1

Add a person to the CRM or update existing person

Given the information in the passed hash reference I<fields> add or update a person.  If the B<email> or B<Twitter> fields match then update an existing person, otherwise add a new person.  If a new person is being added then the I<fields> source key must be set to the correct value to correspond with the B<PersonSource> table.
If the source key is not set or insufficient information is provided, returns zero.  Otherwise returns the contact ID of the person created or updated.

=back

=cut

sub add {
	my ($self, $fields) = @_;
	my $id;
	$id = $self->{'dbh'}->selectrow_array("SELECT id$Bod::Variables::C_Table FROM $Bod::Variables::C_Table WHERE pri_email= ? OR sec_email = ?", undef, $fields->{'email'}, $fields->{'email'}) if $fields->{'email'};
	$fields->{'twitter'} =~ s/^\@//;
	$id = $self->{'dbh'}->selectrow_array("SELECT id$Bod::Variables::C_Table FROM $Bod::Variables::C_Table WHERE twitter = ?", undef, $fields->{'twitter'}) if $fields->{'twitter'} and !$id;
	$fields->{"id$Bod::Variables::C_Table"} = $fields->{'id'} if $fields->{'id'} and !$fields->{"id$Bod::Variables::C_Table"};
	
	# These fields should not be set manually
	$fields->{$Bod::Variables::S_Table} = undef;
	$fields->{'created'} = undef;
	$fields->{'updated'} = undef;
	
	my @place;
	my $set;
	my $flag = 0;
	foreach my $field(@{$self->{'field'}}) {
		if ($fields->{$field}) {
			$set .= ', ' if $flag;
			$set .= "$field = ?";
			push @place, $fields->{$field};
			$flag = 1;
		}
	}
	if ($id) {
		my $query = $self->{'dbh'}->prepare("UPDATE $Bod::Variables::C_Table SET $set, updated = DATE(NOW()) WHERE id$Bod::Variables::C_Table = $id");
		$query->execute(@place);
	} else {
		if (!$fields->{'source'}) {
			$self->error = 'No source code provided for contact';
			return 0;
		}
		if (!$fields->{'firstname'} and !$fields->{'email'} and !$fields->{'twitter'}) {
			$self->error = 'Insufficient information provided for contact';
			return 0;
		}
		my $query = $self->{'dbh'}->prepare("INSERT INTO $Bod::Variables::C_Table SET $set, created = DATE(NOW()), $Bod::Variables::S_Table = ?");
		$query->execute(@place, $fields->{'source'});
		$id = $self->{'dbh'}->selectrow_array("SELECT LAST_INSERT_ID()");
	}
	return $id;
}

=head4 business(contact, business, subscribe)

=over 1

Adds the person to the business unit as definded in the B<BusinessUnit> table.  Has no effect if the person is already added to the business unit.  However, if the optional I<subscribe> is true, the person will be resubscribed to the list if they had previously unsubscribed.

Returns true if the person is in the busines unit, zero if it has failed and I<undef> if an error has occurred.

=back

=cut

sub business {
	my ($self, $contact, $business, $subscribe) = @_;
	unless ($contact > 0 and $business > 0) {
		$self->error = 'Invalid Contact or Business parameters';
		return undef;
	}
	my $update;
	$update = ' ON DUPLICATE KEY UPDATE subscribe = 1' if $subscribe;
	my $query = $self->{'dbh'}->prepare("INSERT IGNORE INTO $Bod::Variables::B_Table_has_$Bod::Variables::C_Table SET $Bod::Variables::C_Table_id$Bod::Variables::C_Table = ?, $Bod::Variables::B_Table_id$Bod::Variables::B_Table = ?, subscribe = 1$update");
	$query->execute($contact, $business);
	return $self->{'dbh'}->selectrow_array("SELECT COUNT(*) FROM $Bod::Variables::B_Table_has_$Bod::Variables::C_Table WHERE $Bod::Variables::C_Table_id$Bod::Variables::C_Table = ?, $Bod::Variables::B_Table_id$Bod::Variables::B_Table = ?", undef, $contact, $business);
}

=head4 marketing(contact, business, permission, grant)

=over 1

Set the marketing permissions for a person on the specified business unit.  The I<permission> parameter is defined in the B<MarketingPermissionLookUp> table.  Normally, this method will grant the permission but can also revoke the permision by passing 'R' as the optional I<grant> parameter

=back

=cut

sub marketing {
	my ($self, $contact, $business, $permission, $grant) = @_;
	unless ($contact > 0 and $business > 0 and $permission > 0) {
		$self->error = 'Invalid Contact, Business or Permission parameters';
		return undef;
	}
	$grant = 'G' unless $grant eq 'R';
	my $query = $self->{'dbh'}->prepare("INSERT INTO $Bod::Variables::M_Table SET $Bod::Variables::C_Table_id$Bod::Variables::C_Table = ?, $Bod::Variables::B_Table_id$Bod::Variables::B_Table = ?, date = NOW(), giveRem = ?, Permission_idPermission = ?");
	$query->execute($contact, $business, $grant, $permission);
	return $self->{'dbh'}->selectrow_array("SELECT COUNT(*) FROM $Bod::Variables::M_Table WHERE $Bod::Variables::C_Table_id$Bod::Variables::C_Table = ?, $Bod::Variables::B_Table_id$Bod::Variables::B_Table = ? AND Permission_idPermission = ? AND date > NOW() - INTERVAL 2 SECOND", undef, $contact, $business, $permission);
}

1;