#21564, external message services: REST client

4 files changed, 329 insertions, 13 deletions

diff --git a/FS/FS/msg_template.pm b/FS/FS/msg_template.pm
index d7d9f50..827bb98 100644
--- a/FS/FS/msg_template.pm
+++ b/FS/FS/msg_template.pm
@@ -35,6 +35,12 @@ FS::msg_template - Object methods for msg_template records
 
   $error = $record->check;
 
+=head1 NOTE
+
+This uses a table-per-subclass ORM strategy, which is a somewhat cleaner
+version of what we do elsewhere with _option tables. We could easily extract 
+that functionality into a base class, or even into FS::Record itself.
+
 =head1 DESCRIPTION
 
 An FS::msg_template object represents a customer message template.
@@ -81,20 +87,66 @@ points to.  You can ask the object for a copy with the I<hash> method.
 
 sub table { 'msg_template'; }
 
+sub extension_table { ''; } # subclasses don't HAVE to have extensions
+
 sub _rebless {
   my $self = shift;
   my $class = 'FS::msg_template::' . $self->msgclass;
   eval "use $class;";
   bless($self, $class) unless $@;
+
+  # merge in the extension fields
+  if ( $self->msgnum and $self->extension_table ) {
+    my $extension = $self->_extension;
+    if ( $extension ) {
+      $self->{Hash} = { $self->hash, $extension->hash };
+    }
+  }
+
   $self;
 }
 
+# Returns the subclass-specific extension record for this object. For internal
+# use only; everyone else is supposed to think of this as a single record.
+
+sub _extension {
+  my $self = shift;
+  if ( $self->extension_table and $self->msgnum ) {
+    local $FS::Record::nowarn_classload = 1;
+    return qsearchs($self->extension_table, { msgnum => $self->msgnum });
+  }
+  return;
+}
+
 =item insert [ CONTENT ]
 
 Adds this record to the database.  If there is an error, returns the error,
 otherwise returns false.
 
-# inherited
+=cut
+
+sub insert {
+  my $self = shift;
+  $self->_rebless;
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+
+  my $error = $self->SUPER::insert;
+  # calling _extension at this point makes it copy the msgnum, so links work
+  if ( $self->extension_table ) {
+    local $FS::Record::nowarn_classload = 1;
+    my $extension = FS::Record->new($self->extension_table, { $self->hash });
+    $error ||= $extension->insert;
+  }
+
+  if ( $error ) {
+    dbh->rollback if $oldAutoCommit;
+  } else {
+    dbh->commit if $oldAutoCommit;
+  }
+  $error;
+}
 
 =item delete
 
@@ -102,16 +154,56 @@ Delete this record from the database.
 
 =cut
 
-# inherited
+sub delete {
+  my $self = shift;
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+
+  my $error;
+  my $extension = $self->_extension;
+  if ( $extension ) {
+    $error = $extension->delete;
+  }
+
+  $error ||= $self->SUPER::delete;
+
+  if ( $error ) {
+    dbh->rollback if $oldAutoCommit;
+  } else {
+    dbh->commit if $oldAutoCommit;
+  }
+  $error;
+}
 
-=item replace [ OLD_RECORD ] [ CONTENT ]
+=item replace [ OLD_RECORD ]
 
 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 returns the error, otherwise returns false.
 
 =cut
 
-# inherited
+sub replace {
+  my $new = shift;
+  my $old = shift || $new->replace_old;
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+
+  my $error = $new->SUPER::replace($old, @_);
+
+  my $extension = $new->_extension;
+  if ( $extension ) {
+    $error ||= $extension->replace;
+  }
+
+  if ( $error ) {
+    dbh->rollback if $oldAutoCommit;
+  } else {
+    dbh->commit if $oldAutoCommit;
+  }
+  $error;
+}
 
 sub replace_check {
   my $self = shift;
diff --git a/FS/FS/msg_template/email.pm b/FS/FS/msg_template/email.pm
index 275dc82..e69183f 100644
--- a/FS/FS/msg_template/email.pm
+++ b/FS/FS/msg_template/email.pm
@@ -448,17 +448,10 @@ sub content {
 
 =cut
 
-=back
-
-=head2 CLASS METHODS
-
-=over 4
-
 =item send_prepared CUST_MSG
 
-Takes the CUST_MSG object and sends it to its recipient. This is a class 
-method because everything needed to send the message is stored in the 
-CUST_MSG already.
+Takes the CUST_MSG object and sends it to its recipient. The "smtpmachine"
+configuration option will be used to find the outgoing mail server.
 
 =cut
 
diff --git a/FS/FS/msg_template/http.pm b/FS/FS/msg_template/http.pm
new file mode 100644
index 0000000..51dfcff
--- /dev/null
+++ b/FS/FS/msg_template/http.pm
@@ -0,0 +1,155 @@
+package FS::msg_template::http;
+use base qw( FS::msg_template );
+
+use strict;
+use vars qw( $DEBUG $conf );
+
+# needed to talk to the external service
+use LWP::UserAgent;
+use HTTP::Request::Common;
+use JSON;
+
+# needed to manage prepared messages
+use FS::cust_msg;
+
+our $DEBUG = 1;
+our $me = '[FS::msg_template::http]';
+
+sub extension_table { 'msg_template_http' }
+
+=head1 NAME
+
+FS::msg_template::http - Send messages via a web service.
+
+=head1 DESCRIPTION
+
+FS::msg_template::http is a message processor in which the message is exported
+to a web service, at both the prepare and send stages.
+
+=head1 METHODS
+
+=cut
+
+sub check {
+  my $self = shift;
+  return 
+       $self->ut_textn('prepare_url')
+    || $self->ut_textn('send_url')
+    || $self->ut_textn('username')
+    || $self->ut_textn('password')
+    || $self->ut_anything('content')
+    || $self->SUPER::check;
+}
+
+sub prepare {
+
+  my( $self, %opt ) = @_;
+
+  my $json = JSON->new->canonical(1);
+
+  my $cust_main = $opt{'cust_main'}; # or die 'cust_main required';
+  my $object = $opt{'object'} or die 'object required';
+
+  my $hashref = $self->prepare_substitutions(%opt);
+
+  my $document = $json->decode( $self->content || '{}' );
+  $document = {
+    'msgname' => $self->msgname,
+    'msgtype' => $opt{'msgtype'},
+    %$document,
+    %$hashref
+  };
+
+  my $request_content = $json->encode($document);
+  warn "$me ".$self->prepare_url."\n" if $DEBUG;
+  warn "$request_content\n\n" if $DEBUG > 1;
+  my $ua = LWP::UserAgent->new;
+  my $request = POST(
+    $self->prepare_url,
+    'Content-Type' => 'application/json',
+    'Content' => $request_content,
+  );
+  if ( $self->username ) {
+    $request->authorization_basic( $self->username, $self->password );
+  }
+  my $response = $ua->request($request);
+  warn "$me received:\n" . $response->as_string . "\n\n" if $DEBUG;
+
+  my $cust_msg = FS::cust_msg->new({
+      'custnum'   => $cust_main->custnum,
+      'msgnum'    => $self->msgnum,
+      '_date'     => time,
+      'msgtype'   => ($opt{'msgtype'} || ''),
+  });
+
+  if ( $response->is_success ) {
+    $cust_msg->set(body => $response->decoded_content);
+    $cust_msg->set(status => 'prepared');
+  } else {
+    $cust_msg->set(status => 'failed');
+    $cust_msg->set(error => $response->decoded_content);
+  }
+
+  $cust_msg;
+}
+
+=item send_prepared CUST_MSG
+
+Takes the CUST_MSG object and sends it to its recipient.
+
+=cut
+
+sub send_prepared {
+  my $self = shift;
+  my $cust_msg = shift or die "cust_msg required";
+  # don't just fail if called as a class method
+  if (!ref $self) {
+    $self = $cust_msg->msg_template;
+  }
+
+  # use cust_msg->header for anything? we _could_...
+  my $request_content = $cust_msg->body;
+
+  warn "$me ".$self->send_url."\n" if $DEBUG;
+  warn "$request_content\n\n" if $DEBUG > 1;
+  my $ua = LWP::UserAgent->new;
+  my $request = POST(
+    $self->send_url,
+    'Content-Type' => 'application/json',
+    'Content' => $request_content,
+  );
+  if ( $self->username ) {
+    $request->authorization_basic( $self->username, $self->password );
+  }
+  my $response = $ua->request($request);
+  warn "$me received:\n" . $response->as_string . "\n\n" if $DEBUG;
+
+  my $error;
+  if ( $response->is_success ) {
+    $cust_msg->set(status => 'sent');
+  } else {
+    $error = $response->decoded_content;
+    $cust_msg->set(error => $error);
+    $cust_msg->set(status => 'failed');
+  }
+
+  if ( $cust_msg->custmsgnum ) {
+    $cust_msg->replace;
+  } else {
+    $cust_msg->insert;
+  }
+
+  $error;
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
diff --git a/bin/msg_template_http-demo.pl b/bin/msg_template_http-demo.pl
new file mode 100755
index 0000000..8d184fc
--- /dev/null
+++ b/bin/msg_template_http-demo.pl
@@ -0,0 +1,76 @@
+=head1 NAME
+
+FS::msg_template::http example server.
+
+=head1 DESCRIPTION
+
+This is an incredibly crude Mojo web service for demonstrating how to talk 
+to the HTTP customer messaging interface in Freeside.
+
+It implements an endpoint for the "password reset" messaging case which 
+creates a simple password reset message using some template variables,
+and a "send" endpoint that just delivers the message by sendmail. The 
+configuration to use this as your password reset handler would be:
+
+prepare_url = 'http://localhost:3000/prepare/password_reset'
+send_url =    'http://localhost:3000/send'
+No username, no password, no additional content.
+
+=cut
+
+use Mojolicious::Lite;
+use Mojo::JSON qw(decode_json encode_json);
+use Email::Simple;
+use Email::Simple::Creator;
+use Email::Sender::Simple qw(sendmail);
+
+post '/prepare/password_reset' => sub {
+  my $self = shift;
+
+  my $json_data = $self->req->body;
+  #print STDERR $json_data;
+  my $input = decode_json($json_data);
+  if ( $input->{username} ) {
+    my $output = {
+      'to'      => $input->{invoicing_email},
+      'subject' => "Password reset for $input->{username}",
+      'body'    => "
+To complete your $input->{company_name} password reset, please go to 
+$input->{selfservice_server_base_url}/selfservice.cgi?action=process_forgot_password;session_id=$input->{session_id}
+
+This link will expire in 24 hours.",
+    };
+
+    return $self->render( json => $output );
+
+  } else {
+
+    return $self->render( text => 'Username required', status => 500 );
+
+  }
+};
+
+post '/send' => sub {
+  my $self = shift;
+
+  my $json_data = $self->req->body;
+  my $input = decode_json($json_data);
+  my $email = Email::Simple->create(
+    header => [
+      From    => $ENV{USER}.'@localhost',
+      To      => $input->{to},
+      Subject => $input->{subject},
+    ],
+    body => $input->{body},
+  );
+  local $@;
+  eval { sendmail($email) };
+  if ( $@ ) {
+    return $self->render( text => $@->message, status => 500 );
+  } else {
+    return $self->render( text => '' );
+  }
+};
+
+app->start;
+