From a863c3e50a77e83554d8c7386fe822e52e6cd87c Mon Sep 17 00:00:00 2001 From: Michael Traxler Date: Wed, 12 Nov 2014 23:25:43 +0100 Subject: [PATCH] added epics current monitor --- dmon/code/Perl2Epics.pm | 187 ++++++++++++++++++++++++++++++ dmon/scripts/dmon_currents.pl | 74 ++++++++++++ tools/HPlot.pm | 3 +- users/cern_cbmrich/dmon_config.pl | 6 +- 4 files changed, 266 insertions(+), 4 deletions(-) create mode 100644 dmon/code/Perl2Epics.pm create mode 100755 dmon/scripts/dmon_currents.pl diff --git a/dmon/code/Perl2Epics.pm b/dmon/code/Perl2Epics.pm new file mode 100644 index 0000000..35bb72c --- /dev/null +++ b/dmon/code/Perl2Epics.pm @@ -0,0 +1,187 @@ +package Perl2Epics; +use warnings; +use strict; +use Data::Dumper; +# use Hmon; + +use lib '/mnt/home_cbm02/hadaq/EPICS/base-3.14.12.3/lib/perl'; +use CA; + +$ENV{EPICS_CA_AUTO_ADDR_LIST} = 'YES'; +# JAM added fixed port numbers of EB epics +$ENV{EPICS_CA_ADDR_LIST} = "10.160.0.63 cbmpi2"; +#$ENV{EPICS_CA_ADDR_LIST} = "192.168.100.11 192.168.100.12 192.168.100.13 192.168.100.14 192.168.100.15 localhost"; + +my $EpicsValues = {}; +my $EpicsStore = {}; +my @EpicsChans = (); +my $EpicsNames = {}; +my $errcnt = {}; + +sub callback { + my ($chan, $status, $data) = @_; + #print Dumper $data; + if ($status) { + printf "%-30s %s\n", $chan->name, $status; + } + else { +# print $chan->name . ": $data->{value}\n"; +# print scalar @{$EpicsStore->{$chan->name}->{tme}}."\n"; + if(scalar @{$EpicsStore->{$chan->name}->{tme}} > 10) { + shift @{$EpicsStore->{$chan->name}->{tme}}; + shift @{$EpicsStore->{$chan->name}->{val}}; + } + push(@{$EpicsStore->{$chan->name}->{tme}}, $data->{stamp}); + push(@{$EpicsStore->{$chan->name}->{val}}, $data->{value}); + $EpicsValues->{$chan->name}->{tme} = $data->{stamp}; + $EpicsValues->{$chan->name}->{val} = $data->{value}; + } +} + + +sub Connect { + my ($title, $varname, $type, $wait) = @_; + # push(@EpicsChans,CA->new($name)); + # $EpicsChans[-1]->create_subscription('v', \&callback, 'DBR_TIME_DOUBLE'); + ## print $varname."\n"; + $type = 'DBR_TIME_DOUBLE' unless defined $type; + $EpicsStore->{$varname}->{tme} = []; + $EpicsStore->{$varname}->{val} = []; + $EpicsNames->{$title} = $varname; + $errcnt->{$varname} = 0; + my $success; + eval { + my $c = CA->new($varname); + CA->pend_io($wait || 0.05); + $c->create_subscription('v', \&callback, $type); +# $c->get_callback(\&callback, $type, 1); + $EpicsStore->{$varname}->{ca} = $c; + $success = $c->is_connected(); + }; + #print Dumper $EpicsValues; + return ($success); +} + +sub Update { + CA->pend_event($_[0]); +} + + +sub GetAll { + my $store = {}; + my $time; + my $val; + + Update(0.001); + + foreach my $el (keys %{$EpicsNames}) { + my $varname = $EpicsNames->{$el}; + my $ca = $EpicsStore->{$varname}->{ca}; + my $r = $ca->is_connected() if(defined $ca); + my $success = 1; + if(!$r && (!defined $errcnt->{$el} || $errcnt->{$el} < 20)) { + $success = Connect($el, $varname); + $errcnt->{$el}++; + } + + if(!$success) { + $time = -1; + $val = 0; + } elsif (scalar @{$EpicsStore->{$varname}->{tme}} > 0) { + $time = (@{$EpicsStore->{$varname}->{tme}})[-1]; + $val = (@{$EpicsStore->{$varname}->{val}})[-1]; + } else { + $time = $EpicsStore->{$varname}->{lasttime}; + $val = $EpicsStore->{$varname}->{lastval}; + } + $store->{$el}->{tme} = $time; + $store->{$el}->{val} = $val; + $EpicsStore->{$varname}->{lasttime} = $time; + $EpicsStore->{$varname}->{lastval} = $val; + } + + return $store; +} + +sub Get { + my ($title,$latest) = @_; + my $varname = $EpicsNames->{$title}; + my $time; + my $val; +# print $varname; + + my $c = $EpicsStore->{$varname}->{ca}; + my $r = $c->is_connected() if(defined $c); + + my $success = 1; + if(!$r) { + $success = Connect($title, $varname); + } + + if(!$success) { + return (-1, 0); + } + + Update(0.00001); + + if (scalar @{$EpicsStore->{$varname}->{tme}} > 0) { + if(defined $latest && $latest == 1) { + $time = (@{$EpicsStore->{$varname}->{tme}})[-1]; + $val = (@{$EpicsStore->{$varname}->{val}})[-1]; + } + else { #if (scalar @{$EpicsStore->{$varname}->{tme}} > 1) + $time = shift (@{$EpicsStore->{$varname}->{tme}}); + $val = shift (@{$EpicsStore->{$varname}->{val}}); + } + } + else { + $time = $EpicsStore->{$varname}->{lasttime}; + $val = $EpicsStore->{$varname}->{lastval}; + } + $EpicsStore->{$varname}->{lasttime} = $time; + $EpicsStore->{$varname}->{lastval} = $val; + $time = $time || -1; + $val = $val || 0; + return ($time,$val); +} + +sub Put { + my ($title, $value) = @_; + my $varname = $EpicsNames->{$title}; + if (!defined $varname) { + return -1; + } + + my $c = $EpicsStore->{$varname}->{ca}; + my $r = $c->is_connected() if(defined $c); + + my $success = 1; + if(!$r) { + $success = Connect($title, $varname); + } + + if(!$success) { + return -2; + } + + if (($c->element_count()) != 1) { + print "5\n"; + return -3; + } + + my $type = $c->field_type; + my @values; + if ($type !~ m/ ^DBR_STRING$ | ^DBR_ENUM$ /x) { + # Make @ARGV strings numeric + push (@values, (map { +$_; } $value)); + } else { + # Use strings + push (@values, $value); + } + $c->put(@values); + + return 0; +} + +1; +__END__ diff --git a/dmon/scripts/dmon_currents.pl b/dmon/scripts/dmon_currents.pl new file mode 100755 index 0000000..daa0232 --- /dev/null +++ b/dmon/scripts/dmon_currents.pl @@ -0,0 +1,74 @@ +#!/usr/bin/perl -w + +use warnings; +use POSIX qw(strftime); +use FileHandle; +use lib "./code"; +use lib "../tools"; +use HADES::TrbNet; +use List::Util qw(min max); +use Time::HiRes qw(usleep); +use Dmon; +use HPlot; +use Perl2Epics; +use Data::Dumper; + +my %config = Dmon::StartUp(); + +HPlot::PlotInit({ + name => "PadiwaCurrents", + file => Dmon::DMONDIR."PadiwaCurrents", + curves => 20, + entries => 300, + type => HPlot::TYPE_HISTORY, + output => HPlot::OUT_PNG, + xlabel => "Time [s]", + ylabel => "Current [A]", + sizex => 750, + sizey => 270, + nokey => 1, + buffer => 1 + }); + +my $str = Dmon::MakeTitle(10,6,"PadiwaCurrents",0); + $str .= qq@@; + $str .= Dmon::MakeFooter(); +Dmon::WriteFile("PadiwaCurrents",$str); + +for(my $i = 1; $i<=20; $i++) { + my $name = sprintf('CBM:PWRSWITCH:GetCurrent%02x',$i); + Perl2Epics::Connect("C".$i,$name); + } + + + +while (1) { + + # get data from epics + my $data = Perl2Epics::GetAll(); + my $maximum = 0; + my $total = 0; + + for(my $i = 1; $i<=20; $i++) { + my $val = $data->{"C".$i}->{"val"}; + $total += $val || 0; + $maximum = max($maximum,$val||0); + HPlot::PlotAdd('PadiwaCurrents',$val,$i-1); + } + + HPlot::PlotDraw('PadiwaCurrents'); + + my $title = "Currents"; + my $value = sprintf("%.3fA / %.3fA", $maximum, $total); + my $longtext = "Maximum / Total current: ". $value; + my $status = Dmon::OK; + Dmon::WriteQALog($config{flog},"currents",30,$status,$title,$value,$longtext,'2-PadiwaCurrents'); + + + sleep 1; + } + + + + + diff --git a/tools/HPlot.pm b/tools/HPlot.pm index 2af6ad2..83b4e69 100755 --- a/tools/HPlot.pm +++ b/tools/HPlot.pm @@ -15,7 +15,8 @@ use constant {OUT_PNG => 1, OUT_SVG => 2, #n/a OUT_SCREEN => 3}; #n/a -my @color= ('#2222dd','#dd2222','#22dd22','#dd8822','#dd22dd','#22dddd','#dddd22','#8888dd','#8822bb','#444444'); +my @color= ('#2222dd','#dd2222','#22dd22','#dd8822','#dd22dd','#22dddd','#dddd22','#8888dd','#8822bb','#444444', + '#2222dd','#dd2222','#22dd22','#dd8822','#dd22dd','#22dddd','#dddd22','#8888dd','#8822bb','#444444'); sub plot_write { my ($file,$str,$no) = @_; diff --git a/users/cern_cbmrich/dmon_config.pl b/users/cern_cbmrich/dmon_config.pl index 374d0ba..e55a97c 100755 --- a/users/cern_cbmrich/dmon_config.pl +++ b/users/cern_cbmrich/dmon_config.pl @@ -5,7 +5,7 @@ activeScripts => [['time','ping','-','-','daqop'], ['numfee','temperature','reftime','billboard','mbs'], ['trgrate','datarate','deadtime','-','-'], - ['heatmaprich','padiwatemp','padiwaonline','-','-'], + ['heatmaprich','padiwatemp','padiwaonline','currents','-'], ['cbmnetlink','cbmnetdata','cbmnetsync','-','-'],], #Names to be shown in left column of Overview (max 4 letters!) @@ -54,8 +54,8 @@ HubTrbAdresses => [0x7005,0x7000,0x7001,0x7002,0x7003, 0x0105, 0x0115], -BillboardAddress => 0xf30a, -MBSAddress => 0xf30a, +BillboardAddress => 0x0112, +MBSAddress => 0x0112, #Addresses of all TDCs. Either single or broadcast addresses TdcAddress => [0xfe4c,0xfe4e,0x7005], -- 2.43.0