added epics current monitor

diff --git a/dmon/code/Perl2Epics.pm b/dmon/code/Perl2Epics.pm
new file mode 100644 (file)
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 (executable)
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@<img src="%ADDPNG PadiwaCurrents.png%" type="image/png">@;
+   $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 2af6ad2bf304d86493aa87e46b0e3b23a2f22659..83b4e69a008f58d854b29acf2f3f639ba546a427 100755 (executable)
--- 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 374d0ba96cbfc029f3fae6c71dc27c49fdffb0d3..e55a97caf4534049b833035446d19b3fe23d55d2 100755 (executable)
--- 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],