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/perl5/lib/perl5/ChartDirector'; 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// 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 => '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 my @chart_data; # create AoA: RESULT: for (@$data) { # AoH my $result = $_->{result}; my @date = split '-', $_->{date}; # split into components for chartTime() my ($granulocyte_data) = $result =~ /Granulocyte PNH clone = ($re)%/; my ($erythrocyte_data) = $result =~ /Red cell PNH clone = ($re)%/; # warn Dumper [\@date, $granulocyte_data, $erythrocyte_data]; # skip unless have at least 1 result: next RESULT unless $granulocyte_data || $erythrocyte_data; # add granulocyte & red_cell clone data & transformed date values: my $pnh_data = [ $granulocyte_data, $erythrocyte_data ]; # deref'd in plot_pnh() push @chart_data, [ $pnh_data, 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_pnh(); # send to finalise_chart() to add title (if required) & run makeChart2(): my $chart = $self->make_chart($chart_obj); 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(); my $vars = $self->query->Vars; # $self->debug($vars); 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(); my $vars = $self->query->Vars; # $self->debug($vars); 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(); my $vars = $self->query->Vars; # $self->debug($vars); 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(); my $vars = $self->query->Vars; # $self->debug($vars); 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(); my $vars = $self->query->Vars; # $self->debug($vars); 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; # $self->debug($vars); 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(); my $vars = $self->query->Vars; # $self->debug($vars); 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(); my $vars = $self->query->Vars; # $self->debug($vars); 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; # $self->debug($vars); 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(); my $vars = $self->query->Vars; # $self->debug($vars); 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(); my $vars = $self->query->Vars; # $self->debug($vars); 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 } # ------------------------------------------------------------------------------ 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 '/' ) || ( $vol eq 'data' && $mount eq '/data' ) ) { $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;