package LIMS::Controller::Resources;

use Moose;
BEGIN { extends 'LIMS::Base'; }
with (
	'LIMS::Controller::Roles::Misc', 
    'LIMS::Controller::Roles::DataMap',
    'LIMS::Controller::Roles::DataFile',
    'LIMS::Controller::Roles::Resource',

);
__PACKAGE__->meta->make_immutable(inline_constructor => 0);

use CGI::Session;
use Data::Dumper;
use IO::All;

#-------------------------------------------------------------------------------
sub menu : StartRunmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

    return $self->tt_process;
}

#-------------------------------------------------------------------------------
sub list_all_screen_tests : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

    my $o = $self->model('Screen')->get_all_assigned_tests;

    my %tests;

    while (my $test = $o->next) { # $self->debug($test->as_tree);
        next if $test->screen->active eq 'no';

        my $section_name = $test->lab_test->lab_section->section_name;
        my $description  = $test->screen->description;
        my $field_label  = $test->lab_test->field_label;
        my $category     = $test->screen->category->name,
        my %data = (
            section_name => $section_name,
            field_label  => $field_label,
        );
        push @{ $tests{$category}{$description} }, \%data;
    }

    $self->tt_params( data => \%tests );

    return $self->tt_process;
}

#-------------------------------------------------------------------------------
sub list_linked_lab_tests : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

	# get current linked lab-tests:
    my @joins = ('parent_lab_test.lab_section', 'linked_lab_test.lab_section');
	my $args = { sort_by => 'parent_lab_test.field_label' };
    my @args = ( 'LinkedLabTest', $args, \@joins );
    my $linked_tests = $self->model('Base')->get_objects(@args);
    $self->tt_params( data => $linked_tests );
	return $self->tt_process;
}

#-------------------------------------------------------------------------------
sub diagnostic_terms : Runmode {
    my $self = shift;
	
    my %args = ( sort_by => $self->query->param('sort_by') || '' );

    my $total = $self->model('Base')->get_objects_count('Diagnosis');
    if ( $total > $self->cfg('settings')->{entries_per_page} ) {
        # invoke pager for template and add limit & offset params to \%args:
        $self->pager({ query => \%args, total => $total });
    }
	{ # get all diagnoses:
        my $diagnoses = $self->model('Diagnosis')->get_all_diagnoses(\%args);
        $self->tt_params( diagnoses => $diagnoses );
    }
    { # ICDO3 category - maps ICDO3 to sub-groups (AML, CLL, MCL, etc):
        my $sub_categories = $self->get_icdo_category(); # L::C::R::Misc
        $self->tt_params( sub_categories => $sub_categories );
    }
	return $self->tt_process;
}

#-------------------------------------------------------------------------------
sub teaching_cases : Runmode {
    my $self = shift;
	
    my $duration = $self->query->param('duration') || 365; # days default
    $self->stash( duration => $duration ); # for .tt

	my $time_now = LIMS::Local::Utils::time_now();
	my $query = [
		option_name => 'teaching',
		action => 'authorised',
		time => { ge => $time_now->subtract( days => $duration ) },
	];
	my @objects = ('request_history', 'request_option.option');
    # args = classname, optional hashref of args, optional with_objects:
    my @args = ('Request', { query => $query, multi_many_ok => 1 }, \@objects);
    my $total = $self->model('Base')->get_objects_count(@args); # warn Dumper $total;

    if ( $total > $self->cfg('settings')->{entries_per_page} ) {
        # invoke pager for template and add limit & offset params to \%args:
        $self->pager({ query => {}, total => $total });
    }

    my $data = $self->model('Audit')->teaching_cases($duration);
    $self->tt_params(
		cases => $data,
        start_date => $self->model('Request')->get_first_request_date(),
	);
	return $self->tt_process;
}

#-------------------------------------------------------------------------------
sub view_cron_log : Runmode {
    my $self = shift;
    
    my $file = $self->cfg('settings')->{cron_log_path} . '/cron.log';
    my @log = io($file)->slurp;
    
    # add flag for any lines which look like an error:
    my $err_flag = '#%=ERROR=%#';
    map { $_ .= $err_flag unless $_ =~ /^([\w_]+\.pl)/ } @log;
    
    $self->tt_params(
        err_flag => $err_flag,
        data     => \@log,
    );
    return $self->tt_process();
}

# ------------------------------------------------------------------------------
sub admin_messages : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);
    
    my $data = $self->get_admin_messages(); # R::Resources; no args for 'all' msgs
    $self->tt_params( msgs => $data );
    return $self->tt_process();
}

# ------------------------------------------------------------------------------
sub edit_admin_message : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);
    
	my $msg_id = $self->param('id');
	my $params = $self->query->Vars; # warn Dumper $vars;
	
	if (%$params) { # update of existing entry
		$self->model('')->update_admin_message($params);
		return $self->redirect( $self->qurey->url . '/resources/admin_messages');
	}
	else { # get requested entry:
		my $data = $self->get_admin_messages(); # R::Resources; no args for 'all' msgs
		
		# get requested entry from @$data array:
		my ($msg) = grep $_->id == $msg_id, @$data; # warn Dumper $msg;
		$self->tt_params( msg => $msg );
		return $self->tt_process();
	}
}

#-------------------------------------------------------------------------------
sub outreach_practice_blood_tube_overrides : Runmode {
	my $self = shift;
	
	my $data = $self->model('Outreach')->practice_blood_tube_overrides;
	return $self->tt_process({ data => $data });
}

#-------------------------------------------------------------------------------
sub view_lantronix_log : Runmode {
    my $self = shift;
    
    my $file = $self->cfg('path_to_app_root') . '/logs/lantronix.log';
    my $data = _parse_lantronix_data($file); # warn Dumper $data;	
    
#    return $self->tt_process('worklist/local/haem_data.tt', { haem_data => $data });
    return $self->tt_process({ haem_data => $data });
}

sub _parse_lantronix_data {
	my $file = shift;
	
	my @data = io($file)->slurp;
	
	my @fields = qw(
		pda wbc wbc_f rbc rbc_f hb hb_f hct hct_f mcv mcv_f mch mch_f mchc mchc_f
		plt plt_f lymph_percent lymph_percent_f mixed_percent mixed_percent_f
		neutr_percent neutr_percent_f lymph lymph_f mixed mixed_f neutr neutr_f    
	);
	
	my %results = ();
	
	my ($datetime, $id, @params);
	
	for (@data) {
		if ($_ =~ /D1U/) { # warn 'here';
			($id, @params) = $_ =~ /
				D1U\d{16}        # year, month, day + sample ID padding (8 zeros)
				(\d{8})          # sample ID = 8 char, right-aligned eg 000012_1, 0012_100, 12_10000, etc
				(\w{6})          # PDA info
				\d               # RDW select || reserve
				([\d*]{4})(\d)   # wbc + flag
				([\d*]{4})(\d)   # rbc + flag
				([\d*]{4})(\d)   # hb + flag
				([\d*]{4})(\d)   # hct + flag
				([\d*]{4})(\d)   # mcv + flag
				([\d*]{4})(\d)   # mch + flag
				([\d*]{4})(\d)   # mchc + flag
				([\d*]{4})(\d)   # plt + flag
				([\d*]{4})(\d)   # lymph (%) + flag
				([\d*]{4})(\d)   # mixed (%) + flag
				([\d*]{4})(\d)   # neutr (%) + flag
				([\d*]{4})(\d)   # lymph (#) + flag
				([\d*]{4})(\d)   # mixed (#) + flag
				([\d*]{4})(\d)   # neutr (#) + flag
		#		.*{5}            # rdw - don't need
		#		.*{5}            # pdw - don't need
		#		.*{5}            # mpv - don't need
		#		.*{5}            # p-lrc - don't need
			/xo; # warn Dumper [$id, \@params ];
		}
		elsif (/(\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2})/) { # warn 'here';	
			$datetime = $1; # warn $datetime;
		}

		if ($datetime && $id && @params) { # warn Dumper [$datetime, $id, \@params];
			my %h = (); # reset	
			# create hash of data:
			@h{@fields} = @params; # warn Dumper \%h;
		
			# add lab number (yy_nnnnn format):
			$results{$datetime} = \%h;
			
			$datetime = $id = undef; @params = (); # reset
		}    
	}
	return \%results;
}

#-------------------------------------------------------------------------------
sub data_file : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
    my $errs = shift;
  
    return $self->forbidden() unless $self->user_can('do_admin');
    return $self->tt_process('resources/new_data_file.tt', { error => $errs });
}

#-------------------------------------------------------------------------------
sub active_sessions : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
    
    # args = classname, optional hashref of args, optional with_objects:
    my @args = ('Session', { sort_by => 'time desc' }, 'user.user_location');
    my $all_sessions = $self->model('Base')->get_objects(@args);
	
    my $settings = $self->cfg('settings');
    
    my $timeouts = $self->get_yaml_file('idle_timeout'); # warn Dumper $timeouts;

	my @active_sessions = ();
	
	my @cgi_sess_cfg = (
		'driver:MySQL;serializer:'.$settings->{db_session_serializer},
        undef, # placeholder for session id,
        { Handle => $self->dbh },
        1, # THIS IS EXPERIMENTAL: pass a true value as the fourth parameter if
        # you want to skip the changing of access time. This isn't documented 
        # more formally, because it only called by find() [works OK in v4.43]
	);
	
    SESSION:
    for my $session (@$all_sessions) { 
        next unless $session->userid; # skip failed logins & not logged in yet

		$cgi_sess_cfg[1] = $session->id; # set session id
        my $sess = CGI::Session->load(@cgi_sess_cfg); # load() doesn't force new
            # warn Dumper [ $sess->atime, $sess->ctime, $sess->expire, time() ];

        my $user_location = $session->user->user_location->location_name;
        my $timeout # if user location in idle_timeout.yml, or default:
            = $timeouts->{$user_location} || $settings->{default_user_timeout};

        # push @active_sessions, $session
        #    unless $sess->is_expired; # no, this is CGI::Session timeout (24hrs)!
        if ( my $atime = $sess->atime ) { # to prevent unititialized val in subtraction err
            my $session_is_expired = ( time() - $atime > $timeout );
            # warn Dumper [ time() - $sess->atime, $timeout ];
			next SESSION if $session_is_expired; # warn Dumper $session->as_tree;

			my %data = (
				addr => $sess->remote_addr,
				user => $session->user,
                time => $session->time,
			); # warn Dumper \%data;
			
            push @active_sessions, \%data;
        }
	}
    $self->tt_params( sessions => \@active_sessions);
    
    { # callback for template to calculate duration:
        my $duration = sub {
            LIMS::Local::Utils::time_now->delta_ms(@_);
        };
        $self->tt_params( calculate_duration => $duration );
    }
    return $self->tt_process;
}

#-------------------------------------------------------------------------------
sub get_data_file : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

    return $self->forbidden() unless grep $self->user_can($_),
        qw(do_admin edit_pid); # edit_pid from referral_sources lookup page
    
    my $method = $self->query->param('method'); # warn $method;
    
    if ($method eq 'url') {
        return $self->data_file_from_url; # Role::DataFile
    }
    elsif ($method eq 'upload') {
        return $self->data_file_from_upload; # Role::DataFile
    }
    else {
        return $self->forward('data_file');
    }       
}

#-------------------------------------------------------------------------------
sub user_messages : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
    
    if ( my $recipient_id = $self->param('id') ) { # if passed from 'hello' page
        my $user = $self->model('User')->get_user_profile($recipient_id);
        $self->tt_params( recipient => $user );
    }
    else {
        my $profile = $self->user_profile;
        
        { # get any user-to-user messages:
            my $messages = $self->get_user_messages($profile->{id});
            $self->tt_params( user_messages => $messages );
        }
        { # get any admin-to-user messages: 
        	my $user_location = $profile->{user_location}->{location_name};
            my $messages = $self->get_admin_messages($user_location);
            $self->tt_params( admin_messages => $messages );
        }

        { # get list of users:
            my @sort_order = qw(user_location.location_name last_name first_name);
            my $args = { sort_by => \@sort_order }; # override default
            my $users = $self->model('User')->get_all_users($args);
            $self->tt_params( users => $users );
        }
    }
    return $self->tt_process;
}

#-------------------------------------------------------------------------------
sub new_message : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
    
    my $vars = $self->query->Vars();
    return $self->forward('user_messages')
        if grep { ! $vars->{$_}} qw(user_id message); # dfv overkill for 2 vars ??    
    
    my $rtn = $self->model('User')->new_user_message($vars);
    
    if ($rtn) {
        return $self->error($rtn);
    }
    else {
        $self->flash( info => $self->messages('user')->{msg_sent});
        return $self->redirect( $self->query->url . '/resources/user_messages' );
    }
}

#-------------------------------------------------------------------------------
sub new_diagnoses : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

    my $profile = $self->user_profile; # warn Dumper $profile;
    
    my $vars = $self->query->Vars(); # warn Dumper $vars;

	my $data = $self->new_and_relapsed_diagnoses($vars); # warn Dumper $data;

	my $locations = {}; # can be all locations, local network, single location, or none:
	
	if ( $self->is_lab_staff ) { # can view all locations
		$locations = $data->{locations_map};
	}
	elsif ( my $network_locations = $self->get_network_locations ) { # C::R::Resource
        $locations = $network_locations; # eg East Lancs network
    }
	elsif ( my $region_code = $profile->{user_location}->{region_code} ) { # warn $region_code;
		my $h = $data->{locations_map}; # delete all but users' location:
		( $h->{$_} eq $region_code ) or delete $h->{$_} for keys %$h; # works as it's a ref to hash
		$locations = $data->{locations_map}; # now should only have users' location 
	} # warn Dumper $locations; # may still be undef eg user location has no region code

    $self->tt_params(
        locations => $locations,
        results   => $data->{results},
    );   
    return $self->tt_process();
}

#-------------------------------------------------------------------------------
sub user_permissions : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);
	
	my $data = $self->model('User')->display_user_permissions; # warn Dumper $data;
	
    # need to get hash of function.id for unlock_actions (edit_pid, report, etc):
    my $unlock_actions = $self->cfg('unlock_actions');
    my $all_functions  = $self->model('User')->get_user_functions();
    
    # get hash of function_name => id for user_functions table:
    my %functions = map +( $_->function_name => $_->id ), @$all_functions;
        # warn Dumper \%functions;
    
    # take %functions hash slice into new hash:    
    my %unlock_actions_map = map +($_ => 1), @functions{@$unlock_actions};
        # warn Dumper \%unlock_actions_map;
    
	my %tt_params = (
        data            => $data,
        functions       => $self->user_functions_map,
        unlock_actions  => \%unlock_actions_map,
    );
	
	return $self->render_view('resources/user_permissions.tt', \%tt_params);	
}

# ------------------------------------------------------------------------------
sub process_status : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

	if ( my @pids = $self->query->param('pid') ) { # request to kill process
		`kill -9 $_` for @pids;	# warn Dumper \@pids; 
	}
	
	my $cmd = 'ps aux | grep -v grep | grep perl'; # gets pids in numerical order
	my @ps = `$cmd`; # warn Dumper \@ps;

    # get list of .pid files and their pid id:
    my $run_dir = $self->cfg('settings')->{run_dir};
    my %h = map +($_->getline => $_->filename),
        grep { $_->filename =~ /\w+\.pid$/ }
            io($run_dir)->all_files; # warn Dumper \%h;

	my @data;
    my $pid_owner = 'zombie'; # will apply to any pids < current fastcgi processes
	for (@ps) {
		# my ($user,$pid,$cpu,$mem_percent,$vmem,$rss,$start,$time,$cmd)
		#	= @fields[0..5,8..10]; 
		my @fields = split /\s+/; # warn Dumper \@fields;
		next unless $fields[-1] =~ /fcgi/; # cmd matches fcgi
		# reformat $vmem & $rss (underscore to assist legibility):
		$fields[$_] = _number_format($fields[$_]) for (4,5);
        { # add new process 'owner' - corresponds to perl-fcgi-pm process:
            no warnings 'uninitialized'; # only perl-fcgi-pm pid will be
            $pid_owner = $1 if $h{$fields[1]} =~ /(\w+)\.pid/;
        }
		push @data, [ @fields[0..5,8..10], $pid_owner ];
	}
	return $self->tt_process({ data => \@data, cmd => $cmd });
}

# ------------------------------------------------------------------------------
sub system_resources : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);
    # callback for CPU load:
    $self->tt_params( cpu => \&_cpu_data );
    return $self->tt_process();    
}

sub _cpu_data { # from webmin/proc/linux-lib.pl os_get_cpu_info()
    open my $src, '<' . '/proc/loadavg' || return 0;
    my @load = split /\s+/, <$src>;
    return @load[0..2];
}

sub _number_format { # www.perlmonks.org/?node_id=653
	local $_ = shift;
	1 while s/^(-?\d+)(\d{3})/$1_$2/;
	return $_;
}

1;
