For all past time we have connected directly to our CRM from the scripts that need to read or write the data. It has been my intention for a very long time to create some standard subroutines in a require file to do all the things we regularly need to do. Thanks to The Monastery, I now know I need to use a module to do this. So I have set about creating a suitable module. I also thought this would be a good opportunity to do it properly and include some POD. This module will never be used outside of our use case but it seems like good practice to include documentation.
Could you please look over the code and documentation and for me before I go too much further and advise if I am making any horrible mistakes, what I can improve and how clear the documentation is...
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 at
+tempt is made to find the environment from the C<$ENV{'HTTP_HOST'}> v
+ariable.
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:l
+ocalhost: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_sch
+ema.`COLUMNS` WHERE TABLE_SCHEMA = '$Bod::Variables::db_prefix$env' A
+ND 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::V
+ariables::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 fi
+eld names.
=back
=cut
sub get {
my ($self, $id) = @_;
return $self->{'dbh'}->selectrow_hashref("SELECT * FROM $Bod::Vari
+ables::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 up
+date a person. If the B<email> or B<Twitter> fields match then updat
+e 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->{'em
+ail'};
$fields->{'twitter'} =~ s/^\@//;
$id = $self->{'dbh'}->selectrow_array("SELECT id$Bod::Variables::C
+_Table FROM $Bod::Variables::C_Table WHERE twitter = ?", undef, $fiel
+ds->{'twitter'}) if $fields->{'twitter'} and !$id;
$fields->{"id$Bod::Variables::C_Table"} = $fields->{'id'} if $fiel
+ds->{'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_Tab
+le = $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 !$fiel
+ds->{'twitter'}) {
$self->error = 'Insufficient information provided for cont
+act';
return 0;
}
my $query = $self->{'dbh'}->prepare("INSERT INTO $Bod::Variabl
+es::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 busines
+s unit. However, if the optional I<subscribe> is true, the person wi
+ll be resubscribed to the list if they had previously unsubscribed.
Returns true if the person is in the busines unit, zero if it has fail
+ed 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::Vari
+ables::B_Table_has_$Bod::Variables::C_Table SET $Bod::Variables::C_Ta
+ble_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::Variable
+s::C_Table_id$Bod::Variables::C_Table = ?, $Bod::Variables::B_Table_i
+d$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 u
+nit. The I<permission> parameter is defined in the B<MarketingPermis
+sionLookUp> table. Normally, this method will grant the permission b
+ut can also revoke the permision by passing 'R' as the optional I<gra
+nt> 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 parame
+ters';
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;
