package LIMS;

=begin # doesn't work under production env
use vars '$svk_revision';
BEGIN { # get svk equivalent of svnversion - hit only once during startup:
	unless ($ENV{HARNESS_ACTIVE}) { # crashes it
		$svk_revision = `svk info | grep 'Revision:' | awk '{print \$2}'`;
	}
}
our $VERSION = $svk_revision;
=cut

use Moose;
extends 'LIMS::Titanium';
with (
	# 'LIMS::Model::Roles::QueryLogger',
	'LIMS::Controller::Roles::DataMap',
);

#use strict;
#use warnings;
#use base 'LIMS::Titanium'; # std CPAN Titanium with some additional modules loaded

use Data::Dumper;
use Time::HiRes qw(gettimeofday tv_interval);
use DateTime; DateTime->DefaultLocale('en_GB'); # set default locale for app
use Scalar::Util qw(weaken);
# use POSIX qw(strftime); # only required by CAP::LogDispatch callback

use LIMS::RDBO;     # returns LIMS::DB->new_or_cached via init_db()
use LIMS::Validate; # returns validation profile
use LIMS::Local::Debug;
use LIMS::Local::Utils;
use LIMS::Local::Config;
use LIMS::Local::QueryLog qw( set_querylog_args );
use LIMS::Local::LogDispatch;

=begin # test don't work -
sub cgiapp_get_query {
    my $self = shift;

    require CGI::Simple; # note, uploads are disabled by default in CGI::Simple
    return CGI::Simple->new();
}
=cut

#-------------------------------------------------------------------------------
# OVERRIDE METHODS
#-------------------------------------------------------------------------------
sub cgiapp_init {
    my $self = shift; # DEBUG $self->query; # needs to be after Log::Dispatch setup

	if ($self->{have_turned_dbi_trace_on}) { # eg in fcgi script - comment to enable
		my $msg = sprintf 'PID: %s; TIMESTAMP: %s',
			$$, DateTime->now( time_zone => 'local' )->datetime;
		DBI->trace_msg($msg, 0); # warn $msg;
	}
	
    # set Time::HiRes base-line; needs to be before Log::Dispatch setup
    $self->param( t0 => [gettimeofday] );

    # CAP::DBI - load dbh into object - replaced with own dbh() method now
#    my $dbi = $self->_dbh_config; $self->dbh_config( $dbi );

    # configure plugins:
    $self->_configure_plugins;

    # everything protected except forgotten password, logout & AJAX functions:
	# (need 'logout' or will have to login an expired session 1st to logout!!)
    $self->authen->protected_runmodes( qr/^(?!password_|logout|do_ajax)/ );

    $self->debug($self->query); # needs to be done after plugin config

    #require LIMS::Local::DevelCycle; # warn Devel::Cycle::find_cycle($self);
    #my $out = LIMS::Local::DevelCycle::find($self); warn $out if $out;    
}

#-------------------------------------------------------------------------------
sub setup {
    my $self = shift;

    $self->run_modes(
        login    => 'login',
        AUTOLOAD => \&_exception,
    ); # warn Dumper $self->run_modes;
}

#-------------------------------------------------------------------------------
sub cgiapp_prerun {
    my $self = shift; 

	# check access route is permitted (ie direct or via portal):
	return $self->redirect('/') unless $self->_check_portal_referral();
	
    $self->tt_params(
        app_url       => $self->query->url,
        url_with_path => $self->query->url(-path_info=>1), # also works in template c.query.utl(path_info=1);
# 		VERSION 	  => $VERSION, # doesn't work under production env
        # action => (split '/', $self->query->path_info)[1], # using c.query.path_info.match('^/' _ link) instead
	);

    $self->_create_user_profile() if
        $self->authen->username &&
        ! defined $self->session->param('UserProfile');
        # $self->debug($self->session->dump);

	$self->_set_active_link();
	
    # redirect to hello page if new login:
    if ( $self->authen->is_new_login ) {
        return $self->redirect( $self->query->url . '/login/hello' );
    }
    
    # pass username to QueryLog for sql logging:
    LIMS::Local::QueryLog::set_querylog_args({user => $self->authen->username});
	# pass config args to errorhandler (needs admin email, smtp, etc):
    LIMS::Local::ErrorHandler::set_errorhandler_args({
		cfg  => $self->cfg('settings'),
		user => $self->authen->username,
	});

	# otherwise CAD-loaded classes can't find it for package-wide authorization:
	$self->run_modes( authz_forbidden => 'forbidden' ); 	
	
    # alternative to $self->authen->protected_runmodes:
    # $self->authen->username ?
    #   $self->authen->redirect_after_login :
    #     $self->authen->redirect_to_login;
}

#-------------------------------------------------------------------------------
sub cgiapp_postrun { }

#-------------------------------------------------------------------------------
sub teardown {
    my $self = shift;
    $self->session->flush; # recommended action
}

#-------------------------------------------------------------------------------
# for model methods, return (or if 1st call then create & return) a db object:
sub lims_db { shift->{__lims_db} ||= LIMS::RDBO->init_db } # should be the *only* call in whole app

sub dbh { shift->lims_db->dbh } # for Controller methods requiring the dbh eg session_config()

#-------------------------------------------------------------------------------
# drop-in replacements for CAP::ConfigAuto (cfg & config) - using L::Local::Config now
sub config {
    my $self = shift;

    my $cfg = LIMS::Local::Config->instance;
    
    if (@_) {
        my $section = shift;
        return $cfg->{$section};
    }
    else {
        return $cfg;
    }
}
# alias for config() used by CAP::ConfigAuto:
sub cfg { shift->config(@_) }

#-------------------------------------------------------------------------------
# RUNMODES
#-------------------------------------------------------------------------------
sub login { 
    my $self = shift;

    # for destination in login.tt - query->self_url with query_string args removed:
    $self->tt_params( destination_url => $self->query->url(-path_info=>1) );

	$self->_limerick();
	
    return $self->tt_process('login/default.tt');
}

#-------------------------------------------------------------------------------
# PRIVATE METHODS
#-------------------------------------------------------------------------------
sub _configure_plugins {
    my $self = shift;

    # load config from config file:
    my $cfg = $self->cfg;

#-------------------------------------------------------------------------------
    # override default template_name_generator method:
    $cfg->{tt_config}->{TEMPLATE_NAME_GENERATOR} = _tmpl_name_generator(); # should be able to do this in config?

    # $self->tt_config( $cfg->{tt_config} ); # now loading TT as class method
__PACKAGE__->tt_config( $cfg->{tt_config} ); # (singleton) instead of object method

#-------------------------------------------------------------------------------
    # configure CAP::Session - uses CGI::Session; gets cookie or hidden field
    # session id from $cgi; add CGI_SESSION_OPTIONS (cgi method, session driver,
    # etc) to session_config():
    $cfg->{session_config}->{CGI_SESSION_OPTIONS} = $self->_set_cgisession_options();
    $self->session_config( %{ $cfg->{session_config} } );

#-------------------------------------------------------------------------------
    # configure CAP::Authentication:
    $cfg->{authen_cfg}->{DRIVER} = # override $cfg->{authen_cfg}->{DRIVER} = []
		$ENV{ROSEDB_DEVINIT} =~ /devinit_devel/ # use 'Dummy' login for devel
			? 'Dummy'  # ! $ENV{HARNESS_ACTIVE}
			: [ 'Generic', sub { $self->model('User')->verify_credentials(@_) } ];

    $self->authen->config( $cfg->{authen_cfg} ); # $self->debug($cfg->{authen_cfg});

#-------------------------------------------------------------------------------
    # ValidateRM/DFV config:
    $self->param( dfv_defaults => $cfg->{dfv_defaults} );

#-------------------------------------------------------------------------------
    # CAP::MessageStack config:
	$self->capms_config(
		-automatic_clearing => 1, # removed from session after display
		-classification_param_name => 'class', # default = 'classification'
	);

#-------------------------------------------------------------------------------
    FormValidator::Simple->set_messages( $self->messages('form_validator') );

#-------------------------------------------------------------------------------
    # configure CAP::Authorization:
	# push @{ $cfg->{authz_cfg}->{DRIVER} }, ( DBH => $self->dbh );
    # $self->authz->config( $cfg->{authz_cfg} );
	
	my $obj = $self; weaken $obj; # or we get circular ref inside authz config()
	
	# only used for package-wide auth ie __PACKAGE__->authz->authz_runmodes()
	$self->authz->config(
		DRIVER => [ 'Generic', sub {
				# Generic driver recieves username as 1st arg (don't need it here):
				my ($username, $action) = @_; # warn $action;
				return $obj->user_can($action); # using user_can() to validate
			}
		],
		# FORBIDDEN_RUNMODE => 'forbidden', # doesn't work with CA::Dispatch for
		# class-wide authz, so defining authz_forbidden rm in prerun() instead		 
	);
	
#-------------------------------------------------------------------------------
    # CAP::Flash config: using CAP::MessageStack & self->flash() as drop-in replacement
#    my $flash_config = $cfg->{flash};
#    $self->flash_config( @$flash_config ); # using CGI::Session::Flash & $self->flash
	
#-------------------------------------------------------------------------------
    # CAP::LogDispatch config (needs to be after session & authen configs):
#    $self->_cap_logdispatch_setup; # comment out if using LIMS::Local::LogDispatch instead

#-------------------------------------------------------------------------------
    # experimental - to stop large build-up of 'form_state_cap_form_state_<32-digits>
    # => 172800' in session table (but still in _SESSION_EXPIRE_LIST from CGI::Session)
	# TODO: actually dangerous if params expire - all will be null so params updated as such
    # $self->form_state->config( expires => '+30m'); # puts form_state into url
}

#-------------------------------------------------------------------------------
# add CGI_SESSION_OPTIONS (cgi method, session driver, etc) to session_config():
sub _set_cgisession_options {
    my $self = shift;

    my $cfg = $self->cfg;

	# override $cfg->{settings}->{db_session_serializer} to a readable format
	# if running test suite:
	$cfg->{settings}->{db_session_serializer} = 'default' if $ENV{HARNESS_ACTIVE};

    my %CGI_SESSION_OPTIONS = (
        db => [
            'driver:MySQL;serializer:'.$cfg->{settings}->{db_session_serializer},
            $self->query,
            { Handle => $self->dbh },
        ],
        # need IDFile, IDInit & IDIncr in session_options_file if using id:incr
        file => [
            'driver:File;serializer:'.$cfg->{settings}->{file_session_serializer},
            $self->query,
            $cfg->{session_options_file},
        ],
    );

    # select CGI_SESSION_OPTIONS driver method from settings.txt (db or file):
    my $session_driver # sessions dir if lims_server.pl
		= $ENV{SERVER_SOFTWARE} =~ /HTTP::Server::Simple/ ?
            $cfg->{settings}->{session_driver} : 
               'db'; # sessions table for production or test harness

    return $CGI_SESSION_OPTIONS{$session_driver};
}

#-------------------------------------------------------------------------------
sub _check_portal_referral {
	my $self = shift; # $self->stash( REMOTE_ADDR => $ENV{REMOTE_ADDR} ); # to check mod_rpaf is working
	
	return 1 # return OK if already logged in or hidden form param supplied:
		if $self->authen->username || $self->query->param('is_portal_access')
		|| $ENV{SERVER_PORT} == 8080; # VPN access on non-approved IP addr

	# get array(ref) of permitted direct-entry IP addresses:
	my $permitted = $self->get_yaml_file('local_addr'); # $self->debug($cfg);
	
	# will return true only if REMOTE_ADDR matches a permitted ip address:
	return ( grep { $ENV{REMOTE_ADDR} =~ /^$_/ } @$permitted );
}

#-------------------------------------------------------------------------------
sub _set_active_link {
	my $self = shift; # use Data::Dumper; # warn Dumper $self->query->path_info;

	my $default = 'search'; # default link
	
	# get 'class' arg (if exists) from url eg /foo/bar/1 - class = 'foo':
	my $class = ( split '/', $self->query->path_info )[1] || return $default;
	
	# for classes that don't correspond directly to nav links:
	my $mapped = {
		# class     nav-link
		patient => 'register',
		# request => 'register', # TODO: matches also 'unlock' & 'email_record'
		config  => 'admin',
	};

	my $active_link = $mapped->{$class} || $class || $default;	
	$self->tt_params( active_link => $active_link ); # warn $active_link;
}

#-------------------------------------------------------------------------------
=begin # doesn't work with LIMS::Local::Config->instance method
sub _cap_logdispatch_setup { # using LIMS::Local::LogDispatch instead
    my $self = shift;

    my $cfg = $self->cfg; # warn Dumper $cfg;

    # can't have $self in a callback:
    my $t0   = $self->param('t0');
    my $user = $self->authen->username;

    $cfg->{log_dispatch}{LOG_DISPATCH_OPTIONS} = {
        callbacks => sub {
            my %h = @_; chomp $h{message};
            my $timestamp = strftime "[%d-%b-%Y %H:%M:%S]", localtime;

            return sprintf "%s %s %s [%.4f sec]\n",
                $timestamp,
                uc $user,
                $h{message},
                tv_interval $t0, [gettimeofday];
        },
    }; # warn Dumper $cfg->{log_dispatch};

    $self->log_config( $cfg->{log_dispatch} );
}
=cut

#-------------------------------------------------------------------------------
# called from cgiapp_prerun only if authen->username exists && profile doesn't:
sub _create_user_profile {
	my $self = shift; 

    my %args = (
        col   => 'username',
        value => $self->authen->username,
    );

    # get users' details from users table, or die (can't use error() as session
	# doesn't exist yet, so user_can() call from tmpl fails):
    my $user_details = $self->model('User')->get_user_details(\%args)
	|| die 'no user details found in _create_user_profile()';

    # first look for custom permissions:
    my $user_permissions = # arrayref
        $self->model('User')->get_user_permissions($user_details->id);

    # if no custom permissions, load default settings for this users' group:
    if (! @$user_permissions) {
        $user_permissions =
            $self->model('User')->get_user_group_functions($user_details->group_id);
    }
	
	# get list of function_names from user_permissions object:
	my @functions = map { $_->function->function_name } @$user_permissions;
	
    # user_profile object to hashref - don't force_load or dies on login table
    my $profile = $user_details->as_tree; # $self->debug($profile);

    # stuff functions list into $profile:
    $profile->{functions} = \@functions; # $self->debug($profile);

    # set session & authen user profile:
    $self->session->param( UserProfile => $profile ); # TODO (lot of work) can probably replace this with:
	$self->authen->store->save(yooza_profile => $profile); # for CAP::Authen LOGIN_SESSION_TIMEOUT
    
	{ # update userid col of sessions table:
		my $args = {
			session_id => $self->session->id,
			userid     => $self->authen->username,
		};
		$self->model('User')->update_session_userid($args); # also updates last_login
	}
	
    unless ( $profile->{designation} eq 'administrator' ) { # || ! $ENV{MOD_PERL};	
        # register successful login (except db admin):
        $self->model('User')->register_login($self->session);
    }
}

# ?? only works if rm = requested, not forwarded (use LIMS::get_template_name for that)
sub _tmpl_name_generator {
    return sub {
		my $self = shift;

		# my $self->tt_template_name(1); # causes infinate loop -> out-of-memory error
		my $rm = $self->get_current_runmode; # warn $rm;
		my $module = ref $self; # warn $module;

        # remove LIMS & LIMS/Controller from $module:
		my @segments = grep $_ !~ 'LIMS|Controller', split '::', $module;

		my $catfile = File::Spec->catfile(@segments, $rm);

		my $tmpl = lc $catfile . '.tt';
        # $self->debug('auto-generated template: ' . $tmpl);

		return $tmpl;
    };
}

#-------------------------------------------------------------------------------
sub _limerick {
	my $self = shift;
	
	my $src_file = $self->cfg('path_to_app_root') . '/src/lib/lear.txt';
	return 0 unless (-e $src_file);
	
	require LIMS::Local::Drollness; # to avoid compile-time error if absent
	my $data = LIMS::Local::Drollness::limerick($src_file);	
	
	$self->tt_params( limerick => $data );
}

#-------------------------------------------------------------------------------
# returns dbh object (and sets authen_cfg driver - not any more):
=begin # replaced with own dbh() method now
sub _dbh_config {
    my $self = shift;

    # Rose::DB method:
    # my $driver = 'dbi_driver'; # not using now, replaced with Generic & sub {}

    return LIMS::DB->new_or_cached->retain_dbh; # need retain_dbh or get:
	
=begin
  ERROR' for request '/hmds/admin/user_location': Error executing class callback
  in init stage: Can't connect to data source
  'LIMS::DB::__RoseDBPrivate__::Rose::DB::MySQL=HASH(0x9a810f4)' because I can't
  work out what driver to use (it doesn't seem to contain a 'dbi:driver:' prefix
  and the DBI_DRIVER env var is not set) at
  /home/raj/perl5/lib/perl5/CGI/Application/Plugin/DBH.pm line 42
=cut

    # $dbi->trace(1, './logs/trace.log'); # best switched on in LIMS::DB::dbi_connect

	# switch on profiling:
    #use DBI::Profile;
    #$dbi->{Profile} = DBI::Profile->new();
	#$dbi->{Profile} = 2;


=begin # DBIC method:
    use lib '/home/raj/www/apps/LIMS/tags/legacy/lib';
    use LIMS::Schema;

    $self->dbh_config( $cfg->{'dbh_params'} );
    # add schema to object - move to own class - load as needed:
    $self->param( schema => LIMS::Schema->connect(@{ $cfg->{dbh_params} }) );

    $cfg->{'dbic_driver'}->[2] = $self->param('schema'); # SCHEMA
    my $driver = 'dbic_driver';
=cut

=begin # using DRIVER = "Generic, sub {}" now - set in _configure_plugins()
	# override DBH => undef in $self->cfg->{dbi_driver}:
    @{ $self->cfg->{dbi_driver} }[2] = $db;
	$self->cfg->{authen_cfg}{DRIVER} = $self->cfg->{$driver};
=cut

    # return $db; # moved to top
#}

#-------------------------------------------------------------------------------
sub _debug_path {
    my ($self, $method) = @_;

    if (! $method) {
        my @caller = caller(1); # warn $caller[3];
        ($method) = $caller[3] =~ /.*::(.*)/; # greedy matching ensures last
    }

    # done in LOG_DISPATCH_OPTIONS callbacks sub now:
    # my $timings =
    #   sprintf "%s, %.4f sec", $method, tv_interval $self->param('t0'), [gettimeofday];

    $self->debug($method); # DEBUG( $timings );
}

#-------------------------------------------------------------------------------
# never gets called if using CA::Dispatch - CAD uses its own error handling for
# non-existent rms
sub _exception {
    my ($self, $intended_runmode) = @_; # $obj->_dump_path('_exception');

#   my $output = "Looking for '$intended_runmode', but found 'AUTOLOAD' instead";

    $self->tt_params(
        mode  => 'Error', # title
        msg   => $intended_runmode,
        title => 'Unknown Action',
    );

    return $self->tt_process('site/exception.tt');
}

1;

__END__
# uses CAP::TT tt_template_name method to return path to template
# alternative to TEMPLATE_NAME_GENERATOR in tt_config - should be able to handle
# forwarded rm's; requires tmpl name to match module path
# (eg Admin::Screen::default() => admin/screen/default.tt):
=begin
sub _get_template_name {
    my $self = shift;

   # eg LIMS/Admin/Screen/Test/default.tmpl
	my @segments = grep $_ !~ 'LIMS|Controller', split '/', $self->tt_template_name(1);

    my $tmpl = File::Spec->catfile(@segments);

    $tmpl =~ s/tmpl/tt/; # using tt suffix

	return lc $tmpl; # DEBUG 'auto-generated template: ' . $tmpl;
}
=cut