package LIMS::Role::Base;
# provides shared methods for LIMS, and at least one other LIMS::Local class
use Moose::Role;
use Data::Dumper;
use Regexp::Common;
use Sort::Naturally;
# use LIMS::Local::Chart; # not in use
use LIMS::Local::Utils;
use Scalar::Util qw(weaken);
#-------------------------------------------------------------------------------
# supplies some callback methods (eg join_hash_values, symbolise) to templates
# called as: $self->render_view('some/template.tt', { foo => $foo, etc });
sub render_view {
my $self = shift;
my $tmpl = shift
|| return $self->error('no template name passed to render_view()');
my $args = shift || {}; # optional args for template
my $_self = $self; weaken $_self; # or get circular refs inside the callbacks
# so tmpl can supply a hash + keys to join
my $join_hash_values = sub {
my ($separator, $hash) = @_;
return join $separator, grep defined, @{ $hash }{ @_ };
};
# eg 10/9/L -> <sup>9</sup>, ul -> µ
my $symbolised = sub {
my $str = shift;
return LIMS::Local::Utils::symbolise($str);
};
my $line_break = sub {
my $str = shift;
$str =~ s/(\r\n)+/\n\n/g; # insert 2 line-breaks for FILTER html_line_break
return $str;
};
my $get_trial_number = sub {
# my ($patient_id, trial_id) = @_; just hand @_ direct:
my $trial_no
= $_self->model('ClinicalTrial')->get_trial_number(@_);
return $trial_no;
};
my $start_date = sub {
return $_self->model('Request')->get_first_request_date;
};
my $nsort = sub {
my $list = shift; # warn Dumper $list;
return Sort::Naturally::nsort(@$list);
};
my $has_mdt_contact = sub {
my $id = shift; # parent_organisation_id
return $_self->model('ReferralSource')->has_mdt_contact($id);
};
my $is_numerical = sub {
my $str = shift;
return $str =~ /\A$RE{num}{real}\Z/; # only matches int & decimal numbers
};
my $sig_figs = sub {
my $param = shift || return; # warn Dumper $param;
return LIMS::Local::Utils::sig_figs($param);
};
my $format_first_name = sub {
my $patient = shift;
return $_self->format_first_name($patient); # returns empty if no rule
};
my $calculated_age = sub {
LIMS::Local::Utils::calculate_age(@_);
};
my $composite_p53 = sub {
LIMS::Local::Utils::calculate_composite_p53(@_);
};
my $is_code_ref = sub { ref shift };
# NB: these accessors MUST NOT clash with existing ones:
$self->tt_params(
format_firstname => $format_first_name,
join_hash_values => $join_hash_values,
get_trial_number => $get_trial_number,
has_mdt_contact => $has_mdt_contact,
composite_p53 => $composite_p53,
calculate_age => $calculated_age,
natural_sort => $nsort,
is_code_ref => $is_code_ref,
is_numerical => $is_numerical,
start_date => $start_date,
line_break => $line_break,
symbolise => $symbolised,
sig_figs => $sig_figs,
);
return $self->tt_process($tmpl, $args);
}
sub model {
my $self = shift;
my $classname = shift
|| $self->error( 'Required classname attribute missing' );
# warn 'classname:'. $classname;
# return stashed package object if it exists:
if ( my $stashed = $self->stash->{"model::$classname"} ) {
# $self->debug("model::$classname IS in stash");
return $stashed;
}
my $package = "LIMS::Model::$classname";
# $self->debug("model::$classname NOT in stash");
# load package via require:
unless (eval "require $package") {
$self->error("Unable to load module [$package].");
}
my %args = (
_lims_db => $self->lims_db, # required by LIMS::Model::Base
_session => $self->session, # required by LIMS::Model::Roles::SessionData
);
# instantiate object
my $model = $package->new(%args)
|| $self->error("unable to instatiate [$package]."); # $self->debug("instatiated $package.");
$self->stash->{"model::$classname"} = $model;
return $model;
}
#-------------------------------------------------------------------------------
sub get_yaml_file {
my ($self, $filename) = @_; # warn $filename;
return $self->stash->{__yaml_file}->{$filename}
if $self->stash->{__yaml_file}->{$filename}; # in case called in a loop
my %args = (
yaml_dir => $self->cfg('settings')->{yaml_dir},
app_root => $self->cfg('path_to_app_root'),
filename => $filename,
);
my $yaml = LIMS::Local::Utils::get_yaml(\%args);
# stash in case we're called in loop (eg print_run, get_blood_tube_type):
$self->stash->{__yaml_file}->{$filename} = $yaml;
return $yaml;
}
#-------------------------------------------------------------------------------
sub time_now { shift->model('Base')->time_now() }
#-------------------------------------------------------------------------------
# uses firstname_format.yml to apply special formatting to first_name:
# shared by render_view() & ::Roles::Chart::plot_hiv()
sub format_first_name {
my ($self, $patient) = @_;
my $rules = $self->get_yaml_file('firstname_format') || return 0;
my $first_name = ref $patient eq 'HASH' # handles object ot hashref
? $patient->{first_name}
: $patient->first_name; # warn $first_name;
my $last_name = ref $patient eq 'HASH' # handles object ot hashref
? $patient->{last_name}
: $patient->last_name; # warn $last_name;
for (@$rules) {
# regex, which attr (lname or fname) to apply regex to, format to apply:
my ($regex, $apply_to, $format) = @$_;
# warn Dumper [$regex, $apply_to, $format];
if (
( $apply_to eq 'first_name' && $first_name =~ qr/\A($regex)\Z/ ) ||
( $apply_to eq 'last_name' && $last_name =~ qr/\A($regex)\Z/ )
) { # warn 'here';
if ($format eq 'upper') { # warn 'here';
return uc $first_name; # can't do: $format($first_name) - error
}
}
}
# no rule so return empty:
return 0;
}
1;
