From 15f4104cd03061e7b38c3d1933e1969492d3074b Mon Sep 17 00:00:00 2001 From: "hadaq@CountingHouse" Date: Tue, 14 May 2013 17:29:30 +0200 Subject: [PATCH] added RICH HV tools --- richhv/Perl2Epics.pm | 186 ++++++++++++++++++++++++++++++++++ richhv/addrow.txt | 187 ++++++++++++++++++++++++++++++++++ richhv/caput.pl | 188 +++++++++++++++++++++++++++++++++++ richhv/formfind | 193 ++++++++++++++++++++++++++++++++++++ richhv/rich_tripwatch.pl | 127 ++++++++++++++++++++++++ richhv/rich_tripwatch_jf.pl | 141 ++++++++++++++++++++++++++ 6 files changed, 1022 insertions(+) create mode 100644 richhv/Perl2Epics.pm create mode 100644 richhv/addrow.txt create mode 100755 richhv/caput.pl create mode 100755 richhv/formfind create mode 100755 richhv/rich_tripwatch.pl create mode 100755 richhv/rich_tripwatch_jf.pl diff --git a/richhv/Perl2Epics.pm b/richhv/Perl2Epics.pm new file mode 100644 index 0000000..15e6018 --- /dev/null +++ b/richhv/Perl2Epics.pm @@ -0,0 +1,186 @@ +package Perl2Epics; +use warnings; +use strict; +use Data::Dumper; +# use Hmon; + +use lib '/home/scs/EPICS/gcc-4.4/EPICS-3.14.12.2_linux-x86_64/base/' . '/lib/perl'; +use CA; + +$ENV{EPICS_CA_AUTO_ADDR_LIST} = 'YES'; +$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/richhv/addrow.txt b/richhv/addrow.txt new file mode 100644 index 0000000..1199cb8 --- /dev/null +++ b/richhv/addrow.txt @@ -0,0 +1,187 @@ + + + + Apr7 < RICH < Hades Wiki + + + + + + + + + + + + + + +
Skip to topic | Skip to bottom
+ +
+Home +
+
+ + + + +
+
+
RICH
+
+ + +
+Hello LudwigMaier ! +
+Create personal sidebar +
+
+
+

+RICH Web
+Web Home | Search
+Topics List | Index
+Changes | Notifications
+

+

+

+

+Hades Wiki Webs +

+

+

+

+

edit WebLeftBar
+

+

+ +
RICH.Apr7r1.7 - 07 Apr 2012 - 22:43 - JohannesSiebensontopic end
+
Start of topic | Skip to actions
+
+

7 Apr Trips

+

+ +

+ + + + + + + + + + + + + + + +
entry # day_month_time S1 S2 S3 S4 S5 S6 Comment Sign
1 07 Apr 00:00 2400 V 2400 V 2400 V 2300 V 2400 V 2400 V nom. voltages JF
2 07 Apr 02:42 2000 V 2000 V 2000 V 2000 V 2000 V 2000 V safe voltages
no beam till at least 12 pm,
end shift now 		LM
3 07 Apr 08:58 2400 V 2400 V 2400 V 2300 V 2400 V 2400 V nom voltages
conditioning in longer beam breaks 		JF
4 07 Apr 14:12       2400 V     condit. LM
5 07 Apr 14:30       2450 V     condit. LM
6 07 Apr 14:35     2450 V       condit. LM
7 07 Apr 19:37 1900 V 1900 V 1900 V 1900 V 1900 V 1900 V Beam is back, first be careful LM
8 07 Apr 19:49 2200 V 2200 V 2200 V 2200 V 2200 V 2200 V   LM
9 07 Apr 19:54 2400 V 2400 V 2400 V 2250 V 2400 V 2400 V   LM
10 07 Apr 22:38       frown frown ...     since 9pm seven trips in S4 JS
11 07 Apr 23:12       frown        
+ +
+

+-- JuergenFriese - 02 Apr 2012 +
+ +to top
+

End of topic
Skip to action links | Back to top
+ + +
+Edit +| Attach image or document +| Printable version +[PDF] +| Raw text +| More topic actions +
Revisions: | r1.7 | > | r1.6 | > | r1.5 +| Total page history +| Backlinks +| Graph +
+
+
You are here: RICH > Apr12HighVoltageTrips > Apr7

to top

+
Copyright © 1999-2012 by the contributing authors. +All material on this collaboration platform is the property of the contributing authors.
+Ideas, requests, problems regarding Hades Wiki? Send feedback +
+ \ No newline at end of file diff --git a/richhv/caput.pl b/richhv/caput.pl new file mode 100755 index 0000000..514fe17 --- /dev/null +++ b/richhv/caput.pl @@ -0,0 +1,188 @@ +#!/usr/bin/perl + +use warnings; +use strict; +use Data::Dumper; +# use Hmon; + +use lib '/home/scs/EPICS/gcc-4.4/EPICS-3.14.12.2_linux-x86_64/base/' . '/lib/perl'; + +use Getopt::Std; +use CA; +$ENV{EPICS_CA_AUTO_ADDR_LIST} = 'YES'; +$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"; + +our ($opt_0, $opt_c, $opt_e, $opt_f, $opt_g, $opt_h, $opt_l, + $opt_n, $opt_s, $opt_t); +our $opt_w = 1; + +$Getopt::Std::OUTPUT_HELP_VERSION = 1; + +HELP_MESSAGE() unless getopts('achlnstw:'); +HELP_MESSAGE() if $opt_h; + +die "No pv name specified. ('caput -h' gives help.)\n" + unless @ARGV; +my $pv = shift; + +die "No value specified. ('caput -h' gives help.)\n" + unless @ARGV; + +my $chan = CA->new($pv); +eval { + CA->pend_io($opt_w); +}; +if ($@) { + if ($@ =~ m/^ECA_TIMEOUT/) { + print "Channel connect timed out: '$pv' not found.\n"; + exit 2; + } else { + die $@; + } +} + +die "Write access denied for '$pv'.\n" unless $chan->write_access; + +my $n = $chan->element_count(); +die "Too many values given, '$pv' limit is $n\n" + unless $n >= @ARGV; + +my $type = $chan->field_type; +$type = 'DBR_STRING' + if $opt_s && $type =~ m/ ^DBR_ENUM$ | ^DBR_FLOAT$ | ^DBR_DOUBLE$ /x; +$type = 'DBR_LONG' + if $opt_n && $type eq 'DBR_ENUM'; +$type =~ s/^DBR_/DBR_TIME_/ + if $opt_l; + +my @values; +if ($type !~ m/ ^DBR_STRING$ | ^DBR_ENUM$ /x) { + # Make @ARGV strings numeric + @values = map { +$_; } @ARGV; +} else { + # Use strings + @values = @ARGV; +} + +my $done = 0; +if ($opt_t) { + do_put(); +} else { + $chan->get_callback(\&old_callback, $type); +} +CA->pend_event(0.1) until $done; + + +sub old_callback { + my ($chan, $status, $data) = @_; + die $status if $status; + display($chan, $type, $data, 'Old'); + do_put(); +} + +sub do_put { + if ($opt_c) { + $chan->put_callback(\&put_callback, @values); + } else { + $chan->put(@values); + $chan->get_callback(\&new_callback, $type); + } +} + +sub put_callback { + my ($chan, $status) = @_; + die $status if $status; + $chan->get_callback(\&new_callback, $type); +} + +sub new_callback { + my ($chan, $status, $data) = @_; + die $status if $status; + display($chan, $type, $data, 'New'); + $done = 1; +} + +sub format_number { + my ($data, $type) = @_; + if ($type =~ m/_DOUBLE$/) { + return sprintf "%.${opt_e}e", $data if $opt_e; + return sprintf "%.${opt_f}f", $data if $opt_f; + return sprintf "%.${opt_g}g", $data if $opt_g; + } + if ($type =~ m/_LONG$/) { + return sprintf "%lx", $data if $opt_0 eq 'x'; + return sprintf "%lo", $data if $opt_0 eq 'o'; + if ($opt_0 eq 'b') { + my $bin = unpack "B*", pack "l", $data; + $bin =~ s/^0*//; + return $bin; + } + } + return $data; +} + +sub display { + my ($chan, $type, $data, $prefix) = @_; + if (ref $data eq 'ARRAY') { + display($chan, $type, join(' ', @{$data}), $prefix); + } elsif (ref $data eq 'HASH') { + $type = $data->{TYPE}; # Can differ from request + my $value = $data->{value}; + if (ref $value eq 'ARRAY') { + $value = join(' ', map { format_number($_, $type); } @{$value}); + } else { + $value = format_number($value, $type); + } + my $stamp; + if (exists $data->{stamp}) { + my @t = localtime $data->{stamp}; + splice @t, 6; + $t[5] += 1900; + $t[0] += $data->{stamp_fraction}; + $stamp = sprintf "%4d-%02d-%02d %02d:%02d:%09.6f", reverse @t; + } + printf "%-30s %s %s %s %s\n", $chan->name, + $stamp, $value, $data->{status}, $data->{severity}; + } else { + my $value = format_number($data, $type); + if ($opt_t) { + print "$value\n"; + } else { + printf "$prefix : %-30s %s\n", $chan->name, $value; + } + } +} + +sub HELP_MESSAGE { + print STDERR "\nUsage: caput [options] ...\n", + "\n", + " -h: Help: Print this message\n", + "Channel Access options:\n", + " -w : Wait time, specifies longer CA timeout, default is $opt_w second\n", + " -c: Use put_callback to wait for completion\n", + "Format options:\n", + " -t: Terse mode - print only sucessfully written value, without name\n", + " -l: Long mode \"name timestamp value stat sevr\" (read PVs as DBR_TIME_xxx)\n", + "Enum format:\n", + " Default: Auto - try value as ENUM string, then as index number\n", + " -n: Force interpretation of values as numbers\n", + " -s: Force interpretation of values as strings\n", + "Floating point type format:\n", + " Default: Use %g format\n", + " -e : Use %e format, with a precision of digits\n", + " -f : Use %f format, with a precision of digits\n", + " -g : Use %g format, with a precision of digits\n", + " -s: Get value as string (may honour server-side precision)\n", + "Integer number format:\n", + " Default: Print as decimal number\n", + " -0x: Print as hex number\n", + " -0o: Print as octal number\n", + " -0b: Print as binary number\n", + "\n", + "Examples:\n", + " caput my_channel 1.2\n", + " caput my_waveform 1.2 2.4 3.6 4.8 6.0\n", + "\n"; + exit 1; +} + diff --git a/richhv/formfind b/richhv/formfind new file mode 100755 index 0000000..3ca8ea4 --- /dev/null +++ b/richhv/formfind @@ -0,0 +1,193 @@ +#!/usr/bin/env perl +# +# formfind.pl +# +# This script gets a HTML page on stdin and presents form information on +# stdout. +# +# Author: Daniel Stenberg +# Version: 0.2 Nov 18, 2002 +# +# HISTORY +# +# 0.1 - Nov 12 1998 - Created now! +# 0.2 - Nov 18 2002 - Enhanced. Removed URL support, use only stdin. +# + +$in=""; + +if($ARGV[0] eq "-h") { + print "Usage: $0 < HTML\n"; + exit; +} + +sub namevalue { + my ($tag)=@_; + my $name=$tag; + if($name =~ /name *=/i) { + if($name =~ /name *= *([^\"\']([^ \">]*))/i) { + $name = $1; + } + elsif($name =~ /name *= *(\"|\')([^\"\']*)(\"|\')/i) { + $name=$2; + } + else { + # there is a tag but we didn't find the contents + $name="[weird]"; + } + + } + else { + # no name given + $name=""; + } + # get value tag + my $value= $tag; + if($value =~ /[^\.a-zA-Z0-9]value *=/i) { + if($value =~ /[^\.a-zA-Z0-9]value *= *([^\"\']([^ \">]*))/i) { + $value = $1; + } + elsif($value =~ /[^\.a-zA-Z0-9]value *= *(\"|\')([^\"\']*)(\"|\')/i) { + $value=$2; + } + else { + # there is a tag but we didn't find the contents + $value="[weird]"; + } + } + else { + $value=""; + } + return ($name, $value); +} + + +while() { + $line = $_; + push @indoc, $line; + $line=~ s/\n//g; + $line=~ s/\r//g; + $in=$in.$line; +} + +while($in =~ /[^<]*(<[^>]+>)/g ) { + # we have a tag in $1 + $tag = $1; + + if($tag =~ /^