package LIMS::Dispatch;

use base 'CGI::Application::Dispatch';

use IO::Dir;
use DateTime;
use Modern::Perl;
use Data::Printer;
use Time::HiRes qw(gettimeofday tv_interval);

use vars qw($VERSION_INFO); # hashref of date and number

BEGIN {
	use LIMS::Local::ErrorHandler; # can't be used with CAP::Redirect or get
    use FindBin qw($Bin);

    # use CGI::Carp qw(fatalsToBrowser);
	# "prerun_mode() can only be called within cgiapp_prerun()! Error at
	# CAP::Redirect.pm line 24" - ($SIG{__DIE__} issue - see README)
}

# map for translate_module_name():
my %map = (
	worklist => 'WorkList', # action_links in header.tt
	printrun => 'PrintRun',
);

# CAPITALISE these (also for translate_module_name):
my @capitalised = qw(pas hmrn);

my $debug = ! grep $ENV{$_}, qw(HARNESS_ACTIVE FAST_CGI MOD_PERL); # saves *.t dumping data to console

=begin # not passing config files to LIMS constructor now - using LIMS::Local::Config->instance
use LIMS::Local::Utils;
my $path_to_app_root = LIMS::Local::Utils::find_home(); # warn 'path_to_app_root:'.$path_to_app_root;

my $d = IO::Dir->new($path_to_app_root . '/config')
	|| die "undefined \$d in $0", $@;

my @config_files =
    map { $path_to_app_root . '/config/' . $_ }
        grep { $_ =~ /lims_(.*)\.pl$/ } # lims_*.pl
            $d->read; # warn Dumper \@config_files;
=cut

my @dispatch_table = (
    # if no path_info supplied:
    '/' => { app => 'Search', rm => 'default' }, # should be handled by default arg ?
    # specific rm's that don't match :app/:rm
    logout    => { app => 'Login',     rm => 'logout' },
    messages  => { app => 'Resources', rm => 'user_messages' }, # from nav bar in header.tt
    dashboard => { app => 'Resources', rm => 'dashboard' }, # from nav bar in header.tt

    'admin/:app'        => { prefix => 'LIMS::Controller::Admin' },
    'admin/:app/:rm'    => { prefix => 'LIMS::Controller::Admin' },
    'admin/:app/:rm/:id'=> { prefix => 'LIMS::Controller::Admin' },

    'config/:app'        => { prefix => 'LIMS::Controller::Admin::Config' },
    'config/:app/:rm'    => { prefix => 'LIMS::Controller::Admin::Config' },
    'config/:app/:rm/:id'=> { prefix => 'LIMS::Controller::Admin::Config' },

    ':app/=/'    => { }, # broken url ??
    ':app/=/:id' => { rm => 'load' }, # make '=' alias for 'load'

    # generic matches:
    ':app' => { }, # LIMS::Controller::Foo::<StartRunmode>
    ':app/:rm' => { }, # LIMS::Controller::Foo::<specified runmode>
    ':app/:rm/:id' => { }, # LIMS::Controller::Foo::<specified runmode>; token = param('id')
    ':app/:rm/:id/:Id' => { }, # as above; token = param('id') & param('Id')
);

my %local_args = (
#    default => 'search', # fastcgi doesn't work unless '/' set in dispatch table
    prefix  => 'LIMS::Controller',
    table   => \@dispatch_table,
    debug   => $debug,
    args_to_new => {
       PARAMS => {
        Class => undef, # class name - defined in dispatch_args()
        app_version => _app_version(),
#       config_files => \@config_files, # using LIMS::Local::Config->instance() now
#       t0 => [gettimeofday], # moved to LIMS cgiapp_init()
       },
    },
    error_document => "<$Bin/../static/%s.html",
);

sub dispatch_args {
	my $self = shift;

	my $dispatch_args = $self->SUPER::dispatch_args;

	# override default dispatch_args with %local_args:
	$dispatch_args->{$_} = $local_args{$_} for keys %local_args;
	# warn Dumper $dispatch_args;

    # add class_name var:
    $dispatch_args->{args_to_new}->{PARAMS}->{Class} = $self->get_class_name;

	return $dispatch_args;
}

# override default method - can return module_name in different format to default:
sub translate_module_name {
    my ($self, $input) = @_; # warn $input;

	# return value from %map if defined:
	return $map{$input} if defined $map{$input};

	# force capitalisation if required:
    $input =~ s/$_/uc($_)/e for @capitalised;

    $input = join '::', map { ucfirst $_ } ( split '_', $input ); # foo_bar -> Foo::Bar
    $input = join '',   map { ucfirst $_ } ( split '-', $input ); # foo-bar -> FooBar
        # warn $input;
    return $input;
}

sub get_class_name {
    my $self = shift; # warn Dumper $self->dispatch_path;

    my $dispatch_path = $self->dispatch_path || return; # return nothing is OK

    my $class_name = ( split '/', $dispatch_path )[1]; # warn $class_name;
    return $class_name;
}

sub throw_bad_request { 1 } # just returns '1'

#-------------------------------------------------------------------------------
sub _app_version { # returns svn + git commit counts
=begin
Revision 1 Added Mon Sep 15 2008 15:04:33

initial git-svn commit on Tue, 10 Aug 2010 08:29:38 at svn version 1000:
git-svn-id: https://jti.org.uk/svn/hmds_lims/trunk@1000

HILIS4 commenced in production on Sun 09/10/2011 at svn version 1344:
git-svn-id: https://jti.org.uk/svn/hmds_lims/trunk@1344 [Sun, 9 Oct 2011 18:42:10 +0000]

penultimate commit to svn on Fri 25/04/2014 before moving to git on Mon 28/04/2014:
git-svn-id: https://jti.org.uk/svn/hmds_lims/trunk@1938 [Fri, 25 Apr 2014 12:53:48 +0000]

current version = 1000 + 'git rev-list HEAD --count'
or 1938 + commits after 25/4/2014, or 1344 + commits after 9/10/2011
#        my $commitsSinceLastSVN = `git rev-list --after=2014-04-25 HEAD --count`;
#        $VERSION = 1938 + $commitsSinceLastSVN;
=cut
    if (! $VERSION_INFO) { # should only run system call once on start-up:
		# chomp( my $date = `git log -1 --format=%cd --date=relative` ); # eg 6hrs ago - persists until restart
		chomp( my $raw_time = `git log -1 --format=%cd --date=raw` ); # warn $raw_time; # cmd appends new-line
		# extract epoch seconds eg 1455628027 +0000 [GMT], 1460022637 +0100 [BST], etc:
		my ($epoch) = $raw_time =~ /^(\d+)\s\+0[01]00/ or # don't use '||' here - gets truth
			die "could'nt extract epoch time from `git log` output"; # warn $epoch;
		my $vnumber = 999 + `git rev-list HEAD --count`; # as 1st in git repo = svn #1000
        $VERSION_INFO->{date}
			= DateTime->from_epoch(epoch => $epoch)->strftime('%d/%m/%Y %T');
		$VERSION_INFO->{number} = $vnumber;
		say 'starting HILIS 4.' . $vnumber unless $ENV{HARNESS_ACTIVE};
    } # warn $VERSION_INFO;
    return $VERSION_INFO;
}

1;
