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::Role::Base', # render_view(), model()
	'LIMS::Controller::Roles::DataMap',
	'LIMS::Controller::Roles::Resource',
);

use IO::All;
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 Memory::Usage;
# use POSIX qw(strftime); # only required by CAP::LogDispatch callback
# use Devel::Gladiator qw(arena_ref_counts);

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;
	}

=begin # Memory::Usage:
	$self->{mu} = Memory::Usage->new();
	$self->{mu}->record('cgiapp_init');
=cut
	# set Time::HiRes base-line; needs to be before Log::Dispatch setup
    $self->param( t0 => [gettimeofday] );

    # configure plugins:
    $self->_configure_plugins;

    # configure CAP::Authentication protected_runmodes:
    $self->_configure_protected_runmodes;

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

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

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

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

    # load this if using non-external fastcgi (see comment in L::L::QueryLog)
    # LIMS::Local::QueryLog->ensure_warn_handler_capture;
=begin
    $Data::Dumper::Deparse = 1; # warn Dumper $SIG{__WARN__};
    use Sub::Identify ':all';
    my $subname = sub_fullname( $SIG{__WARN__} ); warn $subname;
=cut
    # $self->param(arena_ref_counts_pre => arena_ref_counts()); # and _log_process_size
    
    my $authen = $self->authen; # $self->_dump_authen_params;
    my $query  = $self->query;    

	# temporarily force logged-in users to holding page in offline mode:
	$self->prerun_mode('offline') if $authen->username
		&& $self->config('settings')->{offline};
	
	# check access route is permitted (ie direct or via portal):
=begin # combined with login form now
	unless ( $self->_check_portal_referral ) { # warn 'here';
		my $home_page = sprintf '/%s.html', $query->url(-relative => 1);
		return $self->redirect( $home_page ); # hilis4.html, hods.html, etc
	}
	{ # some locations can skip terms & conditions - simplified login so not needed:
		my $local_addr = $self->get_yaml_file('local_addr'); # warn Dumper $permitted;
		my $var = grep { $ENV{REMOTE_ADDR} =~ /^$_/ } @$local_addr;
		$self->tt_params( can_bypass_terms => $var );
	}
=cut
    $self->tt_params( # keep this *ABOVE* main if() block below !!
        app_url       => $query->url,
        url_base      => $query->url(-base=>1),
        url_with_path => $query->url(-path_info=>1),
        remote_addr   => $ENV{REMOTE_ADDR},
	);
    { # pass username to ErrorHandler & QueryLog (*BEFORE* main if() block below):
        my $args = { user => $self->authen->username || '' }; # '' in case no username yet
        LIMS::Local::QueryLog::set_querylog_args($args);
        LIMS::Local::ErrorHandler::set_errorhandler_args($args);
    }

    # if new login, need to see if user profile exists (ie genuine new login), or
	# re-login after idle timeout (need to check username matches session profile):
    if ( $authen->is_new_login ) { # warn 'here';
		# get user profile (if it exists):
        my $profile  = $self->user_profile; # warn Dumper $profile;
        my $username = $authen->username;

        if (! $profile) { # it's a new login
            $self->_create_user_profile(); # warn 'here';
            my $vars = $query->Vars(); # warn Dumper $vars;

			# redirect to 'hello' page, unless arrived via reset pwd email:
            unless ( $vars->{skip_redirect} ) { # from password_reset()
                # re-direct 1st login to password reset page:
                my $redirect = $vars->{first_login} && $vars->{authen_password}
                    ? ( 'user/change_password/' . $vars->{authen_password} )
                    : 'login/hello'; # warn $redirect;
                return $self->redirect( $query->url . '/' . $redirect );
            }
        }
        # check form param username matches session profile, or redirect to logout:
        elsif ( $username ne $profile->{username} ) { # warn 'here';
			# $self->flash(); # can't do it - lost on logout(); not needed as never get here
			# warn Dumper [$self->authen->username, $profile->{username}];
           $self->redirect( $query->url . '/logout' );
        }
        # check email address present (legacy conversion):
        elsif (! $profile->{email} ) { # warn 'here';
            $self->flash( warning => $self->messages('user')->{update_email} );
        }
		# check new messages:
		elsif ( my $i = $self->model('User')->any_new_messages($username) ) {
			# set flash msg:
			my $msg = $self->tt_process('user/new_msg_alert.tt', {count => $i});
			$self->flash( info => ${$msg} );
		}
    }

	$self->_set_active_link(); # uses tt_params - won't work on a redirect

	# 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 {
    my ($self, $output) = @_; # warn Dumper $output;
    my $run_time = sprintf "%.2f sec",
        tv_interval $self->param('t0'), [gettimeofday];
    ${$output} =~ s/%SCRIPTRUNTIMER%/$run_time/; # too late to use tt_params
    
    # $self->_log_process_size();
}

=begin # to manipulate info pre tt_process:
sub tt_pre_process {
    my ($self, $file, $vars) = @_; warn Dumper $vars;
    $vars->{remote_user} = $ENV{REMOTE_USER};
    return;
}
=cut

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

    # README: need to update sessions table with userid on new login and also on
    # re-authentication after a session timeout - CAP::Authen seems to delete
    # session on timeout (see sql log), and a new one is created in final call
    # to CGI::Session::flush (see last item in a DBI trace), which calls
    # CGI::Session::Driver::mysql::store and creates a new session with same ID,
    # and preserves a_session UserProfile vals (deletes all AUTH_* fields), but
    # also ignores userid col. So need to update it again after flush():
    if ( $self->authen->is_new_login ) { # warn 'new login/re-authentication';
        my $args = {
            session_id => $self->session->id,
            userid     => $self->authen->username,
        };
        $self->model('User')->update_session_userid($args); # warn Dumper $args;
    }

    if ( grep $ENV{$_}, qw/DEVEL_SERVER HARNESS_ACTIVE/ ) { # warn 'here'; # for devel/testing only:
        require LIMS::Local::DevelCycle; # warn Devel::Cycle::find_cycle($self);
        my $out = LIMS::Local::DevelCycle::find($self); die $out if $out;
    }
=begin # Memory::Usage:
	$self->{mu}->record('teardown');
	my $r = $self->{mu}->report(); # $self->{mu}->dump();
	$self->debug($r);
=cut
}

#-------------------------------------------------------------------------------
# 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()

sub user_profile { shift->authen->store->fetch('yooza_profile') } # session param

#-------------------------------------------------------------------------------
# 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(@_) }

# temporary holding page for offline / maintenance mode:
sub offline { return shift->_offline_mode }

#-------------------------------------------------------------------------------
# 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->tt_params( env => \%ENV );

	# for idle timeout re-authentication:
	if ( my $profile = $self->user_profile ) { # warn Dumper $profile;
		$self->tt_params( user_profile => $profile );
	}

	$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:
    my $authen_cfg = $self->_authen_config(); # doesn't work in lims_config if using instance()
    $self->authen->config($authen_cfg);

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

#-------------------------------------------------------------------------------
    # CAP::MessageStack config; *must* have YAML::Syck installed if using yaml serializer:
	$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 $_self = $self; weaken $_self; # or 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 $_self->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 $cgi = $self->query;
    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 %h = (
        db => [
            'driver:MySQL;serializer:'.$cfg->{settings}->{db_session_serializer},
            $cgi, { Handle => $self->dbh },
        ],
        # need IDFile, IDInit & IDIncr in session_options_file if using id:incr
        file => [
            'driver:File;serializer:'.$cfg->{settings}->{file_session_serializer},
            $cgi, $cfg->{session_options_file},
        ],
    );

    # select CGI_SESSION_OPTIONS driver method (db or file):
    my $use_file_sessions = # use file for sessions if:
        $ENV{USE_FILE_SESSIONS} # set in L::Local::LIMS
        || $cgi->param('USE_FILE_SESSIONS') # if called via chart via cron
        || ( $ENV{SERVER_SOFTWARE} =~ /HTTP::Server::Simple/
            && ! $ENV{USE_DB_SESSIONS} ); # command-line flag
    my $driver = $use_file_sessions ? 'file' : 'db';

    return $h{$driver};
}

#-------------------------------------------------------------------------------
sub _authen_config { # doesn't work in lims_config.pl using L::L::C::instance()
    my $self = shift;

    my $settings = $self->cfg('settings');

    my $_self = $self; weaken($_self); # or get circular ref inside callback

    my $authen_driver
        = $ENV{ROSEDB_DEVINIT} =~ /devinit_devel/ && ! $ENV{DB_SESSIONS}
            ? 'Dummy' # ! $ENV{HARNESS_ACTIVE} # use 'Dummy' login for devel
            : [ # generic driver passes authen_username & authen_password:
                'Generic', sub {
                    my ($u, $p) = @_; my $v = $_self->query->Vars();
                    $_self->model('User')->verify_credentials($u, $p, $v);
                }
            ]; # warn Dumper $authen_driver;

    my $timeouts = $self->get_yaml_file('idle_timeout'); # warn Dumper $timeouts;

    # custom method to fine-tune timeout based on user type:
    my $authen_timeout = sub { # returns true if the session should be timed out
        my $authen = shift;

        # get user profile, set in LIMS::_create_user_profile():
        my $user_profile  = $_self->user_profile; # warn Dumper $user_profile;
        my $user_location = $user_profile->{user_location}->{location_name};
        my $functions     = $user_profile->{functions}; # warn Dumper $functions;

        # how long to set idle timeout (admin, or in idle_timeouts.yml, or default):
        # my $timeout = $user_profile->{designation} =~ /^admin/i # use function:
        my $timeout = ( grep $_ eq 'do_admin', @$functions ) # has admin function
            ? $settings->{admin_timeout} # value set in 'EVERY' will still apply
            : $timeouts->{$user_location} || $settings->{default_user_timeout};

        # ps aux | grep perl && lsof -p <process pid> - ?? keeps multiple fh open:
			# _debug_authen($authen->last_access, $timeout); # can't use $self here!!!

        return ( time() - $authen->last_access > $timeout ); # returns truth
    };

    return {
        DRIVER => $authen_driver,
        LOGIN_SESSION_TIMEOUT => {
		    IDLE_FOR => '24h', # same as session default - overridden under CUSTOM:
		    EVERY  => '1d',
		    CUSTOM => \&$authen_timeout, # true if the session should be timed out
        },
        LOGIN_RUNMODE => 'login', # redirect_after_login requires destination field in .tt if used
        STORE => 'Session', # ie CAP::Store::Session
    }; # warn Dumper $cfg->{authen_cfg};
}

#-------------------------------------------------------------------------------
sub _configure_protected_runmodes { # CAP::Authentication protected_runmodes:
    my $self = shift;
    # all rm's protected except forgotten password, logout & AJAX functions:
    # (need 'logout' or will have to login an expired session 1st to logout!!)
    my $unprotected_runmodes = join '|', qw( password_ logout );
    my @unprotected_classes = qw(ajax chart); # whole classes # eg from cron script

    my $loaded_class = $self->param('Class'); # set in LIMS::Dispatch
	# exempt @unprotected_classes from being defined as protected_runmodes:
    unless ( $loaded_class && grep lc $loaded_class eq $_, @unprotected_classes ) {
        $self->authen->protected_runmodes( qr/^(?!$unprotected_runmodes)/ );
    } # warn Dumper [$loaded_class, $self->authen->protected_runmodes];
}

#-------------------------------------------------------------------------------
sub _debug_authen { # called from within closure so don't use $self
    my ($last_access, $timeout) = @_;
    my $msg = sprintf 'LOGIN_SESSION_TIMEOUT: idle=%s, timeout=%s',
        time() - $last_access, $timeout;
    LIMS::Local::Debug::DEBUG($msg); # can't use $self->debug() - see above
}

#-------------------------------------------------------------------------------
sub _log_process_size { # log query string, pid & process size
    my $self = shift;
    return unless $ENV{FAST_CGI};
    
    my $query = $self->query->self_url();
    $query =~ s/(authen_password=).*/$1/; # don't log passwds
    my $content = sprintf "[%s:%s] %s %s\n", $$,
        LIMS::Local::Utils::format_number(`ps -p $$ -o size=`+0),
        LIMS::Local::Utils::date_and_time_now, $query; # warn $content;
    io("$FindBin::Bin/../logs/process-size.txt")->append($content);
=begin
    my %diffs;
    my $arena_ref_counts = arena_ref_counts();
    my $arena_ref_counts_pre = $self->arena_ref_counts();

    foreach (keys %$arena_ref_counts_pre) {
        $diffs{$_} = [$arena_ref_counts_pre->{$_}, $arena_ref_counts->{$_}]
            if $arena_ref_counts_pre->{$_} != $arena_ref_counts->{$_};
    }
    warn Dumper \%diffs;
=cut
}

#-------------------------------------------------------------------------------
=begin # home page replaced with single-click login form now
sub _check_portal_referral {
	my $self = shift; # $self->stash( REMOTE_ADDR => $ENV{REMOTE_ADDR} ); # to check mod_rpaf is working

# if user not logged in, have neither profile nor authen->username; on 1st login
# have authen->username but no profile (it's created after return from here); if
# logged in but timed-out, have profile but not authen->username. So need to
# check for profile OR username OR valid 'access_token' form flag OR permitted
# direct-entry IP address. Also allow :8080 VPN access on non-approved IP addr

    my $user_profile = $self->user_profile; # warn Dumper $user_profile;
    my $settings     = $self->cfg('settings');

    my $portal_access_ok = 0; # '/' sends access token as SHA1 digest of today DT
    if ( my $token = $self->query->param('access_token') ) {
        my $str = LIMS::Local::Utils::today->datetime; # eg 2010-01-01T00:00:00
        $portal_access_ok = ( $token eq LIMS::Local::Utils::sha1_digest($str) );
    }

	return 1 # return OK if already logged in or hidden form param supplied:
		if $self->authen->username # ie logged in and not timed out (see above)
        || $user_profile # ie AFTER initial login, even if timed-out (see above)
        || $settings->{is_test_platform} # global.txt (for test server)
        || $portal_access_ok # from login page originally via portal root '/'
        || $ENV{SERVER_PORT} == 8080; # for 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 );
}
=cut

#-------------------------------------------------------------------------------
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;
}

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

    my $profile = $self->user_profile; # warn Dumper $profile;
    my $authen  = $self->authen; # warn $authen->username;

	no warnings 'uninitialized';
    $self->debug([
        'is_authenticated:' . $authen->is_authenticated || 0,
        'is_login_timeout:' . $authen->is_login_timeout || 0,
        'profile_username:' . $profile->{username}		|| '',
        'is_new_login:'     . $authen->is_new_login     || 0,
        'last_access:'      . $authen->last_access		|| '',
        'last_login:'       . $authen->last_login		|| '',
        'username:'			. $authen->username			|| '',
   ]);
}

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

    # 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 $username = $self->authen->username;
    my $user_details = $self->model('User')->get_user_by_username($username)
	|| 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);
    }

    # user_profile object to hashref - don't force_load or dies on login table
    my $profile = $user_details->as_tree; # $self->debug($profile);

	{ # get list of function_names from user_permissions object:
        my @functions = map { $_->function->function_name } @$user_permissions;
        # stuff functions list into $profile:
        $profile->{functions} = \@functions; # $self->debug($profile);
    }
    { # does user belong to local network?
        my $belongs_to_local_network
            = $self->model('User')->in_local_network($profile->{user_location_id});
        $profile->{is_local_network} = $belongs_to_local_network;
    }
    $profile->{user_location}->{centre} = $self->cfg('settings')->{_centre};

    # 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

	# skip following functions if dev_server:
	return if $ENV{DEVEL_SERVER};

	# update last_login date on user table:
    $self->model('User')->update_last_login($username);

    # register successful login (except db admin):
    unless ( $profile->{designation} eq 'administrator' ) { # || ! $ENV{MOD_PERL};
        $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 _offline_mode {
	my $self = shift; $self->_limerick;
	return $self->tt_process('site/maintenance.tt');
}

#-------------------------------------------------------------------------------
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::Stuff; # to avoid compile-time error if absent
	my $data = LIMS::Local::Stuff::limerick($src_file);
	$self->tt_params(limerick => $data);
	# set flag for tt to enable/disable:
	$self->tt_params( devel_server => $ENV{DEVEL_SERVER} );  
}

#-------------------------------------------------------------------------------
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');
}

sub _capture_weakself {
    # use as: my $callback = $self->_capture_weakself(sub { my ($self, @args) = @_ });
    my ($self, $code) = @_;
    weaken(my $weak_self = $self);
    return sub {
        $code->($weak_self, @_)
    }
}

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

# 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
#}

=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