package Common::RSApp;

# ----------------------------------------------------------------
# The Common::RSApp class is intended to provide fundamental
# application services support. For example, it does the work of
# connecting to core databases and making those connections
# available to any application that needs them.
#
# Common::RSApp is implemented as a singleton as all services
# provided are available in a global context for the duration
# of an application's lifetime. There is no need and  never
# should be more than one Common::RSApp instance (and the
# singleton implementation enforces this).
#
# Common::RSApp determiness whether it is running from Apache or
# from a standalone script and behaves accordingly. For the
# purposes of running under Apache and the singleton
# implementation, application lifetime is limited to the lifetime
# of a single request. In standalone context, lifetime is the
# process lifetime.
#
# Typical apache usage:
#
# # at the start of the handler
# my $app = Common::RSApp->new();
#
# # now, anywhere in the code
# my $db = Common::RSApp::GetClientDB();
# $db->DoCmd(...);
#
# # at the end of the handler
# $app->finalize();
#
#
# From a script, just include a client ID. Everything else
# is done as before:
#
# my $app = Common::RSApp->new(clientID => $clientID);
#
#
# Methods:
#
# new()
#   returns the one and only instance of the RSApp class
#   accepts optional clientID parameter for use in
#   batch environments (must not be specfied when running
#   under Apache)
#
# static GetClientID()
#   returns client ID
#
# static GetCommonDB()
#   returns RSDB object connected to RSCOMMON database
#
# static GetClientDB()
#   returns RSDB object connecton to client specific database
#
# static GetActiveUserID()
#   returns the ID for the currently logged in user
#   note: returns zero in standalone environments
#
# static GetMasterUserID()
#   returns the true user ID regarless of who they're logged in as
#   note: returns zero in standalone environments
#
# static GetIPAddr()
#   returns the string representation of the requester's IP address
#   for standalone environments, this is the IP address of the
#   machine the application is run from
#
# static GetConfig( module, parameter );
#   returns a value associated to the configuration parameter
#   defined in the module configuration file.
#
# finalize()
#   releases resources used by RSApp object
# ----------------------------------------------------------------
use strict;
use warnings;

#use Apache::Singleton;
#use base 'Apache::Singleton';

use lib '/app/tools/common/lib';
use Common::RSDB;
use Common::Assert;
use Common::Log;
use Common::Crypto;

#use Common::Client;
use Common::Cookie::SessionCookie;
use Common::Cookie::PersistentCookie;

use Data::Dumper;

###
#   Define configuration modules.  Can be accessed via a static method:
#   Common::Config::GetConfig( 'module' );
###
use constant kConfigModules => (
    common       => 'Common::Config',
    rps          => 'RPS::Config',
    distribution => 'Distribution::Config',
    job          => 'Job::Config',
    bookpub      => 'BookPub::Config',
    rdas         => 'RDAS::Config',
    report       => 'RDAS::Report',
);

# List of valid web server ip addresses
#
my %gProductionWebHostNames = (
    'bpweb01'  => 1,
    'bpweb02'  => 1,
    'rpsweb01' => 1,
    'rpsweb02' => 1,
    'rpsweb03' => 1,
);

# List of valid production server ip addresses
#
my %gProductionHostNames = (
    'rpsapp01' => 1,
    'rpsapp02' => 1,
    'rpsapp03' => 1,
    'rpsapp04' => 1,
    'rpsapp05' => 1,
    'rpsapp06' => 1,
    'rpsapp07' => 1,
    'rpsapp08' => 1,
    'rpsapp09' => 1,
    'rpsapp10' => 1,
    'rpsapp11' => 1,
    'app00'    => 1,
    'app01'    => 1,
    'report06' => 1,
    'report07' => 1,
    'report08' => 1,
    'rpsapp20' => 1,
    'rpsapp21' => 1,
    'rpsapp22' => 1,
    'rpsapp23' => 1,
    'rpsapp24' => 1,
    'rpsapp25' => 1,
);

# List of valid staging server ip addresses
#
my %gStagingHostNames = (
    'staging64' => 1,
    'staging'   => 1,
);

my $gTheInstance;

sub new {
    my $class = shift;
    my %args  = @_;

    # take a gander at _new_instance(), that's where the magic
    # happens for classes derived from Apache::Singleton

    # Have to invoke instance based on the $class parameter...
    # Otherwise we wouldn't be able to subclass this class.
    #
    assert( !defined $gTheInstance );

    my $self = {};

    bless( $self, $class );

    $gTheInstance = $self->_init(%args);

    # Now instantiate the 'auto delete' wrapper object.
    #
    my $deleterObj = Common::RSApp::AutoDeleter->new($gTheInstance);
    return $deleterObj;
}

# We needed a scheme to _temporarily_ replace the singleton with another.
# Hence this additional constructor, which should be used judiciously...
#
sub new_temporary {
    my ( $class, %args ) = @_;

    my $self = {};
    bless( $self, $class );

    # Keep the reference to the previous instance around.
    #
    $self->{_previousInstance} = $gTheInstance;

    $gTheInstance = $self->_init(%args);

    # Now return another autodeleter wrapped around this new, temporary singleton.
    #
    my $deleterObj = Common::RSApp::AutoDeleter->new($gTheInstance);
    return $deleterObj;
}

sub Instance {
    assert( defined $gTheInstance, "The RSApp singleton does not exist!" );

    return $gTheInstance;
}

sub ReleaseInstance {
    my ($self) = @_;

    if ( $self->{_previousInstance} ) {
        $gTheInstance = $self->{_previousInstance};
    } else {
        $gTheInstance = undef;
    }

    #	$gTheInstance = undef;
}

sub finalize {
    my $self = shift;

    $self->_disconnectCommonDB();
    $self->_disconnectClientDB();
    $self->_disconnectClientDBBatchMode();
    delete $self->{activeUserID};
    delete $self->{masterUserID};
    delete $self->{ipAddr};
    delete $self->{clientID};
}

# Static methods

sub GetClientID {
    my $instance = Instance();
    return $instance->{clientID};
}

sub GetCommonDB {
    my $instance = Instance();

    if ( !defined $instance->{commonDB} ) {
        $instance->_connectCommonDB();
    }
    return $instance->{commonDB};
}

## Name: GetPlaintextKey
## Desc: Returns the plaintext key for use in encrypting/decrypting data
## Args: key_id - index into client's hash of data keys
## Returns: the plaintext datakey
##
sub GetPlaintextKey {
    my $keyID        = shift;
    my $instance     = Instance();
    my $plaintextKey;

    $plaintextKey = ( exists $instance->{_datakeys}{$keyID} ) ?  $instance->{_datakeys}{$keyID} : undef;

    if ( !$plaintextKey ) {
        print STDERR "RSApp.GetPlaintextKey - refreshing _datakeys ...\n";
        $instance->_initDatakeys();
        $plaintextKey = ( exists $instance->{_datakeys}{$keyID} ) ?  $instance->{_datakeys}{$keyID} : undef;  # try again..
    }

    return $plaintextKey;
}

## Name: GetCipherByKeyID
## Desc: Returns a Cipher object that can be used for encrypting/decrypting data
## Args: key_id - index into client's hash of data keys
## Returns: the cipher object to use
##
sub GetCipherByKeyID {
    my $keyID    = shift;
    my $instance = Instance();
    my $cipher;

    return if ( !$keyID );

    $cipher = ( exists $instance->{_cipher}{$keyID} ) ?  $instance->{_cipher}{$keyID} : undef;

    if ( !$cipher ) {

        # Refresh the _datakeys and _cipher attribute.
        $instance->_initDatakeys(); # This will scan for new data keys

        # .. and try again
        $cipher = ( exists $instance->{_cipher}{$keyID} ) ?  $instance->{_cipher}{$keyID} : undef;  # try again..
    }
    return $cipher;
}

## Name: GetDatakey
## Desc: Returns a random key_id for use in encrypting data.
## Args:
##
sub GetDatakeyID {
    my $instance = Instance();

    my $keyID;

    if( exists $instance->{_datakeys} && keys %{$instance->{_datakeys}} ) {
        my @keys;
        my $hr = $instance->{_datakeys};
        foreach my $k ( keys %$hr ) {
            push @keys, $k;
        }
        my $minimum = 0;
        my $maximum = (scalar @keys);
        my $x = $minimum + int(rand($maximum - $minimum));
        $keyID = $keys[$x];
    }
    return $keyID;
}

## Returns the Common::Client instance.
##
sub GetClient {

    #    my $instance = Instance();
    #
    #    if (! defined $instance->{client})
    #    {
    #        $instance->{client} = Common::Client->new(clientID => $instance->{clientID});
    #    }
    #    return $instance->{client};
}

sub GetClientDB {
    my $instance = Instance();

    if ( !defined $instance->{clientDB} ) {
        $instance->_connectClientDB();
    }
    return $instance->{clientDB};
}

sub GetClientDBBatchMode {
    my $instance = Instance();

    if ( !defined $instance->{clientDBBatchMode} ) {
        $instance->_connectClientDBBatchMode();
    }
    return $instance->{clientDBBatchMode};
}

sub CloseCommonDB {
    my $instance = Instance();

    $instance->{commonDB} = undef;
}

sub CloseClientDB {
    my $instance = Instance();

    $instance->{clientDB} = undef;
}

sub CloseClientDBBatchMode {
    my $instance = Instance();

    $instance->{clientDBBatchMode} = undef;
}

sub GetMasterUserID {
    my $instance = Instance();

    if ( !defined $instance->{masterUserID} ) {
        $instance->_setUserIDs();
    }
    return $instance->{masterUserID};
}

sub GetActiveUserID {
    my $instance = Instance();

    if ( !defined $instance->{activeUserID} ) {
        $instance->_setUserIDs();
    }
    return $instance->{activeUserID};
}

sub GetIPAddr {
    my $instance = Instance();

    if ( !defined $instance->{ipAddr} ) {
        $instance->_setIPAddr();
    }
    return $instance->{ipAddr};
}

sub GetServerIPAddr {
    my $instance = Instance();

    if ( !defined $instance->{serverIPAddr} ) {
        require Sys::Hostname;
        require Socket;

        my $hostname = Sys::Hostname::hostname();
        my $packedIP = gethostbyname($hostname);
        $instance->{serverIPAddr} = Socket::inet_ntoa($packedIP);
    }
    return $instance->{serverIPAddr};
}

sub GetClientVHost {
    my $instance = Instance();

    if ( !defined $instance->{vhost} ) {
        my $client = Common::Client->new( clientID => GetClientID() );
        $instance->{vhost} = $client->WebAlias();
        $instance->{vhost} = $client->ClientNameClean() unless $instance->{vhost};
    }
    return $instance->{vhost};
}

sub GetHostname {
    my $instance = Instance();

    if ( !defined $instance->{hostname} ) {
        $instance->_setIPAddr();
    }
    return $instance->{hostname};
}

# Return the systems host name
sub GetRealHostname {
    require Sys::Hostname;
    my $hostname = ( split( /\./, Sys::Hostname::hostname() ) )[0];

    return $hostname;
}

sub GetProductionWebServers { keys %gProductionWebHostNames }

sub IsProductionWebServer {

    # We can't use the GetIPAddr call here, because that
    # will return the _requestor's_ IP address in a modperl setting.
    # We want to know _our_ ip address.
    #
    # Or, we just use an environmental variable.
    #
    my $instance = Instance();
    if ( !defined $instance->{isProductionServer} ) {
        require Sys::Hostname;
        my $hostname = ( split( /\./, Sys::Hostname::hostname() ) )[0];
        $instance->{isProductionWebServer} = $gProductionWebHostNames{$hostname} ? 1 : 0;
    }
    return $instance->{isProductionWebServer};
}

sub GetProductionServers { keys %gProductionHostNames }

sub IsProductionServer {

    # We can't use the GetIPAddr call here, because that
    # will return the _requestor's_ IP address in a modperl setting.
    # We want to know _our_ ip address.
    #
    # Or, we just use an environmental variable.
    #
    my $instance = Instance();
    if ( !defined $instance->{isProductionServer} ) {
        require Sys::Hostname;
        my $hostname = ( split( /\./, Sys::Hostname::hostname() ) )[0];
        $instance->{isProductionServer} = $gProductionHostNames{$hostname} ? 1 : IsProductionWebServer(@_);
    }
    return $instance->{isProductionServer};
}

sub GetStagingServers { keys %gStagingHostNames }

sub IsStagingServer {

    # We can't use the GetIPAddr call here, because that
    # will return the _requestor's_ IP address in a modperl setting.
    # We want to know _our_ ip address.
    #
    # Or, we just use an environmental variable.
    #
    my $instance = Instance();
    if ( !defined $instance->{isStagingServer} ) {
        require Sys::Hostname;
        my $hostname = ( split( /\./, Sys::Hostname::hostname() ) )[0];
        $instance->{isStagingServer} = $gStagingHostNames{$hostname} ? 1 : 0;
    }
    return $instance->{isStagingServer};
}

# This is for other classes to use when they want to create some cached data that is tied
# to the life-span of the instance.
# Sometimes it is not practical to cache things directly here in the global RSApp class...
# For example, if we want to cache an object, chances are excellent that we'll end up in
# a circular include situation (since most class modules are going to end up including Common::RSApp).
#
sub GetRAMCache {
    my $instance = Instance();

    if ( !defined $instance->{ramCache} ) {
        $instance->{ramCache} = {};
    }
    return $instance->{ramCache};
}

# JPK - This weird little method is used to generate a 'unique' token that can be used
#       to identify this particular instance of the App object.  Basically, it's for debugging.
#
sub DebugToken {
    my $instance = Instance();
    if ( !defined $instance->{debugToken} ) {
        $instance->{debugToken} = time() . int( rand(1000) );
    }

    return $instance->{debugToken};
}

sub GetSessionPreferenceCookie {
    my $instance = Instance();
    if ( !defined $instance->{sessionPrefCookie} ) {
        $instance->{sessionPrefCookie} = new Common::Cookie::SessionCookie();
    }

    return $instance->{sessionPrefCookie};
}

sub GetPersistentPreferenceCookie {
    my $instance = Instance();
    if ( !defined $instance->{persistentPrefCookie} ) {
        $instance->{persistentPrefCookie} = new Common::Cookie::PersistentCookie();
    }

    return $instance->{persistentPrefCookie};
}

sub GetConfig {
    my $module  = shift;
    my $keyword = shift;

    assert( $module, "Module required" );

    my $instance = Instance();

    my %modules = (kConfigModules);
    my $config  = $modules{$module};

    assert( $config, "Unknown config module: $module" );

    unless ( $instance->{config}->{$module} ) {
        eval "require $config";
        die $@ if $@;

        $instance->{config}->{$module} = $config->new();
    }

    return $instance->{config}->{$module}->get($keyword)
      if ($keyword);
}

# Private methods

sub _initDatakeys {
    my ( $self, %args ) = @_;
    my $clientID = $self->{clientID};

    my $tableName = 'data_key';

    my $dbo = ( $clientID == 0 ) ? $self->_connectCommonDB() : $self->_connectClientDB();

    my $sql = "SHOW TABLES LIKE '$tableName'";
    my $sth = $dbo->DoCmd($sql);
    my %keyMap;

    if ( ! exists $self->{_datakeys} ) {
        # Initialize the datakeys and cipher attributes
        $self->{_datakeys} = {};
        $self->{_cipher}   = {};  # hash of cipher objects; indexed by key_id and setup with the corresponding plaintext key
    }

    my $href = $self->{_datakeys};
    my $cref = $self->{_cipher};

    # If the data_key table is present, then initialize the _datakeys and _cipher attributes.
    #
    if( $sth->rows > 0 ) {

        # Read-in the client data_key
        #
        my $sql = "SELECT key_id, ciphertext FROM data_key";
        my $sth = $dbo->DoCmd($sql);
        while( my($keyID, $cipherText) = $sth->fetchrow_array() ) {

            # Decrypt the key.  we'll store the plaintext key and the associated
            # cipher object as in-memory attributes.
            #
            if ( !exists $href->{$keyID} ) {
                my $plaintextKey = Common::Crypto->GetPlaintextkey64( $cipherText );
                $href->{$keyID}  = $plaintextKey;
                $cref->{$keyID}  = Common::Crypto->_getCipher( plaintextKey64 => $plaintextKey );
            }

            # Check if we have a cipher object for the keyID.  Create one if needed to keep
            # the cipher and datakeys attributes in sync.
            #
            if ( !exists $cref->{$keyID} ) {
                my $plaintextKey = $href->{$keyID};
                $cref->{$keyID}  = Common::Crypto->_getCipher( plaintextKey64 => $plaintextKey );
            }
        }
    }
}

sub _init {
    my ( $self, %args ) = @_;

    $self->_setClientID(%args);

    $self->{_useRSDBI} = ( defined $args{useRSDBI} ? $args{useRSDBI} : 1 );
    $self->{_useRoot}  = ( defined $args{useRoot}  ? $args{useRoot}  : 0 );
    $self->_initDatakeys(%args);

    return $self;
}

sub _setClientID {
    my $self = shift;
    my %args = @_;

    if ( defined $args{clientID} ) {
        $self->{clientID} = $args{clientID};
    } elsif ( $ENV{MOD_PERL} ) {
        $self->{clientID} = $ENV{CLIENT_ID};
    } else {
        die "ERROR - no clientID specified";
    }

}

sub _connectCommonDB {
    my $self = shift;

    $self->{commonDB} = Common::RSDB->new( client_id => 0, use_rs_dbi => $self->{_useRSDBI}, root => $self->{_useRoot} );
}

sub _connectClientDB {
    my $self = shift;

    if ( $self->{clientID} ) {
        $self->{clientDB} =
          Common::RSDB->new( client_id => $self->{clientID}, use_rs_dbi => $self->{_useRSDBI}, root => $self->{_useRoot} );
    }
}

sub _connectClientDBBatchMode {
    my $self = shift;

    if ( $self->{clientID} ) {
        my $dbo = Common::RSDB->new( client_id => $self->{clientID}, use_rs_dbi => $self->{_useRSDBI}, root => $self->{_useRoot} );
        $dbo->DBH()->{AutoCommit} = 0;
        $self->{clientDBBatchMode} = $dbo;
    }
}

sub _setUserIDs {
    my $self = shift;
    if ( $ENV{MOD_PERL} ) {
        require RSApache::DBSession;

        my $session = RSApache::DBSession->new();
        $self->{masterUserID} = $session->MasterUser->UserID if $session->MasterUser;
        $self->{activeUserID} = $session->ActiveUser->UserID if $session->ActiveUser;
    } else {
        $self->{masterUserID} = 0;
        $self->{activeUserID} = 0;
    }
}

sub _setIPAddr {
    my $self = shift;

    if ( $ENV{MOD_PERL} ) {
        $self->{ipAddr} = $ENV{REMOTE_ADDR};
        my $hostname = ( split( /\./, $ENV{HTTP_HOST} ) )[0];
        $self->{hostname} = $hostname;

        #
        # I think we do need. When we send emails with links back to the site,
        # I reference hostname in order to construct the proper URL. Is there
        # a better way? -jff-
        #

        # $self->{hostname} = "";
        #
        # We don't set the hostname, 'cause that is a very expensive operation.
        # And, well, we're assuming we don't really need it.
        # If it turns out that we _do_ need it on occasion, then this might be
        # the right place to go and get it.
    } else {
        require Sys::Hostname;
        require Socket;

        my $hostname = Sys::Hostname::hostname();
        my $packedIP = gethostbyname($hostname);
        $self->{ipAddr} = Socket::inet_ntoa($packedIP);

        $hostname = ( split( /\./, $hostname ) )[0];
        $self->{hostname} = $hostname;
    }
}

sub _disconnectCommonDB {
    my $self = shift;

    if ( $self->{commonDB} ) {

        # in the future we may want to formally close DB
        delete $self->{commonDB};
    }
}

sub _disconnectClientDB {
    my $self = shift;

    if ( $self->{clientDB} ) {

        # in the future we may want to formally close DB
        delete $self->{clientDB};
    }
}

sub _disconnectClientDBBatchMode {
    my $self = shift;

    if ( $self->{clientDBBatchMode} ) {

        # in the future we may want to formally close DB
        delete $self->{clientDBBatchMode};
    }
}

sub DESTROY {
    my $self = shift;

    $self->finalize();
}

###
1;    # Play nicely.
###

package Common::RSApp::AutoDeleter;

use lib '/app/tools/common/lib';

use Common::Assert;

sub new {
    my ( $class, $objectToDelete ) = @_;
    assert($objectToDelete);

    my $self = bless {}, $class;
    $self->{_obj} = $objectToDelete;

    return $self;
}

sub DESTROY {
    my $self = shift;
    $self->{_obj}->ReleaseInstance();
    $self->{_obj} = undef;
}

1;