package LIMS::Controller::Chart;

use Moose;
BEGIN { extends 'LIMS::Base'; }
with 'LIMS::Controller::Roles::Chart'; # contains ChartDirector chart methods
has chart_data => (
    is      => 'ro',
    isa     => 'ArrayRef',
    traits  => ['Array'],
    default => sub { [ ] },
    handles => {
        add_chart_data => 'push',
    },
);
use namespace::clean -except => 'meta';
__PACKAGE__->meta->make_immutable(inline_constructor => 0);

use Scalar::Util qw(looks_like_number);
use Regexp::Common qw(number);
use LIMS::Local::Utils;
use Data::Dumper;

use lib '/home/raj/perl-lib/ChartDirector/lib';
use perlchartdir; # perlchartdir::setLicenseCode(); # or use chartdir.lic

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

    # redirect to /resources:
    return $self->redirect( $self->query->url . '/resources' );
}

# ------------------------------------------------------------------------------
# just returns template, where name = param('id'):
sub load : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

    my $template_name = $self->param('id')
    || $self->error( 'no template name passed to ' . $self->get_current_runmode );

    { # make some useful dates available to templates:
        $self->tt_params(
            start_date => $self->model('Request')->get_first_request_date(),
        );
    }

    my $template = 'chart/' . $template_name . '.tt';

    $self->render_view($template);
}

# ------------------------------------------------------------------------------
# target for /chart/process/<target_rm>/<chart_type> eg /chart/process/diagnoses/pie
sub process : Runmode {
    my $self = shift; my $rm = $self->get_current_runmode; $self->_debug_path($rm);

    # get target method (eg diagnoses):
    my $target = $self->param('id') || $self->stash->{chart_method}
    || return $self->error( 'no target passed to ' . $rm );

    # check it exists:
    unless ( $self->can($target) ) {
        return $self->error( "cannot find method for $target" );
    }

    # get chart_type from 2nd token in $self->param
    my $chart_type = $self->param('Id') || $self->stash->{chart_type}
    || return $self->error( 'no chart type passed to ' . $rm );

    # check it exists:
    unless ( $self->can($chart_type) ) {
        return $self->error( "cannot find method for $chart_type" );
    }

    # create chart object in required method eg $self->diagnoses('pie_chart'):
    my $chart_obj = $self->$target($chart_type)
    || return $self->cleardot(); # or will get errors trying to parse non-existant data

    # send to finalise_chart() to add title (if required) & run makeChart2():
    my $chart = $self->make_chart($chart_obj);

    # set header & return chart:
    $self->header_add(-type => 'image/png', -expires => 'now');
    return $chart;
}

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

    # set header for png image:
    $self->header_add(type => 'image/png', -expires => 'now');

    my %args = (
        lab_section => 'Flow cytometry',
        test_name   => 'immunology',
    );

    my $data = $self->_get_param_monitoring_data(\%args)
    || return $self->cleardot();

    # make captures non-greedy in case result entered without e-o-l markers (req #97709):
    # see ~/scripts/hiv_regex.pl for validation
    my $RE_cd4pos8neg = q!CD4\+8\- T-cells = (.*?) cells per microlitre!;
    my $RE_cd4pos8pos = q!CD4\+8\+ T-cells = (.*?) cells per microlitre!;
    my $RE_cd4pos     = q!CD4\+ = (.*?)/uL!; # legacy (not always consistent)

    RESULT:
    for (@$data) { # AoH
        my $result = $_->{result};
        my @date = split '-', $_->{date}; # split into components for chartTime()

        my ($CD4pos)       = $result =~ /$RE_cd4pos/io;
        my ($CD4posCD8neg) = $result =~ /$RE_cd4pos8neg/o;
        my ($CD4posCD8pos) = $result =~ /$RE_cd4pos8pos/o;

        my @vars = ( $CD4pos, $CD4posCD8neg, $CD4posCD8pos );
        map { # ensure each value not undef & remove any commas:
            $_ ||= 0;
            $_ =~ s/,//; # eg 1,234
        } @vars; # warn Dumper \@vars;

        { # check all vars numerical, or set $NoValue + warning & skip to next result:
            my %args = ( vars => \@vars, date => \@date ); # date required for chartdata
            $self->check_numeric(\%args) || next RESULT; # returns 'true' if so
        }

        my $CD4_total = LIMS::Local::Utils::sum_list(\@vars); # warn $CD4_total;
        next RESULT unless $CD4_total;

        # add CD4 count & transformed date values:
        $self->add_chart_data( [$CD4_total, perlchartdir::chartTime(@date)] );
    } # warn Dumper \@chart_data;

    # stash data for Roles::Chart::_get_chart_data():
    $self->stash(
        chart_data  => $self->chart_data,
        chart_title => undef, # don't need one
    );

    my $chart_obj = $self->plot_hiv();

    # send to finalise_chart() to add title (if required) & run makeChart2():
    my $chart = $self->make_chart($chart_obj);
    return $chart;
}

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

    # set header for png image:
    $self->header_add(type => 'image/png', -expires => 'now');

    my %args = (
        lab_section => 'Flow cytometry',
        test_name   => { rlike => '^pnh' },
    );

    my $data = $self->_get_param_monitoring_data(\%args)
    || return $self->cleardot(); # warn Dumper $data;

    # integers & decimals:
    my $re = qr(\d+|\d+\.\d+|\d+\.|\.\d+); # eg 100 | 99.99 | 90. | .1

    # RfC464 (09/2018) redefined PNH result summary format:
    # RfC496 (01/2019) allowed '<' signs (ignored) for all non-neutrophil cell-types
    my $expr = qr!GPI-anchor deficient population \(PNH clone\) = ($re)% in !
    . qr!neutrophils, <?($re)% in monocytes(?:\,| and) <?($re)% in erythrocytes !
    . qr!\(<?($re)% type II cells and <?($re)% type III cells\)!; # p $expr;

    # retics optional:
    my $retics_str = qr!and <?($re)% in reticulocytes \(<?($re)% type II !
    . qr!cells and <?($re)% type III cells\)!;

    my @common = qw( granulocyte monocyte erythrocyte rbc_type2 rbc_type3 );
    my @retics = qw( reticulocyte retic_type2 retic_type3 ); # optional

    my @chart_data; # create AoA:
    RESULT:
    for (@$data) { # AoH
        my $result = $_->{result}; # warn Dumper $result;
        my @date = split '-', $_->{date}; # split into components for chartTime()

        my %h = (); # reset
        if ( $result =~ /^$expr/ ) { # >= 09/2018 format
            @h{@common} = ($1,$2,$3,$4,$5);
            # optional retics:
            if ( $result =~ /$retics_str/ ) {
                @h{@retics} = ($1,$2,$3);
            }
        }
        elsif ( $result =~ /^Granulocyte PNH clone/ ) { # <= 09/2018 format
            ($h{granulocyte}) = $result =~ /Granulocyte PNH clone = ($re)%/;
            ($h{erythrocyte}) = $result =~ /Red cell PNH clone = ($re)%/;
            ($h{monocyte})    = $result =~ /Monocyte PNH clone = ($re)%/;
            ($h{rbc_type2}, $h{rbc_type3}) =
                $result =~ /($re)% type II cells and ($re)% type III cells/;
        } # warn Dumper [\@date, \%h];

        my @vals = @h{@common,@retics}; # warn Dumper \@vals; # deref'd in plot_pnh()
        # skip unless have at least 1 result:
        next RESULT unless grep { defined $_ } @vals;
        push @chart_data, [ \@vals, perlchartdir::chartTime(@date) ];
    } # warn Dumper \@chart_data;
    # check we have some data to plot (results may have failed regexes):
    @chart_data || return $self->cleardot();

    # stash data for Roles::Chart::_get_chart_data():
    $self->stash(
        pnh_params  => [ @common, @retics ], # to retain param order for Role::Chart method
        chart_data  => \@chart_data,
        chart_title => undef, # don't need one
    );

    my $chart_obj = $self->plot_pnh();

    # send to finalise_chart() to add title (if required) & run makeChart2():
    my $chart = $self->make_chart($chart_obj);
    return $chart;
}

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

    my $section   = $self->param('id');
    my $test_diag = $self->param('Id'); # tp53_cll, myc_dlbcl, etc

    my $yml = $self->get_yaml_file('trend_analysis'); # warn Dumper $yml;
    # check section:test_diag exists (as it must do as yml used for .tt):
    my $cfg = $yml->{$section}->{$test_diag}
        or return $self->error("unknown config entry $section:$test_diag"); # warn Dumper $cfg;

    { # create & stash data for chart:
        my %h = ( chart_titles => $cfg->{chart} ); # yAxis labels, etc
        # add chart_data
        my $data = $self->model('Audit')->trend_analysis($cfg);
        $h{chart_data} = $data; # warn Dumper \%h;
        # stash title, data & y_axis_labels for create_chart():
        $self->stash(%h);
    }

    my $chart_obj = $self->plot_trend_analysis();

    # send to finalise_chart() to add title (if required) & run makeChart2():
    my $chart = $self->make_chart($chart_obj);
    # set header for png image:
    $self->header_add(type => 'image/png', -expires => 'now');
    return $chart;
}

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

    # params to draw on chart:
    my @params = qw(hb wbc plts creatinine);
    return $self->outreach(\@params);
}

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

    # params to draw on chart:
    my @params = qw(paraprotein abnormal_b_cells);
    return $self->outreach(\@params);
}

# ------------------------------------------------------------------------------
sub outreach { # shared with outreach_common() & outreach_others()
    my ($self, $params) = @_; $self->_debug_path(); # arrayref of params

    # set header for png image:
    $self->header_add(type => 'image/png', -expires => 'now');

    my $patient_id = $self->param('id');

    my @fields = @$params; # for calculation of abnormal B cells:
    if ( grep $_ eq 'abnormal_b_cells', @$params ) {
        push @fields, qw(total_b_cells wbc neoplastic_b_cells);
    } # warn Dumper \@fields;

    # get all request results for this patient:
    my $data = $self->model('Outreach')->get_chart_results($patient_id, \@fields);

    { # don't plot chart unless at least 2 datasets:
        my %dates;
        map {
            my $date = DateTime::Format::MySQL->parse_datetime($_->{created_at});
            $dates{$date->dmy}++;
        } @$data; # warn Dumper \%dates;
        return $self->cleardot unless keys %dates > 1;
    }

    # create interim hash where keys = epoch seconds, vals = hashref of results:
    my %results = ();
    for (@$data) { # warn Dumper $_;
        my $result = $_->{result};
        my $param  = $_->{param_name};
        my $date   = $_->{created_at};

        my $epoch = LIMS::Local::Utils::to_datetime_using_parsedate($date)->epoch;
        $results{$epoch}{$param} = $result;
    } # warn Dumper \%results;

    # create dataset for chart function:
    my @chart_data = ();
    for my $r ( sort keys %results ) { # $r = epoch seconds of requests.created_at
        my $data = $results{$r}; # results hashref for request
        if ( grep $_ eq 'abnormal_b_cells', @$params ) { # get calculate vals:
            my $calculated_vals # calculate abnormal B cells from @b_cell param results:
                = $self->model('Outreach')->calculate_flow_params($data);
            $data->{abnormal_b_cells} = $calculated_vals->{neoplastic_b_cells};
        }
        my @results = map $data->{$_}, @$params; # array of results for @params

        # convert epoch back to DT for perlchartdir::chartTime(@date):
        my $dt = DateTime->from_epoch( epoch => $r );
        my @date = ($dt->year, $dt->month, $dt->day);

        push @chart_data, [ \@results, perlchartdir::chartTime(@date) ];
    } # warn Dumper \@chart_data;

    # stash data for Roles::Chart::_get_chart_data():
    $self->stash(
        chart_data  => \@chart_data,
        chart_title => undef, # don't need one
    );

    my $chart_obj = $self->plot_outreach($params);

    # send to finalise_chart() to add title (if required) & run makeChart2():
    my $chart = $self->make_chart($chart_obj);
    return $chart;
}

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

    # set header for png image:
    $self->header_add(type => 'image/png', -expires => 'now');

    my $param = $self->param('id');
    my $patient_id = $self->param('Id');

    my $data = $self->model('Outreach')->get_chart_results($patient_id, $param);
    my $lab_param = $self->model('Outreach')->get_lab_param($param);

    my @chart_data; # warn Dumper $data;

    for (@$data) { # warn Dumper $_;
        my $result = $_->{result};
        my $date   = $_->{created_at};

        my $dt = LIMS::Local::Utils::to_datetime_using_parsedate($date);
        my @date = ($dt->year, $dt->month, $dt->day); # warn Dumper \@date;

        push @chart_data, [ $result, perlchartdir::chartTime(@date) ];
    }

    my $patient = $self->model('Patient')->get_patient($patient_id);
    my $title = sprintf '%s %s :: %s', ucfirst $patient->first_name,
        uc $patient->last_name, $lab_param->field_label;

    # stash data for Roles::Chart::_get_chart_data():
    $self->stash(
        chart_data  => \@chart_data,
        chart_title => $title,
    );
    $self->stash(dynamic_adjust => 1) if $self->query->param('dynamic_adjust'); # vary chart dimersions

    my $chart_obj = $self->plot_outreach_param();

    # send to finalise_chart() to add title (if required) & run makeChart2():
    my $chart = $self->make_chart($chart_obj);
    return $chart;
}

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

    # set header for png image:
    $self->header_add(type => 'image/png', -expires => 'now');

    my %args = (
        lab_section => 'Molecular',
        test_name   => [ # all the various test names associated with CHIM:
            qw( chimerism chimerism_chim cd15_chimerism cd3_chimerism ) # not WBC
        ],
    );

    my $data = $self->_get_param_monitoring_data(\%args)
    || return $self->cleardot();

    # params to draw on chart:
    my @params = qw(cd3 cd4 cd8 cd15 wbc);

    my %seen; # ensure no duplicates due to multiple tests replacing CHIM panel

    my @chart_data; # create AoA:
    RESULT:
    for (@$data) { # AoH
        my $date = $_->{date};
        next RESULT if $seen{$date}; $seen{$date}++;

        my @date = split '-', $date; # split into components for chartTime()

        my $result = $_->{result};
        my ($cd3)  = $result =~ /CD3 donor chimerism = (\d+)/i;
        my ($cd4)  = $result =~ /CD4 donor chimerism = (\d+)/i;
        my ($cd8)  = $result =~ /CD8 donor chimerism = (\d+)/i;
        my ($wbc)  = $result =~ /WBC donor chimerism = (\d+)/i;
        my ($cd15) = $result =~ /CD15 donor chimerism = (\d+)/i;

        # skip all requests until start of data entry (at least one defined param):
        # inclusion of @chart here means null datasets are used, even if last one
        next RESULT unless @chart_data || $cd3 || $cd4 || $cd8 || $cd15 || $wbc;

        my $results = [ $cd3, $cd4, $cd8, $cd15, $wbc ]; # deref'd in plot_chimerism()
        push @chart_data, [ $results, perlchartdir::chartTime(@date) ];
    } # warn Dumper \@chart_data;

	# check dataset sufficient to plot graph:
    return $self->cleardot() unless scalar @chart_data > 1;

    # stash data for Roles::Chart::_get_chart_data():
    $self->stash(
        chart_data  => \@chart_data,
        chart_title => undef, # don't need one
    );

    my $chart_obj = $self->plot_chimerism(\@params);

    # send to finalise_chart() to add title (if required) & run makeChart2():
    my $chart = $self->make_chart($chart_obj);
    return $chart;
}

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

    # set header for png image:
    $self->header_add(type => 'image/png', -expires => 'now');

    my %args = (
        lab_section => 'Molecular',
        test_name   => 'rq_cml',
    );

    my $data = $self->_get_param_monitoring_data(\%args)
    || return $self->cleardot(); # warn Dumper $data;

    my @chart_data; # create AoA:
    RESULT:
    for (@$data) { # AoH
        my $result = $_->{result};
        my @date = split '-', $_->{date}; # split into components for chartTime()

        my ($transcription_number) = $result =~ /transcription number = (\d+)/;
        my ($ratio)                = $result =~ /BCR-ABL : ABL ratio = (.*)%/;

        # skip unless ratio result captured:
        next RESULT unless $ratio; # warn Dumper $ratio;

        # convert any 'less-than' result into real number:
        if ($ratio =~ /\A<(.*)/) {
            # set $transcription_number to zero (if not already):
            $transcription_number = 0; # changes plot symbol
            $ratio = $1; # remove leading '<'
        }
        # skip if still not 'real' number (ie integer or decimal):
        elsif ( $ratio !~ /\A$RE{num}{real}\Z/ ) { # warn $ratio;
            # $ratio = $perlchartdir::NoValue; # probably 'see comment' or 'failed'
            next RESULT; # so skip
        }

        # set point_type (depends whether transcription_number > 0):
        my $point_type = $transcription_number ? 1 : 0;

        # add ratio, transformed date values, and point_type:
        push @chart_data, [ $ratio, perlchartdir::chartTime(@date), $point_type ];
    } # warn Dumper \@chart_data;

	# check dataset sufficient to plot graph:
	return $self->cleardot() unless scalar @chart_data > 1;

    # stash data for Roles::Chart::_get_chart_data():
    $self->stash(
        chart_data  => \@chart_data,
        chart_title => undef, # don't need one
    );
    $self->stash(small => 1) if $self->query->param('outreach'); # reduce size of outreach plot

    my $chart_obj = $self->plot_imatinib();

    # send to finalise_chart() to add title (if required) & run makeChart2():
    my $chart = $self->make_chart($chart_obj);
    return $chart;
}

# ------------------------------------------------------------------------------
sub specimen_turnround : Runmode {
    my $self = shift;

    # set header for png image:
    $self->header_add(type => 'image/png', -expires => 'now');

    my $specimen = $self->param('id'); # warn $specimen

    # get data & stats from session:
    my $session = $self->session->dataref->{_turnaround_chart};

    my $title = sprintf '%s [%s]', $specimen, $session->{chart_title}; # warn Dumper $title;
    my $data  = $session->{chart_data};  # warn Dumper $data;
    my $stats = $session->{chart_stats}; # warn Dumper $stats;

    # require every x-axis val from 0 to max to get 95th percentile line consistent:
    $data->{$_} ||= 0 for ( 0 .. $stats->{max} ); # so chart doesn't skip empties

    my @chart_data = map { [ $data->{$_}, $_ ] }
        sort { $a <=> $b } keys %$data; # warn Dumper \@chart_data;

    # stash title, data & y_axis_label for create_chart():
    $self->stash(
        chart_title  => $title,
        chart_data   => \@chart_data,
    );

    my $chart_obj = $self->plot_specimen_turnround($stats);

    # send to finalise_chart() to add title (if required) & run makeChart2():
    my $chart = $self->make_chart($chart_obj);
    return $chart;
}

# ------------------------------------------------------------------------------
sub user_workload : Runmode {
    my ($self, $chart_type) = @_;

    my $action = $self->query->param('action'); # warn $action;

    my $data = $self->session->dataref->{_user_workload_data}; # warn Dumper $data;
    my $stats = $data->{$action} || return $self->cleardot(); # warn Dumper $stats;

    my @vals = values %$stats;
    my $total = LIMS::Local::Utils::sum_list(\@vals); # warn $total;

    my $sf = sub { LIMS::Local::Utils::sig_figs(@_) };

    my @ary; # chart needs AoA, sort by numerical values:
    foreach my $key ( sort { $stats->{$a} <=> $stats->{$b} } keys %$stats ) { # warn Dumper $key;
        my $result = &$sf( 100 * $stats->{$key} / $total ); # percent to x sigfigs
        push @ary,  [ $result, uc $key ];
    }
    # stash title, data & y_axis_label for create_chart():
    $self->stash(
        chart_title  => undef,
        chart_data   => \@ary,
        y_axis_label => '% of total ' . $action,
    );

    my $chart = $self->$chart_type();
    return $chart;
}

# ------------------------------------------------------------------------------
sub resource_meter : Runmode {
    my ($self, $chart_type) = @_; $self->_debug_path();

    my $vars = $self->query->Vars; # warn Dumper $vars;
    my $info = $self->_sysinfo($vars->{type}) # check return in case request for
    || return 0; # warn Dumper $info; # non-existant block (eg /data)

    # stash data for Roles::Chart::_get_chart_data():
    $self->stash(
        chart_data  => $info,
        chart_title => undef, # don't need one
    );

    my $chart = $self->$chart_type($vars);

    return $chart;
}

# ------------------------------------------------------------------------------
# receives chart object, adds title (if required) & runs makeChart2():
sub make_chart {
    my $self  = shift; $self->_debug_path();
    my $chart = shift || return $self->clear_dot(); # in case chart object failed

    # add a (optional) title to the chart:
    if ( my $title = $self->stash->{chart_title} ) {
        $chart->addTitle($title);
    }
    # display any error:
    if ( my $err = $self->stash->{chart_err} ) {
        $chart->addTitle2($perlchartdir::Center, $err, 'arial.ttf', 12, 0xff0000);
    }

    my $r;
    eval { # trap: Can't call method "makeChart2" without a package or object reference
        $r = $chart->makeChart2($perlchartdir::PNG);
    }; warn ref $chart if $@; # stderr: \t...caught at Chart.pm line 497 ???

    return $r;
}

# ------------------------------------------------------------------------------
sub diagnosis_status {
    my ($self, $chart_type) = @_; $self->_debug_path();

    # check input params are valid or return 0 (can't return err msg to chart function):
    my $vars = $self->_validate_input() || return 0;

    my ($data, $title) = $self->model('Chart')->get_diagnosis_status($vars); # $self->debug($data);
    # return 0 unless @$data; # doesn't cause problem if empty dataset

    # stash title & data for create_chart():
    $self->stash(
        chart_title => $title,
        chart_data  => $data,
    );

    my $chart = $self->$chart_type();

    return $chart;
}

# ------------------------------------------------------------------------------
sub diagnosis_frequency {
    my ($self, $chart_type) = @_; $self->_debug_path();

    # check input params are valid or return 0 (can't return err msg to chart function):
    my $vars = $self->_validate_input() || return 0;

    my ($data, $title) = $self->model('Chart')->get_diagnosis_frequency($vars); # $self->debug($data);
    return 0 unless @$data;

    # stash title & data for create_chart():
    $self->stash(
        chart_title => $title,
        chart_data  => $data,
    );

    my $chart = $self->$chart_type();

    return $chart;
}

# ------------------------------------------------------------------------------
sub specimen_frequency {
    my ($self, $chart_type) = @_; $self->_debug_path();

    # check input params are valid or return 0 (can't return err msg to chart function):
    my $vars = $self->_validate_input() || return 0;

    my ($data, $title) = $self->model('Chart')->get_specimen_frequency($vars); # $self->debug($data);
    return 0 unless @$data;

    # stash title & data for create_chart():
    $self->stash(
        chart_title => $title,
        chart_data  => $data,
    );

    my $chart = $self->$chart_type();

    return $chart;
}

# ------------------------------------------------------------------------------
sub new_diagnosis_frequency {
    my ($self, $chart_type) = @_; $self->_debug_path();

    # check input params are valid or return 0 (can't return err msg to chart function):
    my $vars = $self->_validate_input() || return 0;

    my ($data, $title) = $self->model('Chart')->get_new_diagnosis_frequency($vars); # $self->debug($data);
    return 0 unless @$data;

    # stash title & data for create_chart():
    $self->stash(
        chart_title => $title,
        chart_data  => $data,
    );

    my $chart = $self->$chart_type();

    return $chart;
}

# ------------------------------------------------------------------------------
sub presentation_frequency {
    my ($self, $chart_type) = @_; $self->_debug_path();

    # check input params are valid or return 0 (can't return err msg to chart function):
    my $vars = $self->_validate_input() || return 0;

    my ($data, $title) = $self->model('Chart')->get_presentation_frequency($vars); # $self->debug($data);
    return 0 unless @$data;

    # stash title & data for create_chart():
    $self->stash(
        chart_title => $title,
        chart_data  => $data,
    );

    my $chart = $self->$chart_type();

    return $chart;
}

# ------------------------------------------------------------------------------
sub requests_by_year {
    my ($self, $chart_type) = @_; $self->_debug_path();

    my $vars = $self->query->Vars(); # no input params to validate

    my ($data, $title) = $self->model('Chart')->requests_by_year($vars); # $self->debug($data);

    # stash title & data for create_chart():
    $self->stash(
        y_axis_label => 'requests',
        chart_title  => $title,
        chart_data   => $data,
    );

    my $chart = $self->$chart_type();

    return $chart;
}

# ------------------------------------------------------------------------------
sub requests_by_month {
    my ($self, $chart_type) = @_; $self->_debug_path();

    # check input params are valid or return 0 (can't return err msg to chart function):
    my $vars = $self->_validate_input() || return 0;

    my ($data, $title) = $self->model('Chart')->requests_by_month($vars); # $self->debug($data);
    return 0 unless @$data;

    # stash title & data for create_chart():
    $self->stash(
        y_axis_label => 'requests',
        chart_title  => $title,
        chart_data   => $data,
    );

    my $chart = $self->$chart_type();

    return $chart;
}

# ------------------------------------------------------------------------------
sub diagnosis_errors {
    my ($self, $chart_type) = @_; $self->_debug_path();

    # check input params are valid or return 0 (can't return err msg to chart function):
    my $vars = $self->_validate_input() || return 0;

    my ($data, $title) = $self->model('Chart')->diagnosis_errors($vars); # $self->debug($data);
    return 0 unless @$data;

    # stash title & data for create_chart():
    $self->stash(
        y_axis_label => 'requests',
        chart_title  => $title,
        chart_data   => $data,
    );

    my $chart = $self->$chart_type();

    return $chart;
}

# ------------------------------------------------------------------------------
sub specimens_by_year {
    my ($self, $chart_type) = @_; $self->_debug_path();

    my $vars = $self->query->Vars(); # no input params to validate

    my ($data, $title) = $self->model('Chart')->specimens_by_year($vars); # $self->debug($data);

    # stash title & data for create_chart():
    $self->stash(
        y_axis_label => 'specimens',
        chart_title  => $title,
        chart_data   => $data,
    );

    my $chart = $self->$chart_type();

    return $chart;
}

# ------------------------------------------------------------------------------
sub requests_by_day_of_week {
    my ($self, $chart_type) = @_; $self->_debug_path();

    # check input params are valid or return 0 (can't return err msg to chart function):
    my $vars = $self->_validate_input() || return 0;

    my ($data, $title) = $self->model('Chart')->requests_by_day_of_week($vars); # $self->debug($data);
    # return 0 unless @$data; # doesn't cause problem if empty dataset

    # stash title,data & y_axis_label (if required) for create_chart():
    $self->stash(
        y_axis_label => 'requests',
        chart_title  => $title,
        chart_data   => $data,
    );

    my $chart = $self->$chart_type();

    return $chart;
}

# ------------------------------------------------------------------------------
sub reports_by_day_of_week {
    my ($self, $chart_type) = @_; $self->_debug_path();

    # check input params are valid or return 0 (can't return err msg to chart function):
    my $vars = $self->_validate_input() || return 0;

    my ($data, $title) = $self->model('Chart')->reports_by_day_of_week($vars); # $self->debug($data);
    # return 0 unless @$data; # doesn't cause problem if empty dataset

    # stash title,data & y_axis_label (if required) for create_chart():
    $self->stash(
        y_axis_label => 'reports',
        chart_title  => $title,
        chart_data   => $data,
    );

    my $chart = $self->$chart_type();

    return $chart;
}

# ------------------------------------------------------------------------------
sub type_one {
    my $self = shift; $self->_debug_path();

    # The data for the pie chart
    my $data = [25, 18, 15, 12, 8, 30, 35];

    # The labels for the pie chart
    my $labels = [ qw(CML DLBCL AML MDS CMPD Myeloma ALL) ];

    # Create a PieChart object of size 360 x 300 pixels
    my $c = new PieChart(360, 300);

    # Set the center of the pie at (180, 140) and the radius to 100 pixels
    $c->setPieSize(180, 140, 100);

    # Add a title to the pie chart
    $c->addTitle('Diagnosis Frequency 2009');

    # Draw the pie in 3D
    $c->set3D();

    # Set the pie data and the pie labels
    $c->setData($data, $labels);

    # Explode the 1st sector (index = 0)
    $c->setExplode(0);

    return $c;
}

sub type_three {
    my $self = shift; $self->_debug_path();

    # The data for the pie chart
    my $data = [13, 16, 42];

    # The labels for the pie chart
    my $labels = [ qw(New Relapse FollowUp) ];

    # The colors to use for the sectors
    my $colors = [0x66ff66, 0xff6666, 0xffff00];

    # Create a PieChart object of size 300 x 300 pixels. Set the background to a gradient
    # color from blue (aaccff) to sky blue (ffffff), with a grey (888888) border. Use
    # rounded corners and soft drop shadow.
    my $c = new PieChart(300, 300);
    $c->setBackground($c->linearGradientColor(0, 0, 0, $c->getHeight() / 2, 0xaaccff,
        0xffffff), 0x888888);
    $c->setRoundedFrame();
    $c->setDropShadow();

    if ( $self->query->param('foo') ) {
    #============================================================
    #    Draw a pie chart where the label is on top of the pie
    #============================================================

        # Set the center of the pie at (150, 150) and the radius to 120 pixels
        $c->setPieSize(150, 150, 120);

        # Set the label position to -40 pixels from the perimeter of the pie (-ve means
        # label is inside the pie)
        $c->setLabelPos(-40);

    } else {
    #============================================================
    #    Draw a pie chart where the label is outside the pie
    #============================================================

        # Set the center of the pie at (150, 150) and the radius to 80 pixels
        $c->setPieSize(150, 150, 80);

        # Set the sector label position to be 20 pixels from the pie. Use a join line to
        # connect the labels to the sectors.
        $c->setLabelPos(20, $perlchartdir::LineColor);

    }

    # Add a title to the pie chart
    $c->addTitle('Diagnosis Status 2009');

    # Set the pie data and the pie labels
    $c->setData($data, $labels);

    # Set the sector colors
    $c->setColors2($perlchartdir::DataColor, $colors);

    # Use local gradient shading, with a 1 pixel semi-transparent black (bb000000) border
    $c->setSectorStyle($perlchartdir::LocalGradientShading, 0xbb000000, 1);

    return $c;
}

sub type_four {
    my $self = shift; $self->_debug_path();

    # The value to display on the meter
    my $value = 27.48;

    # Create an AngularMeter object of size 200 x 115 pixels, with silver background
    # color, black border, 2 pixel 3D border border and rounded corners
    my $m = new AngularMeter(200, 115, perlchartdir::silverColor(), 0x000000, 2);
    $m->setRoundedFrame();

    # Set the meter center at (100, 100), with radius 85 pixels, and span from -90 to +90
    # degress (semi-circle)
    $m->setMeter(100, 100, 85, -90, 90);

    # Meter scale is 0 - 100, with major tick every 20 units, minor tick every 10 units,
    # and micro tick every 5 units
    $m->setScale(0, 100, 20, 10, 5);

    # Set 0 - 60 as green (66FF66) zone
    $m->addZone(0, 60, 0, 85, 0x66ff66);

    # Set 60 - 80 as yellow (FFFF33) zone
    $m->addZone(60, 80, 0, 85, 0xffff33);

    # Set 80 - 100 as red (FF6666) zone
    $m->addZone(80, 100, 0, 85, 0xff6666);

    # Add a text label centered at (100, 60) with 12 pts Arial Bold font
    $m->addText(100, 60, "Workload (% max)", "arialbd.ttf", 12, $perlchartdir::TextColor,
        $perlchartdir::Center);

    # Add a text box at the top right corner of the meter showing the value formatted to
    # 2 decimal places, using white text on a black background, and with 1 pixel 3D
    # depressed border
    $m->addText(156, 8, $m->formatValue($value, "2"), "arial.ttf", 8, 0xffffff
        )->setBackground(0x000000, 0, -1);

    # Add a semi-transparent blue (40666699) pointer with black border at the specified
    # value
    $m->addPointer($value, 0x40666699, 0x000000);

    return $m;
}

sub diagnosis {
    my $self = shift; $self->_debug_path();

    my $d = $self->model('Chart')->get_diagnosis_frequency(); # $self->debug($d);

#    my (@terms, @count);
#    while ( my ($i, $term) = each %$d ) {
#        push @count, $i;
#        push @terms, $term;
#    }

    my @count = map $_->[0], @$d;
    my @terms = map $_->[1], @$d;

    # The data for the pie chart
    my $data = \@count;

    # The labels for the pie chart
    my $labels = \@terms;

    # Create a PieChart object of size 560 x 270 pixels, with a golden background and a 1
    # pixel 3D border
    my $c = new PieChart(1000, 400, perlchartdir::goldColor(), -1, 1);

    # Add a title box using 15 pts Times Bold Italic font and metallic pink background
    # color
    $c->addTitle("Diagnosis Frequency 2009 (top 15)", "timesbi.ttf", 15)
        ->setBackground( perlchartdir::metalColor(0xff9999) );

    # Set the center of the pie at (280, 135) and the radius to 110 pixels
    $c->setPieSize(500, 200, 150);

    # Draw the pie in 3D with 20 pixels 3D depth
    $c->set3D(20);

    # Use the side label layout method
    $c->setLabelLayout($perlchartdir::SideLayout);

    # Set the label box background color the same as the sector color, with glass effect,
    # and with 5 pixels rounded corners
    my $t = $c->setLabelStyle();
    $t->setBackground($perlchartdir::SameAsMainColor, $perlchartdir::Transparent,
        perlchartdir::glassEffect());
    #$t->setRoundedCorners(5);

    # Set the border color of the sector the same color as the fill color. Set the line
    # color of the join line to black (0x0)
    $c->setLineColor($perlchartdir::SameAsMainColor, 0x000000);

    # Set the start angle to 135 degrees may improve layout when there are many small
    # sectors at the end of the data array (that is, data sorted in descending order). It
    # is because this makes the small sectors position near the horizontal axis, where
    # the text label has the least tendency to overlap. For data sorted in ascending
    # order, a start angle of 45 degrees can be used instead.
    $c->setStartAngle(135);

    # Set the pie data and the pie labels
    $c->setData($data, $labels);

    return $c;
}

# ------------------------------------------------------------------------------
sub check_numeric { # check vars numeric or set $NoValue & add chart_err msg:
    my ($self, $href) = @_; # hashref

    my $date = $href->{date}; # arrayref
    my $vars = $href->{vars}; # arrayref

    my $msg = 'warning: non-numerical value(s) present';

    my $no_val = $perlchartdir::NoValue;
    my $epoch  = perlchartdir::chartTime(@$date); # actually seconds elapsed since 1-1-0001 00:00:00

    for my $var( @$vars ) {
        unless ( looks_like_number($var) ) { # Scalar::Util
            $self->add_chart_data([ $no_val, $epoch ]); # eg req #33494
            $self->stash( chart_err => $msg );
            return 0;
        }
    }
    return 1; # all OK
}

# ------------------------------------------------------------------------------
# validates date contraints input, returns query params if valid, or 0 if not:
sub _validate_input {
    my $self = shift;
    my $dfv = $self->check_rm( 'default', $self->validate('date_constraints') );
    # not using runmode for return as this is for embedded img:
    return $dfv->has_invalid ? 0 : $self->query->Vars;
}

# ------------------------------------------------------------------------------
sub _get_param_monitoring_data { # eg HIV/Imatinib/Chimerism:
    my ($self, $args) = @_; $self->_debug_path(); # arrayref

    my $request_id = $self->param('id') # already checked in tmpl
    || return 0;

    my $request
        = $self->model('Request')->get_patient_and_request_data($request_id);
    # stash for later:
    $self->stash( request_data => $request->as_tree ); # warn Dumper $request->as_tree;

    { # need at least 1 previous dataset to plot graph:
        my %h = ( request => $request, test_name => $args->{test_name} );
        # returns true if any previous data:
        $self->model('Local')->has_previous_data(\%h) || return 0;
    }

    { # get previous data on same patient:
        my $patient_id = $request->patient_case->patient_id;
        $args->{patient_id} = $patient_id; # add patient_id to args
    }

    my $data = $self->model('Chart')->get_param_monitoring_data($args); # $self->debug($data);
    return $data || 0;
}

sub _sysinfo { # from webmin/proc/linux-lib.pl get_memory_info()
    my $self = shift;
    my $type = shift;

    my %data = ();

    if ( $type =~ /\Ablocks_(\w+)/ ) { # disk space request:
        my $vol = $1; # warn $vol;

        # get disk usage from df -k
        my $disk_usage = `df -k`; # warn Dumper $disk_usage;
        # my ($used, $free) = $disk_usage =~ /Mounted on\n\S+\s+\S+\s+(\S+)\s+(\S+)/;

        my @rows = split "\n", $disk_usage; # warn Dumper \@rows;
        ROW: for (@rows) { # eg /dev/cobd0  4228792  3752312  347584  92%  /
            my @cols = split /\s+/; # warn Dumper \@cols;
            my $mount = $cols[5]; # warn $mount;
            if (
                ( $vol eq 'root' && $mount eq '/' ) ||
                grep { $vol eq $_ && $mount eq '/' . $_ } qw(data var usr)
            ) {
                $data{blocks_used} = $cols[2] / 1024;
                $data{blocks_free} = $cols[3] / 1024;
                last ROW;
            }
        }
    }

    else { # memory request:
        my %mem = ();

        # get memory info from /proc/meminfo:
        open my $src, '<' . '/proc/meminfo' || return ();
        while (<$src>) {
            if (/^(\S+):\s+(\d+)/) {
                $mem{lc($1)} = $2;
            }
        }
        my $memfree = $mem{cached} > $mem{memtotal}
            ? $mem{memfree}
            : $mem{memfree} + $mem{buffers} + $mem{cached};

        %data = (
            swaptotal => $mem{swaptotal} / 1024,
            swapfree  => $mem{swapfree} / 1024,
            memtotal  => $mem{memtotal} / 1024,
            memfree   => $memfree / 1024,
        );
    } # warn Dumper \%data;

    return %data ? \%data : (); # triggers cleardot() if returned empty
}

1;
