• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Dispatch;

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

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

use vars qw($VERSION);

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 = (
    # specific rm's that don't match :app/:rm
    '/'    => { app => 'Search', rm => 'default' }, # if no path_info supplied - should be handled by default arg ?
    logout => { app => 'Login', rm => 'logout' },

    '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/=/: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'
 
# HILIS4 commenced 10/10/2011
sub _app_version {
    if (! $VERSION ) { # should only run system call once on start-up:
        $VERSION = `git rev-list --after=2011-10-10 HEAD --count`;
        say printf 'starting HILIS v4.%04d', $VERSION unless $ENV{HARNESS_ACTIVE}; 
    } 
    return $VERSION;
}

1;