File Coverage

blib/lib/Lab/Moose/Connection/Debug.pm
Criterion Covered Total %
statement 22 38 57.8
branch 2 4 50.0
condition n/a
subroutine 8 10 80.0
pod 4 4 100.0
total 36 56 64.2


line stmt bran cond sub pod time code
1             package Lab::Moose::Connection::Debug;
2             $Lab::Moose::Connection::Debug::VERSION = '3.881';
3             #ABSTRACT: Debug connection, printing / reading on terminal
4              
5 4     4   5354 use v5.20;
  4         16  
6              
7 4     4   40 use Moose;
  4         11  
  4         42  
8 4     4   29722 use namespace::autoclean;
  4         11  
  4         42  
9 4     4   376 use Data::Dumper;
  4         11  
  4         356  
10 4     4   32 use YAML::XS;
  4         9  
  4         243  
11              
12 4     4   27 use Carp;
  4         11  
  4         1647  
13              
14             has verbose => (
15             is => 'ro',
16             isa => 'Bool',
17             default => 1,
18             );
19              
20              
21             sub Write {
22 172     172 1 1860 my $self = shift;
23 172         467 my %args = @_;
24 172 50       5302 if ( $self->verbose() ) {
25 0         0 carp "Write called with args:\n", Dump \%args, "\n";
26             }
27             }
28              
29              
30             sub Read {
31 0     0 1 0 my $self = shift;
32 0         0 my %args = @_;
33 0         0 carp "Read called with args:\n", Dump \%args, "\n";
34 0         0 say "enter return value:";
35 0         0 my $retval = <STDIN>;
36 0         0 chomp $retval;
37 0         0 return $retval;
38             }
39              
40              
41             sub Query {
42 0     0 1 0 my $self = shift;
43 0         0 my %args = @_;
44 0         0 carp "Query called with args:\n", Dump \%args, "\n";
45 0         0 say "enter return value:";
46 0         0 my $retval = <STDIN>;
47 0         0 chomp $retval;
48 0         0 return $retval;
49             }
50              
51              
52             sub Clear {
53 18     18 1 230 my $self = shift;
54 18 50       558 if ( $self->verbose ) {
55 0           carp "Clear called";
56             }
57             }
58              
59             with 'Lab::Moose::Connection';
60              
61             __PACKAGE__->meta->make_immutable();
62             1;
63              
64             __END__
65              
66             =pod
67              
68             =encoding UTF-8
69              
70             =head1 NAME
71              
72             Lab::Moose::Connection::Debug - Debug connection, printing / reading on terminal
73              
74             =head1 VERSION
75              
76             version 3.881
77              
78             =head1 SYNOPSIS
79              
80             use Lab::Moose;
81              
82             my $instrument = instrument(
83             type => 'DummySource',
84             connection_type => 'DEBUG'
85             connection_options => {
86             verbose => 0, # do not print arguments of all Write commands (default is 1).
87             }
88             );
89              
90             =head1 DESCRIPTION
91              
92             Debug connection object. Print out C<Write> commands and prompt answer for
93             C<Read> commands.
94              
95             =head1 METHODS
96              
97             =head2 Write
98              
99             If the connection option verbose is set, output the content of all write
100             commands to the terminal. Otherwise, do nothing.
101              
102             =head2 Read
103              
104             Output the arguments of the read command to the terminal, and request
105             a response there, which is given as result of the read.
106              
107             =head2 Query
108              
109             Output the arguments of the query command to the terminal, and request
110             a response there, which is given as result of the query.
111              
112             =head2 Clear
113              
114             Output "Clear called" on the terminal.
115              
116             =head1 COPYRIGHT AND LICENSE
117              
118             This software is copyright (c) 2023 by the Lab::Measurement team; in detail:
119              
120             Copyright 2016 Simon Reinhardt
121             2017 Andreas K. Huettel, Simon Reinhardt
122             2020 Andreas K. Huettel
123              
124              
125             This is free software; you can redistribute it and/or modify it under
126             the same terms as the Perl 5 programming language system itself.
127              
128             =cut