package LIMS::Controller::Chart;
use Moose;
BEGIN { extends 'LIMS::Base'; }
with 'LIMS::Controller::Roles::Chart'; # contains ChartDirector chart methods
use namespace::clean -except => 'meta';
__PACKAGE__->meta->make_immutable(inline_constructor => 0);
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/<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',
presentation => 'HIV', # screened as
);
my $data = $self->_get_param_monitoring_data(\%args)
|| return $self->cleardot();
my @chart_data; # create AoA:
RESULT:
for (@$data) { # AoH
my $result = $_->{result};
my @date = split '-', $_->{date}; # split into components for chartTime()
# initialise all vars to zero:
my $CD4_total = 0;
my ($CD4pos) = $result =~ /CD4\+ = (.*)\/uL/i; # legacy (not always consistent)
my ($CD4posCD8neg) = $result =~ /CD4\+8\- T-cells = (.*) cells per microlitre/;
my ($CD4posCD8pos) = $result =~ /CD4\+8\+ T-cells = (.*) cells per microlitre/;
# make sure value not undef & remove any commas:
map {
$_ ||= 0;
$_ =~ s/,//; # dat supplied as eg 1,234
} ($CD4pos, $CD4posCD8neg, $CD4posCD8pos);
$CD4_total = $CD4posCD8neg + $CD4posCD8pos + $CD4pos;
# skip unless have CD4 count:
next RESULT unless $CD4_total; # warn Dumper $CD4_total;
# add CD4 count & transformed date values:
push @chart_data, [ $CD4_total, 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_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',
presentation => 'PNH', # screened as
);
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 : 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 $patient_id = $self->param('id');
# params to draw on chart:
my @params = qw(hb plts creatinine paraprotein); # + calculated abnormal B cells:
# for calculation of abnormal B cells:
my @b_cell = qw(total_b_cells wbc neoplastic_b_cells);
# get all request results for this patient:
my $data = $self->model('Outreach')->get_chart_results(
$patient_id, [ @params, @b_cell ]
);
# 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
my @results = map $data->{$_}, @params; # array of results for @params
my $calculated_vals # calculate abnormal B cells from @b_cell param results:
= $self->model('Outreach')->calculate_flow_params($data);
push @results, $calculated_vals->{neoplastic_b_cells};
# 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();
# 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 (@chart_data, $field_label); # 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) ];
$field_label ||= $_->{field_label}; # all the same so 1st one will do
}
my $patient = $self->model('Patient')->get_patient($patient_id);
my $title = sprintf '%s %s :: %s', ucfirst $patient->first_name,
uc $patient->last_name, $field_label;
# stash data for Roles::Chart::_get_chart_data():
$self->stash(
chart_data => \@chart_data,
chart_title => $title,
);
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 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',
presentation => 'CML imatinib PB follow-up', # screened as
);
my $data = $self->_get_param_monitoring_data(\%args)
|| return $self->cleardot();
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;
# 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_imatinib();
# send to finalise_chart() to add title (if required) & run makeChart2():
my $chart = $self->make_chart($chart_obj);
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;
# add a (optional) title to the chart:
if ( my $title = $self->stash->{chart_title} ) {
$chart->addTitle($title);
}
return $chart->makeChart2($perlchartdir::PNG);
}
# ------------------------------------------------------------------------------
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 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 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 _get_param_monitoring_data { # eg HIV/Imatinib:
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 );
{ # need at least 1 previous dataset to plot graph:
my %h = ( request => $request, screen => $args->{presentation} );
# 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;
