perl/Trigger/Trigger.pm

   1 # Copyright (c) 1999 Joseph E. Smith <jes@presto.med.upenn.edu>
   2 #
   3 # See the 'COPYRIGHT' section below for complete copyright information.
   4
   5 package Comedi::Trigger;
   6
   7 use strict;
   8 use vars qw($VERSION $AUTOLOAD @ISA @EXPORT @EXPORT_OK);
   9
  10 use Carp;
  11
  12 require Exporter;
  13 require AutoLoader;
  14
  15 @ISA = qw(Exporter AutoLoader);
  16
  17 # Nothing exported by default; all access through Trigger object
  18
  19 @EXPORT;
  20
  21 $VERSION = '0.01';
  22
  23
  24 # Preloaded methods go here.
  25
  26 sub new {
  27     my $class = shift;
  28     my $self = bless {};
  29
  30     while (@_) {
  31         my ($member, $value) = (shift, shift);
  32
  33         $self->$member($value);
  34     }
  35
  36     return $self->pack;
  37 }
  38
  39 sub pack {
  40     my $self = shift;
  41     my $struct = $self->_pack;
  42
  43     $self->{'struct'} = $struct;
  44
  45     return $struct ? $self : undef;
  46 }
  47
  48 sub _pack {
  49     my $self = shift;
  50
  51     my $chl = $self->{'chanlist'} || return undef;
  52
  53     my $n_chan = (exists($self->{'n_chan'}) ?
  54         $self->{'n_chan'} : @$chl) || return undef;
  55
  56     # keep these buffers in the object so they don't go away
  57     #
  58     $self->{'_chanlist'} = pack('L*', @{$self->{'chanlist'}});
  59
  60     my ($n, $buf);
  61
  62     # n can be zero
  63     #
  64     if (exists($self->{'n'}) && exists($self->{'data'})) {
  65         $n = $self->{'n'};
  66         $buf = $self->{'data'};
  67     }
  68     elsif (exists($self->{'n'})) {
  69         $n = $self->{'n'};
  70         $self->{'_data'} = "\0" x ($n * $n_chan * 2);
  71         $buf = $self->{'data'} = \$self->{'_data'};
  72     }
  73     elsif (exists($self->{'data'})) {
  74         $buf = $self->{'data'};
  75         $n = length($$buf)/(2*$n_chan);
  76     }
  77     else {
  78         return undef;
  79     }
  80
  81     # TODO: more error-checking (return undef)
  82     #
  83     # minimal sanity checks
  84     #
  85     croak("Data buffer is not a scalar reference")
  86         unless ref($buf) eq 'SCALAR';
  87     croak("Sample count (2*$n) too large for buffer (" .
  88           length($$buf) . ")")
  89         unless ((2*$n) <= length $$buf);
  90
  91     return pack('L4 p2 L5 L3',
  92                  $self->{'subdev'} || 0,
  93                  $self->{'mode'} || 0,
  94                  $self->{'flags'} || 0,
  95                  $n_chan,
  96                  $self->{'_chanlist'},
  97                  $$buf,
  98                  $n,
  99                  $self->{'trigsrc'} || $self->{'source'},
 100                  $self->{'trigvar'} || $self->{'major'},
 101                  $self->{'trigvar1'} || $self->{'minor'},
 102                  length $$buf,
 103                  0, 0, 0);
 104 }
 105
 106
 107 sub AUTOLOAD {
 108     my $self = shift;
 109     ref($self) || croak "$self is not an object";
 110
 111     (my $name = $AUTOLOAD) =~ s/.*://;  # strip leading class name(s)
 112
 113     return @_ ? $self->{$name} = shift : $self->{$name};
 114 }
 115
 116 # Autoload methods go after =cut, and are processed by the autosplit program.
 117
 118 1;
 119 __END__
 120 # Below is the stub of documentation for your module. You better edit it!
 121
 122 =head1 NAME
 123
 124 Comedi::Trigger - Object oriented interface to comedi trigger struct
 125
 126 =head1 SYNOPSIS
 127
 128   use Comedi::Trigger;
 129
 130   $t = new Comedi::Trigger;
 131
 132   $t->mode(2);
 133   $t->chanlist([ CR_PACK(0,0,AREF_GROUND), CR_PACK(1,0,AREF_GROUND) ]);
 134   $t->n(100);
 135   $t->major(1999);
 136   $t->minor(20);
 137
 138   $ret = comedi_trigger($dev, $t);
 139
 140 =head1 DESCRIPTION
 141
 142 This module provides an object oriented interface to B<comedi> trigger
 143 structures.  It provides some convenience over C<pack>ing one by hand:
 144 you need only specify a minimum of information, the rest will be
 145 calculated if possible.
 146
 147 =head1 METHODS
 148
 149 Each element of the B<comedi> trigger structure is available as a
 150 method which either retrieves or sets the value of that element.  In
 151 addition, some of the elements have aliases which may be used to make
 152 the programmer's intention clear.
 153
 154 The following methods function analogously to the C struct elements:
 155
 156 =over 4
 157
 158 =item subdev
 159
 160 =item mode
 161
 162 =item flags
 163
 164 =item n_chan
 165
 166 =item n
 167
 168 =back
 169
 170 These elements function analogously, but have aliases:
 171
 172 =over 4
 173
 174 =item trigsrc or source
 175
 176 =item trigvar or major
 177
 178 =item trigvar1 or minor
 179
 180 =back
 181
 182 These elements function somewhat differently than the C implementation:
 183
 184 =over 4
 185
 186 =item chanlist
 187
 188 This should be a reference to a Perl list of channel descriptors
 189 packed using B<Comedi::CR_PACK> (see the example above).
 190
 191 If the number of channels (B<n_chan>)is not specified, it will be set
 192 to the number of elements in this list.
 193
 194 =item data
 195
 196 This should be a scalar, pre-allocated to a length large enough to
 197 hold the requested data.  If no value is set, a scalar will be created
 198 of the appropriate size.
 199
 200 =item data_len
 201
 202 This element should be set to the size of the data buffer (in bytes).
 203 If not specified, it will be set automatically.
 204
 205 =back
 206
 207 This method is specific to the Perl module.
 208
 209 =item pack
 210
 211 This method packs the current state of the trigger elements into a
 212 binary form compatible with the C C<comedi_trig_struct>.  This method
 213 is normally called automatically by B<Comedi::Lib> functions that take
 214 trigger arguments.
 215
 216 =head1 VERSION
 217
 218 Version 0.01 09-Nov-1999
 219
 220 =head1 AUTHOR
 221
 222 Joe Smith <F<jes@presto.med.upenn.edu>>.
 223
 224 =head1 COPYRIGHT
 225
 226 Copyright (c) 1999 Joseph E. Smith.  All rights reserved.  This
 227 program is free software.  You may redistribute it and/or modify it
 228 under the same terms as Perl itself.
 229
 230 =head1 SEE ALSO
 231
 232 Comedi(1), Comedi::Lib(1).
 233
 234 =cut