make self-service session cache module configurable, start framework for in-database session cache

7 files changed, 367 insertions, 30 deletions

diff --git a/FS/FS/ClientAPI/Agent.pm b/FS/FS/ClientAPI/Agent.pm
index e4a58c0..daede59 100644
--- a/FS/FS/ClientAPI/Agent.pm
+++ b/FS/FS/ClientAPI/Agent.pm
@@ -4,16 +4,18 @@ package FS::ClientAPI::Agent;
 
 use strict;
 use vars qw($cache);
+use subs qw(_cache);
 use Digest::MD5 qw(md5_hex);
-use Cache::SharedMemoryCache; #store in db?
 use FS::Record qw(qsearchs); # qsearch dbdef dbh);
+use FS::ClientAPI_SessionCache;
 use FS::agent;
 use FS::cust_main qw(smart_search);
 
-#store in db?
-my $cache = new Cache::SharedMemoryCache( {
-   'namespace' => 'FS::ClientAPI::Agent',
-} );
+sub _cache {
+  $cache ||= new FS::ClientAPI_SessionCache( {
+               'namespace' => 'FS::ClientAPI::Agent',
+             } );
+}
 
 sub agent_login {
   my $p = shift;
@@ -37,9 +39,9 @@ sub agent_login {
   my $session_id;
   do {
     $session_id = md5_hex(md5_hex(time(). {}. rand(). $$))
-  } until ( ! defined $cache->get($session_id) ); #just in case
+  } until ( ! defined _cache->get($session_id) ); #just in case
 
-  $cache->set( $session_id, $session, '1 hour' );
+  _cache->set( $session_id, $session, '1 hour' );
 
   { 'error'      => '',
     'session_id' => $session_id,
@@ -49,7 +51,7 @@ sub agent_login {
 sub agent_logout {
   my $p = shift;
   if ( $p->{'session_id'} ) {
-    $cache->remove($p->{'session_id'});
+    _cache->remove($p->{'session_id'});
     return { 'error' => '' };
   } else {
     return { 'error' => "Can't resume session" }; #better error message
@@ -59,7 +61,7 @@ sub agent_logout {
 sub agent_info {
   my $p = shift;
 
-  my $session = $cache->get($p->{'session_id'})
+  my $session = _cache->get($p->{'session_id'})
     or return { 'error' => "Can't resume session" }; #better error message
 
   #my %return;
@@ -84,7 +86,7 @@ sub agent_info {
 sub agent_list_customers {
   my $p = shift;
 
-  my $session = $cache->get($p->{'session_id'})
+  my $session = _cache->get($p->{'session_id'})
     or return { 'error' => "Can't resume session" }; #better error message
 
   #my %return;
@@ -120,3 +122,4 @@ sub agent_list_customers {
 
 }
 
+1;
diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm
index 58966b3..d18a6e4 100644
--- a/FS/FS/ClientAPI/MyAccount.pm
+++ b/FS/FS/ClientAPI/MyAccount.pm
@@ -2,14 +2,15 @@ package FS::ClientAPI::MyAccount;
 
 use strict;
 use vars qw($cache);
+use subs qw(_cache);
 use Digest::MD5 qw(md5_hex);
 use Date::Format;
 use Business::CreditCard;
-use Cache::SharedMemoryCache; #store in db?
 use FS::CGI qw(small_custview); #doh
 use FS::Conf;
 use FS::Record qw(qsearch qsearchs);
 use FS::Msgcat qw(gettext);
+use FS::ClientAPI_SessionCache;
 use FS::svc_acct;
 use FS::svc_domain;
 use FS::svc_external;
@@ -30,10 +31,11 @@ use vars qw( @cust_main_editable_fields );
 
 use subs qw(_provision);
 
-#store in db?
-my $cache = new Cache::SharedMemoryCache( {
-   'namespace' => 'FS::ClientAPI::MyAccount',
-} );
+sub _cache {
+  $cache ||= new FS::ClientAPI_SessionCache( {
+               'namespace' => 'FS::ClientAPI::MyAccount',
+             } );
+}
 
 #false laziness w/FS::ClientAPI::passwd::passwd
 sub login {
@@ -69,9 +71,9 @@ sub login {
   my $session_id;
   do {
     $session_id = md5_hex(md5_hex(time(). {}. rand(). $$))
-  } until ( ! defined $cache->get($session_id) ); #just in case
+  } until ( ! defined _cache->get($session_id) ); #just in case
 
-  $cache->set( $session_id, $session, '1 hour' );
+  _cache->set( $session_id, $session, '1 hour' );
 
   return { 'error'      => '',
            'session_id' => $session_id,
@@ -81,7 +83,7 @@ sub login {
 sub logout {
   my $p = shift;
   if ( $p->{'session_id'} ) {
-    $cache->remove($p->{'session_id'});
+    _cache->remove($p->{'session_id'});
     return { 'error' => '' };
   } else {
     return { 'error' => "Can't resume session" }; #better error message
@@ -150,7 +152,7 @@ sub customer_info {
 
 sub edit_info {
   my $p = shift;
-  my $session = $cache->get($p->{'session_id'})
+  my $session = _cache->get($p->{'session_id'})
     or return { 'error' => "Can't resume session" }; #better error message
 
   my $custnum = $session->{'custnum'}
@@ -190,7 +192,7 @@ sub edit_info {
 
 sub payment_info {
   my $p = shift;
-  my $session = $cache->get($p->{'session_id'})
+  my $session = _cache->get($p->{'session_id'})
     or return { 'error' => "Can't resume session" }; #better error message
 
   ##
@@ -267,7 +269,7 @@ sub process_payment {
 
   my $p = shift;
 
-  my $session = $cache->get($p->{'session_id'})
+  my $session = _cache->get($p->{'session_id'})
     or return { 'error' => "Can't resume session" }; #better error message
 
   my %return;
@@ -357,7 +359,7 @@ sub process_payment {
 
 sub invoice {
   my $p = shift;
-  my $session = $cache->get($p->{'session_id'})
+  my $session = _cache->get($p->{'session_id'})
     or return { 'error' => "Can't resume session" }; #better error message
 
   my $custnum = $session->{'custnum'};
@@ -379,7 +381,7 @@ sub invoice {
 
 sub list_invoices {
   my $p = shift;
-  my $session = $cache->get($p->{'session_id'})
+  my $session = _cache->get($p->{'session_id'})
     or return { 'error' => "Can't resume session" }; #better error message
 
   my $custnum = $session->{'custnum'};
@@ -400,7 +402,7 @@ sub list_invoices {
 
 sub cancel {
   my $p = shift;
-  my $session = $cache->get($p->{'session_id'})
+  my $session = _cache->get($p->{'session_id'})
     or return { 'error' => "Can't resume session" }; #better error message
 
   my $custnum = $session->{'custnum'};
@@ -571,7 +573,7 @@ sub order_pkg {
 
 sub cancel_pkg {
   my $p = shift;
-  my $session = $cache->get($p->{'session_id'})
+  my $session = _cache->get($p->{'session_id'})
     or return { 'error' => "Can't resume session" }; #better error message
 
   my $custnum = $session->{'custnum'};
@@ -740,14 +742,14 @@ sub _custoragent_session_custnum {
   if ( $p->{'session_id'} ) {
 
     $context = 'customer';
-    $session = $cache->get($p->{'session_id'})
+    $session = _cache->get($p->{'session_id'})
       or return { 'error' => "Can't resume session" }; #better error message
     $custnum = $session->{'custnum'};
 
   } elsif ( $p->{'agent_session_id'} ) {
 
     $context = 'agent';
-    my $agent_cache = new Cache::SharedMemoryCache( {
+    my $agent_cache = new FS::ClientAPI_SessionCache( {
       'namespace' => 'FS::ClientAPI::Agent',
     } );
     $session = $agent_cache->get($p->{'agent_session_id'})
@@ -762,6 +764,5 @@ sub _custoragent_session_custnum {
 
 }
 
-
 1;
 
diff --git a/FS/FS/ClientAPI/Signup.pm b/FS/FS/ClientAPI/Signup.pm
index 4947a64..ede7ba9 100644
--- a/FS/FS/ClientAPI/Signup.pm
+++ b/FS/FS/ClientAPI/Signup.pm
@@ -5,6 +5,7 @@ use Tie::RefHash;
 use FS::Conf;
 use FS::Record qw(qsearch qsearchs dbdef);
 use FS::Msgcat qw(gettext);
+use FS::ClientAPI_SessionCache;
 use FS::agent;
 use FS::cust_main_county;
 use FS::part_pkg;
@@ -88,7 +89,7 @@ sub signup_info {
 
   my $session = '';
   if ( exists $packet->{'session_id'} ) {
-    my $cache = new Cache::SharedMemoryCache( {
+    my $cache = new FS::ClientAPI_SessionCache( {
       'namespace' => 'FS::ClientAPI::Agent',
     } );
     $session = $cache->get($packet->{'session_id'});
@@ -164,7 +165,7 @@ sub new_customer {
 
   my $agentnum;
   if ( exists $packet->{'session_id'} ) {
-    my $cache = new Cache::SharedMemoryCache( {
+    my $cache = new FS::ClientAPI_SessionCache( {
       'namespace' => 'FS::ClientAPI::Agent',
     } );
     my $session = $cache->get($packet->{'session_id'});
diff --git a/FS/FS/ClientAPI_SessionCache.pm b/FS/FS/ClientAPI_SessionCache.pm
new file mode 100644
index 0000000..b722484
--- /dev/null
+++ b/FS/FS/ClientAPI_SessionCache.pm
@@ -0,0 +1,78 @@
+package FS::ClientAPI_SessionCache;
+
+use strict;
+use vars qw($module);
+use FS::UID qw(datasrc);
+
+#ask FS::UID to run this stuff for us later
+install_callback FS::UID sub { 
+  my $conf = new FS::Conf;
+  $module = $conf->config('selfservice_server-cache_module')
+            || 'Cache::SharedMemoryCache';
+};
+
+=head1 NAME
+
+FS::ClientAPI_SessionCache;
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+Minimal Cache::Cache-alike interface for storing session cache information.
+Backends to Cache::SharedMemoryCache, Cache::FileCache, or an internal
+implementation which stores information in the clientapi_session and
+clientapi_session_field database tables.
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+=cut
+
+sub new {
+  my $proto = shift;
+  my $class = ref($proto) || $proto;
+  unless ( $module =~ /^_Database$/ ) {
+    eval "use $module;";
+    die $@ if $@;
+    my $self = $module->new(@_);
+    $self->set_cache_root('/usr/local/etc/freeside/clientapi_session.'.datasrc)
+      if $module =~ /^Cache::FileCache$/;
+    $self;
+  } else {
+    my $self = shift;
+    bless ($self, $class);
+  }
+}
+
+sub get {
+  my($self, $session_id) = @_;
+  die '_Database self-service session cache not yet implemented';
+}
+
+sub set {
+  my($self, $session_id, $session, $expiration) = @_;
+  die '_Database self-service session cache not yet implemented';
+}
+
+sub remove {
+  my($self, $session_id) = @_;
+  die '_Database self-service session cache not yet implemented';
+}
+
+=back
+
+=head1 BUGS
+
+Minimal documentation.
+
+=head1 SEE ALSO
+
+L<Cache::Cache>, L<FS::clientapi_session>, L<FS::clientapi_session_field>
+
+=cut
+
+1;
diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm
index 187a6f9..8ce5138 100644
--- a/FS/FS/Conf.pm
+++ b/FS/FS/Conf.pm
@@ -1383,6 +1383,13 @@ httemplate/docs/config.html
     'type'        => 'checkbox',
   },
 
+  { 'key'         => 'selfservice_server-cache_module',
+    'section'     => '',
+    'description' => 'Module used to store self-service session information.  All modules handle any number of self-service servers.  Cache::SharedMemoryCache is appropriate for a single database / single Freeside server.  Cache::FileCache is useful for multiple databases on a single server, or when IPC::ShareLite is not available (i.e. FreeBSD).', #  _Database stores session information in the database and is appropriate for multiple Freeside servers, but may be slower.',
+    'type'        => 'select',
+    'select_enum' => [ 'Cache::SharedMemoryCache', 'Cache::FileCache', ], # '_Database' ],
+  },
+
 );
 
 1;
diff --git a/FS/FS/clientapi_session.pm b/FS/FS/clientapi_session.pm
new file mode 100644
index 0000000..f71a126
--- /dev/null
+++ b/FS/FS/clientapi_session.pm
@@ -0,0 +1,121 @@
+package FS::clientapi_session;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearch qsearchs );
+
+@ISA = qw(FS::Record);
+
+=head1 NAME
+
+FS::clientapi_session - Object methods for clientapi_session records
+
+=head1 SYNOPSIS
+
+  use FS::clientapi_session;
+
+  $record = new FS::clientapi_session \%hash;
+  $record = new FS::clientapi_session { 'column' => 'value' };
+
+  $error = $record->insert;
+
+  $error = $new_record->replace($old_record);
+
+  $error = $record->delete;
+
+  $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::clientapi_session object represents an FS::ClientAPI session.
+FS::clientapi_session inherits from FS::Record.  The following fields are
+currently supported:
+
+=over 4
+
+=item sessionnum - primary key
+
+=item sessionid - session ID
+
+=item namespace - session namespace
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new record.  To add the record to the database, see L<"insert">.
+
+Note that this stores the hash reference, not a distinct copy of the hash it
+points to.  You can ask the object for a copy with the I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'clientapi_session'; }
+
+=item insert
+
+Adds this record to the database.  If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+# the insert method can be inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+# the delete method can be inherited from FS::Record
+
+=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
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid record.  If there is
+an error, returns the error, otherwise returns false.  Called by the insert
+and replace methods.
+
+=cut
+
+# the check method should currently be supplied - FS::Record contains some
+# data checking routines
+
+sub check {
+  my $self = shift;
+
+  my $error = 
+    $self->ut_numbern('primary_key')
+    || $self->ut_number('validate_other_fields')
+  ;
+  return $error if $error;
+
+  $self->SUPER::check;
+}
+
+=back
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<FS::ClientAPI>, <FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
diff --git a/FS/FS/clientapi_session_field.pm b/FS/FS/clientapi_session_field.pm
new file mode 100644
index 0000000..f790da8
--- /dev/null
+++ b/FS/FS/clientapi_session_field.pm
@@ -0,0 +1,126 @@
+package FS::clientapi_session_field;
+
+use strict;
+use vars qw( @ISA );
+use FS::Record qw( qsearch qsearchs );
+
+@ISA = qw(FS::Record);
+
+=head1 NAME
+
+FS::clientapi_session_field - Object methods for clientapi_session_field records
+
+=head1 SYNOPSIS
+
+  use FS::clientapi_session_field;
+
+  $record = new FS::clientapi_session_field \%hash;
+  $record = new FS::clientapi_session_field { 'column' => 'value' };
+
+  $error = $record->insert;
+
+  $error = $new_record->replace($old_record);
+
+  $error = $record->delete;
+
+  $error = $record->check;
+
+=head1 DESCRIPTION
+
+An FS::clientapi_session_field object represents a FS::ClientAPI session data
+field.  FS::clientapi_session_field inherits from FS::Record.  The following
+fields are currently supported:
+
+=over 4
+
+=item fieldnum - primary key
+
+=item sessionnum - Base ClientAPI sesison (see L<FS::clientapi_session>)
+
+=item fieldname
+
+=item fieldvalie
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item new HASHREF
+
+Creates a new record.  To add the record to the database, see L<"insert">.
+
+Note that this stores the hash reference, not a distinct copy of the hash it
+points to.  You can ask the object for a copy with the I<hash> method.
+
+=cut
+
+# the new method can be inherited from FS::Record, if a table method is defined
+
+sub table { 'clientapi_session_field'; }
+
+=item insert
+
+Adds this record to the database.  If there is an error, returns the error,
+otherwise returns false.
+
+=cut
+
+# the insert method can be inherited from FS::Record
+
+=item delete
+
+Delete this record from the database.
+
+=cut
+
+# the delete method can be inherited from FS::Record
+
+=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
+
+# the replace method can be inherited from FS::Record
+
+=item check
+
+Checks all fields to make sure this is a valid record.  If there is
+an error, returns the error, otherwise returns false.  Called by the insert
+and replace methods.
+
+=cut
+
+# the check method should currently be supplied - FS::Record contains some
+# data checking routines
+
+sub check {
+  my $self = shift;
+
+  my $error = 
+    $self->ut_numbern('primary_key')
+    || $self->ut_number('validate_other_fields')
+  ;
+  return $error if $error;
+
+  $self->SUPER::check;
+}
+
+=back
+
+=head1 BUGS
+
+The author forgot to customize this manpage.
+
+=head1 SEE ALSO
+
+L<FS::clientapi_session>, L<FS::ClientAPI, L<FS::Record>, schema.html from the
+base documentation.
+
+=cut
+
+1;
+