package LIMS::Base;

use parent 'LIMS';

use strict;

use Data::Dumper;
use LIMS::Local::Utils;
use JavaScript::DataFormValidator;

#-------------------------------------------------------------------------------
# GLOBAL METHODS
#-------------------------------------------------------------------------------

# render_view(), get_yaml_file() & model() moved to LIMS::Role::Base

#-------------------------------------------------------------------------------
sub error {
    my ($self, $msg) = @_;

    # map { $self->debug("CALLER: $_") } ($package, $filename, $line);
    my ($package, $filename, $line) = caller;

    my $str = length $msg > 125 # width, array(ref) of args to wrap:
        ? LIMS::Local::Utils::text_wrap(120, [ "\n\t", "\t", $msg ])
        : $msg;

    my $time = LIMS::Local::Utils::time_now();

    $self->tt_params(
        package => $package,
        time    => $time,
        line    => $line,
        msg     => $str,
    );

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

#-------------------------------------------------------------------------------
# alternative to CAP::Flash - accepts args in same format as CAP::Flash, but
# uses CAP::MessageStack instead:

#===============================================================================
# => !!! MUST INSTALL YAML::Syck IF USING CGI::Session::Serialize::yaml <= !!!!!
#===============================================================================

sub flash { # warn 'here'; warn Dumper caller();
    my $self = shift;
    my ($type, $msg, $scope) = @_; # warn Dumper [ $type, $msg, $scope ];
	# !!!! YAML serializer can't handle leading hyphens - need YAML::Syck !!!!
    $self->push_message(
        -message => $msg,
        -classification => $type,
        -scope => $scope,
    );
}

#-------------------------------------------------------------------------------
sub get_meta_data {
	my $self  = shift;
	my $class = shift; # warn $class;

	unless ( $self->stash->{meta_data}->{$class} ) { # warn 'here'; # should only be once per class
		my $meta_data = $self->model('Base')->get_meta_data($class);
		$self->stash->{meta_data}->{$class} = $meta_data;
	}
	return $self->stash->{meta_data}->{$class};
}

#-------------------------------------------------------------------------------
# uses CGI::Pager; accepts $args hashref (query_args and total_count);
# makes cgi_pager object available to template and adds limit & offset params
# to query_args; returns nothing
sub pager {
    my $self = shift;
    my $args = shift; # hashref of query_args and total count

    my $args_for_query = $args->{query};
    my $total_count    = $args->{total};

	my $entries_per_page = # config settings; can be overriden from form:
        $self->query->param('entries_per_page') ||
            $self->cfg('settings')->{entries_per_page} || 10;

    my $pager = CGI::Pager->new(
        page_len    => $entries_per_page, # default = 20
        total_count => $total_count,
    );

    $self->tt_params( cgi_pager => $pager ); # $self->debug($pager);

    # add limit & offset params to args_for_query hashref:
    $args_for_query->{limit}  = $entries_per_page;
    $args_for_query->{offset} = $self->query->param('offset') || 0;
}

#-------------------------------------------------------------------------------
# returns requested Data::FormValidator profile from LIMS::Validate
sub validate {
    my $self = shift;
    my $profile_name = shift || return; # warn $profile_name;

	my $profile = $self->_get_validation_profile($profile_name);

    # return $profile if not a hashref (eg arrayref for FV::Simple or coderef):
    return $profile unless ref $profile eq 'HASH';

	# remove 'ajax_methods' keys from hashref:
	my @keys = grep $_ ne 'ajax_methods', keys %$profile; # warn Dumper \@keys;
	my %dfv_profile = map {	$_ => $profile->{$_} } @keys; # warn Dumper \%dfv_profile;
    return \%dfv_profile;
}

#-------------------------------------------------------------------------------
# called from template with profile name to generate rules for jquery validation:
# if used, need to load jquery.validate.js and
# $(document).ready(function() { $("#id").validate({ rules: { } })
sub jquery_validation_profile {
    my $self    = shift;
    my $profile_name = shift || return; # name of DFV profile to retrieve from $self->validate

	my $profile = $self->_get_validation_profile($profile_name);

	my $ajax_methods = $profile->{ajax_methods};
	my $required = $profile->{required};

	my $app_url = $self->query->url;
	my @rules;

	push @rules, ( qq!$_: "required"! ) for @$required;
	push @rules, ( qq!$_: { remote: "$app_url/ajax/$ajax_methods->{$_}" }! )
		for keys %$ajax_methods; # warn Dumper \@rules;
    return \@rules;
}

#-------------------------------------------------------------------------------
sub validation_models {
	my $self = shift; # warn 'creating validation_models'; # should only be called once

    my $_self = $self; weaken $_self; # or get circular refs inside the callbacks

    # validation models all return 1 if param being validated should 'pass':
	my %validation_models = (
		validate_request_number => sub {
			my $request_number = shift;
			return $_self->model('Request')->get_requests_count($request_number);
		},
		validate_specimen => sub {
			my $specimen = shift; # warn $specimen;
			return $_self->model('Specimen')->validate_specimen($specimen);
		},
        # can have non-unique test_names, but not with same lab_section_id:
#        validate_lab_test => sub {
#            my $data = shift;
#            return $_self->model('LabTest')->check_lab_test_unique($data);
#        },
        # check form field param is unique, or belongs to current record under edit:
        validate_param_ownership => sub {
            my $args = shift; # warn Dumper $args;
            return $_self->model('Validation')->validate_param_ownership($args);
        },
        # just need to check nhs_number not already in use:
        validate_nhs_number_unique => sub {
            my $nhs_no = shift;
            return $_self->model('Patient')->check_patient_nhs_number_count($nhs_no);
        },
        # check storage vial ID is unique:
        has_unique_storage_vialId => sub {
            my $id = shift; # return false if entry already exists:
            return $_self->model('Validation')->has_storage_vialId($id) ? 0 : 1;
        },
		# how many lab_tests:
		get_lab_tests_count => sub {
            return $_self->model('Base')->get_objects_count('LabTest');
        },
		# hmrn_treatment_types:
		hmrn_treatment_types => sub {
            return $_self->model('HMRN')->get_tx_type_map;
        },
        # hmrn_param_constraints:
        hmrn_param_constraints => sub {
            return $_self->model('HMRN')->get_parameter_constraints;
        },
        # get meta data:
        get_meta => sub { $_self->get_meta_data(@_) }
	);

	return \%validation_models;
}

#-------------------------------------------------------------------------------
# sets tmpl vars & returns FormValidator::Simple::check result against supplied profile:
sub form_validator {
    my $self    = shift;
    my $profile = shift; # arrayref

    my $result = FormValidator::Simple->check( $self->query => $profile );

    $self->tt_params( form_validator => $result );

    return $result;
}

#-------------------------------------------------------------------------------
# put requested JavaScript::DataFormValidator profile into tt_params
# profile_name required - provides name for tmpl accessor and name of validation
# profile to load (if not supplied direct)
sub js_validation_profile {
    my $self = shift;
    my $profile_name = shift; # name of DFV profile to retrieve from $self->validate
    my $dfv_profile  = shift; # optional; only C::Report::outreach() supplies it direct

    # get dfv validation profile from validate() if not supplied:
    if (! $dfv_profile) {
        $dfv_profile = $self->validate($profile_name)
            or die "cannot find validation profile for '$profile_name'";
    }

    # grep methods compatible with JS::DFV:
    my %js_compatible_profile = map {
        $_ => $dfv_profile->{$_},
    } grep $dfv_profile->{$_}, (
        # only include methods supported in FormValidator.js v0.06 (not contraint_methods,
        # or contrainsts: named closures, sub-routine references or compiled regex):
        'required',
        'optional',
        'dependencies',
        'dependency_groups',
        'constraints',
        'msgs',
    );

    # create js_validation_profile for template:
     $self->tt_params(
        # Javascript snippet for <form> tag to call check_and_report()
        $profile_name . '_onsubmit' => js_dfv_onsubmit($profile_name),
        # js representation of Perl DFV validation profile:
        $profile_name . '_dfv_js' => js_dfv_profile($profile_name => \%js_compatible_profile),
    );
}

#-------------------------------------------------------------------------------
# returns the requested lims_messages.pl profile
sub messages {
    my $self  = shift;
    my $msg = shift || return;

    return $self->cfg('msg')->{$msg};
}

#-------------------------------------------------------------------------------
# authorisation method for runmodes; also used by CAP::Authorization for
# handling package-wide authorisation ie __PACKAGE__->authz->authz_runmodes()
# params: Str user_can('function') match this function returns true
#       : arrayref [Str] user_can(['f1', 'f2'])
#       match any of these functions returns true
sub user_can {
    my ($self, $action) = @_; # $action can be scalar or array(ref)

    my $allowed_functions # retrieve from stash, or from session then stash it:
        = $self->stash->{allowed_functions} || $self->_get_allowed_functions();

    # returns true if $action exists in users 'functions' profile:
	if ( ref $action eq 'ARRAY' ) {
		foreach my $func(@$action) { # warn $func;
			return 1 if ( grep $func eq $_, @$allowed_functions );
		}
		return 0;
	}
	else {
		return ( grep $action eq $_, @$allowed_functions );
	}
}

#-------------------------------------------------------------------------------
# shared by C::Request::unlock_request() & request_links.tt
sub has_unlock_permission {
    my $self = shift;

    # user permissions that allow request unlocking:
    my $actions = $self->cfg('unlock_actions'); # warn Dumper $actions; # arrayref
	return $self->user_can($actions);
}

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

    my $profile = $self->authen->store->fetch('yooza_profile'); # $self->debug($profile);
    my $user_location = $profile->{user_location}->{location_name} || return 0; # if not logged in;

    if ( my $central_labs = $self->cfg('settings')->{central_labs} ) { # genomics
        return 1 if $central_labs eq 'all_locations'; # genomics
        my @labs = split ',', $central_labs; # warn Dumper \@labs;
        return ( grep $user_location eq $_, @labs );
    }
    my $lab_name = $self->cfg('settings')->{lab_name_abbreviation};
    return ( $user_location eq $lab_name ); # returns truth
}

#-------------------------------------------------------------------------------
sub html_link {
    my $self = shift;
    my ($href, $title, $class) = @_; # $class is optional

    my $q = $self->query;

    return $q->a({ href => $href, class => $class || 'normal' } , $title);
}

#-------------------------------------------------------------------------------
# returns 'forbidden action' page:
sub forbidden {
    my $self = shift;
    return $self->tt_process('site/forbidden_action.tt');
}

#-------------------------------------------------------------------------------
# CAP::Redirect functionality, without eval block which doesn't play nice with
# $SIG{__DIE__} handler in LIMS::Local::ErrorHandler (see README)
sub redirect {
    my $self     = shift;
    my $location = shift;
    my $status   = shift;

    if ($status) {
        $self->header_add( -location => $location, -status => $status );
    }
	else {
        $self->header_add( -location => $location );
    }
    $self->header_type('redirect');
}

#-------------------------------------------------------------------------------
# accepts debug 'params' as 1st (scalar) arg, then optional log level
# (defaults to 0 - debug)
sub debug {
    my $self   = shift;
    my $params = shift; #  warn 'params:'. Dumper $params;
    my $level  = shift || 0; #  warn 'level:'. Dumper $level; # optional arg

    # don't want mod_perl, fast_cgi or t/*.t output unless specifically requested:
    return undef if ( # return undef for use with .tt in fastcgi (otherwise get 0 displayed)
		( grep $ENV{$_}, qw/MOD_PERL FAST_CGI HARNESS_ACTIVE/ )
		&& ! $ENV{DEBUG_ON}
	);

    my $level_name # 0     1     2      3      4       5      6       7
            = [ qw(debug info notice warning error critical alert emergency) ];
    my $log_level = $level_name->[$level] || 'debug';

    my $message =
		ref $params           ?
            Dumper( $params ) :
            $params . "\n"    ; # Log::Dispatch doesn't observe append_new_line switch
            # warn Dumper [$log_level,$message];

    # $self->log->$log_level($message); # CAP::LogDispatch method
    $self->log_dispatch->$log_level($message); # LIMS::Local::LogDispatch method
}

sub current_rm { shift->get_current_runmode }

#-------------------------------------------------------------------------------
sub _get_validation_profile {
	my $self = shift;
    my $profile_name = shift || return; # DEBUG $profile;

	unless ($self->stash->{validator}) {
		my $validator = LIMS::Validate->new(
			models   => $self->validation_models,
			messages => $self->cfg('msg')->{dfv_msgs},
			settings => $self->cfg('settings'),
		);
		$self->stash(validator => $validator);
	}

	return $self->stash->{validator}->$profile_name;
}

#-------------------------------------------------------------------------------
# if 1st call to user_can():
sub _get_allowed_functions { # warn 'here'; # should ony happen once per request
    my $self = shift;

	# $user_profile will be empty if method called after logout (so return):
	my $user_profile = $self->session->param('UserProfile') || return;

    $self->stash( allowed_functions => $user_profile->{functions} );

    return $user_profile->{functions};
}

1;

__END__

#-------------------------------------------------------------------------------
# UNUSED GLOBAL METHODS
#-------------------------------------------------------------------------------

=begin
# alternative to CAP::Flash
sub _flash {
    my $self   = shift; # $self->debug(@_);
    my $method = shift || 'set'; # warn 'METHOD:'.$method;

    # can only return stashed object for setting: no - see below:
    unless ($method eq 'get') {
        return $self->stash->{flash} if $self->stash->{flash}; # prevents message removal from session
    }

    # can't stash object or get "DESTROY created new reference to dead object 'CGI::Session::Flash'
    # during global destruction."
    my $flash = # $self->stash->{flash} =
        CGI::Session::Flash->new($self->session);

    return $flash;
}

# uses Data::Page:
sub _pager {
    my $self  = shift;
    my $total = shift; # total count

	my $entries_per_page = $self->cfg('settings')->{entries_per_page} || 10;
	my $current_page     = $self->query->param('page') || 1;

    my $page = Data::Page->new(); # constructor takes no args

    $page->entries_per_page( $entries_per_page );
    $page->current_page( $current_page );
    $page->total_entries( $total );

    return $page;
}

# uses LIMS::Local::LogDispatch
sub _dispatcher {
    my $self = shift; # return;
    my %args = @_; # warn Dumper \%args;

    my $dispatcher = $self->log_dispatch; # LIMS::Local::LogDispatch

    $dispatcher->log(%args);
}
=cut