• Files
• Commits
• Log
• Graph
• Stats

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 -> &micro;
    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(@_);
    };
    
# 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_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;