File Coverage

blib/lib/Lab/Moose/Instrument/OI_Common.pm
Criterion Covered Total %
statement 35 47 74.4
branch 2 4 50.0
condition n/a
subroutine 10 12 83.3
pod 3 4 75.0
total 50 67 74.6


line stmt bran cond sub pod time code
1             package Lab::Moose::Instrument::OI_Common;
2             $Lab::Moose::Instrument::OI_Common::VERSION = '3.881';
3             #ABSTRACT: Role for handling Oxfords Instruments pseudo-SCPI commands
4              
5 2     2   2988 use v5.20;
  2         7  
6              
7 2     2   10 use Moose::Role;
  2         5  
  2         19  
8 2     2   12054 use MooseX::Params::Validate;
  2         6  
  2         23  
9 2     2   1044 use Lab::Moose::Instrument qw/validated_getter validated_setter/;
  2         6  
  2         155  
10              
11 2     2   22 use Carp;
  2         8  
  2         112  
12 2     2   20 use namespace::autoclean;
  2         7  
  2         19  
13              
14              
15             sub get_temperature_channel {
16 0     0 0 0 my ( $self, %args ) = validated_getter(
17             \@_,
18             channel => { isa => 'Str' }
19             );
20              
21 0         0 my $channel = delete $args{channel};
22              
23 0         0 my $rv
24             = $self->oi_getter( cmd => "READ:DEV:$channel:TEMP:SIG:TEMP", %args );
25 0         0 $rv =~ s/K.*$//;
26 0         0 return $rv;
27             }
28              
29             sub get_temperature_channel_resistance {
30 0     0 1 0 my ( $self, %args ) = validated_getter(
31             \@_,
32             channel => { isa => 'Str' }
33             );
34              
35 0         0 my $channel = delete $args{channel};
36              
37 0         0 my $rv
38             = $self->oi_getter( cmd => "READ:DEV:$channel:TEMP:SIG:RES", %args );
39 0         0 $rv =~ s/Ohm.*$//;
40 0         0 return $rv;
41             }
42              
43             sub _parse_setter_retval {
44 6     6   12 my $self = shift;
45 6         14 my ( $header, $retval ) = @_;
46              
47 6         15 $header = 'STAT:' . $header;
48 6 50       153 if ( $retval !~ /^\Q$header\E:([^:]+):VALID$/ ) {
49 0         0 croak "Invalid return value of setter for header $header:\n $retval";
50             }
51 6         49 return $1;
52             }
53              
54             sub _parse_getter_retval {
55 11     11   32 my $self = shift;
56 11         24 my ( $header, $retval ) = @_;
57              
58 11         40 $header =~ s/^READ:/STAT:/;
59              
60 11 50       174 if ( $retval !~ /^\Q$header\E:(.+)/ ) {
61 0         0 croak "Invalid return value of getter for header $header:\n $retval";
62             }
63 11         116 return $1;
64             }
65              
66              
67             sub oi_getter {
68 11     11 1 44 my ( $self, %args ) = validated_getter(
69             \@_,
70             cmd => { isa => 'Str' }
71             );
72 11         8748 my $cmd = delete $args{cmd};
73 11         53 my $rv = $self->query( command => $cmd, %args );
74 11         35 return $self->_parse_getter_retval( $cmd, $rv );
75             }
76              
77              
78             sub oi_setter {
79 6     6 1 40 my ( $self, $value, %args ) = validated_setter(
80             \@_,
81             cmd => { isa => 'Str' }
82             );
83 6         17 my $cmd = delete $args{cmd};
84 6         28 my $rv = $self->query( command => "$cmd:$value", %args );
85 6         23 return $self->_parse_setter_retval( $cmd, $rv );
86             }
87              
88             1;
89              
90             __END__
91              
92             =pod
93              
94             =encoding UTF-8
95              
96             =head1 NAME
97              
98             Lab::Moose::Instrument::OI_Common - Role for handling Oxfords Instruments pseudo-SCPI commands
99              
100             =head1 VERSION
101              
102             version 3.881
103              
104             =head1 DESCRIPTION
105              
106             =head1 METHODS
107              
108             =head2 get_temperature
109              
110             $t = $m->get_temperature_channel(channel => 'MB1.T1');
111              
112             Read out the designated temperature channel. The result is in Kelvin.
113              
114             =head2 get_temperature_channel_resistance
115              
116             $r = $m->get_temperature_channel_resistance(channel => 'MB1.T1');
117              
118             Read out the designated temperature channel resistance. The result is in Ohm.
119              
120             =head2 oi_getter
121              
122             my $current = $self->oi_getter(cmd => "READ:DEV:$channel:PSU:SIG:CURR", %args);
123             $current =~ s/A$//;
124              
125             Perform query with I<READ:*> command and parse return value.
126              
127             =head2 oi_setter
128              
129             $self->oi_setter(
130             cmd => "SET:DEV:$channel:PSU:SIG:SWHT",
131             value => $value,
132             %args);
133              
134             Perform set/query with I<SET:*> command and parse return value.
135              
136             =head1 COPYRIGHT AND LICENSE
137              
138             This software is copyright (c) 2023 by the Lab::Measurement team; in detail:
139              
140             Copyright 2018 Andreas K. Huettel, Simon Reinhardt
141             2019 Simon Reinhardt
142             2020 Andreas K. Huettel
143              
144              
145             This is free software; you can redistribute it and/or modify it under
146             the same terms as the Perl 5 programming language system itself.
147              
148             =cut