AKHUETTEL / Lab-Measurement-3.930 / lib / Lab / Moose / Instrument / Common.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
—
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172

              
package Lab::Moose::Instrument::Common;
#ABSTRACT: Role for common commands declared mandatory by IEEE 488.2
$Lab::Moose::Instrument::Common::VERSION = '3.930';
use v5.20;
use Moose::Role;
use MooseX::Params::Validate;
use Lab::Moose::Instrument qw/
    validated_getter
    validated_setter
    validated_no_param_setter
    /;
use Carp;
use namespace::autoclean;
sub cls {
    my ( $self, %args ) = validated_no_param_setter( \@_ );
    return $self->write( command => '*CLS', %args );
}
sub idn {
    my ( $self, %args ) = validated_getter( \@_ );
    return $self->query( command => '*IDN?', %args );
}
sub idn_manufacturer {
    my ( $self, %args ) = validated_getter( \@_ );
    my $i=$self->query( command => '*IDN?', %args );
    my ($man, $mod, $ser, $fir) = split /,\s*/, $i, 4;
    return $man;
}
sub idn_model {
    my ( $self, %args ) = validated_getter( \@_ );
    my $i=$self->query( command => '*IDN?', %args );
    my ($man, $mod, $ser, $fir) = split /,\s*/, $i, 4;
    return $mod;
}
sub idn_serial {
    my ( $self, %args ) = validated_getter( \@_ );
    my $i=$self->query( command => '*IDN?', %args );
    my ($man, $mod, $ser, $fir) = split /,\s/, $i, 4;
    return $ser;
}
sub idn_firmware {
    my ( $self, %args ) = validated_getter( \@_ );
    my $i=$self->query( command => '*IDN?', %args );
    my ($man, $mod, $ser, $fir) = split /,\s/, $i, 4;
    return $fir;
}
sub opc {
    my ( $self, %args ) = validated_no_param_setter( \@_ );
    return $self->write( command => '*OPC', %args );
}
sub opc_query {
    my ( $self, %args ) = validated_getter( \@_ );
    return $self->query( command => '*OPC?', %args );
}
sub opc_sync {
    my ( $self, %args ) = validated_getter( \@_ );
    my $one = $self->opc_query(%args);
    if ( $one ne '1' ) {
        croak "OPC query did not return '1'";
    }
    return $one;
}
sub rst {
    my ( $self, %args ) = validated_no_param_setter( \@_ );
    return $self->write( command => '*RST', %args );
}
sub wai {
    my ( $self, %args ) = validated_no_param_setter( \@_ );
    return $self->write( command => '*WAI', %args );
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Lab::Moose::Instrument::Common - Role for common commands declared mandatory by IEEE 488.2
=head1 VERSION
version 3.930
=head1 METHODS
=head2 cls
Send I<*CLS> command.
=head2 idn
Return result of I<*IDN?> query.
=head2 idn_manufacturer
Returns the manufacturer field from an  I<*IDN?> query.
=head2 idn_model
Returns the model field from an  I<*IDN?> query.
=head2 idn_serial
Returns the serial number field from an  I<*IDN?> query.
=head2 idn_firmware
Returns the firmware version field from an  I<*IDN?> query.
=head2 opc
Send I<*OPC> command.
=head2 opc_query
Return result of I<*OPC?> query.
=head2 opc_sync
Perform C<opc_query> and croak if it does not return '1'. Make sure to provide
a sufficient timeout.
=head2 rst
Send I<*RST> command.
=head2 wai
Send I<*WAI> command.
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2025 by the Lab::Measurement team; in detail:
  Copyright 2016       Simon Reinhardt
            2017       Andreas K. Huettel, Simon Reinhardt
            2018       Andreas K. Huettel
            2020       Sam Bingner
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut