#include <stdlib.h>
#include <stdio.h>
#include <string.h>
-#include <comedilib.h>
-#include <libinternal.h>
-#include <EXTERN.h>
-#include <perl.h>
+#include "libinternal.h"
-static int extract_ph_string( PerlInterpreter *my_perl, const char *perl_statement,
- char *result, unsigned int result_size )
-{
- SV *perl_retval;
- STRLEN len;
-
- perl_retval = eval_pv( perl_statement, FALSE );
- strncpy( result, SvPV( perl_retval, len ), result_size );
- return 0;
-}
+static int set_calibration( comedi_t *dev, const comedi_calibration_t *parsed_file,
+ unsigned int cal_index );
-static int extract_ph_integer( PerlInterpreter *my_perl, const char *perl_statement )
+static int check_cal_file( comedi_t *dev, const comedi_calibration_t *parsed_file )
{
- SV *perl_retval;
- int result;
-
- perl_retval = eval_pv( perl_statement, FALSE );
- result = SvIV( perl_retval );
- return result;
-}
-
-static int check_cal_file( comedi_t *dev, PerlInterpreter *my_perl )
-{
- char result[ 100 ];
- int retval;
-
- retval = extract_ph_string( my_perl, "$cal->{driver_name};",
- result, sizeof( result ) );
- if( retval < 0 ) return retval;
-
- if( strcmp( comedi_get_driver_name( dev ), result ) )
+ if( strcmp( comedi_get_driver_name( dev ), parsed_file->driver_name ) )
{
- fprintf( stderr, "driver name does not match calibration file\n" );
+ COMEDILIB_DEBUG( 3, "driver name does not match '%s' from calibration file\n",
+ parsed_file->driver_name );
return -1;
}
- retval = extract_ph_string( my_perl, "$cal->{board_name};",
- result, sizeof( result ) );
- if( retval < 0 ) return retval;
-
- if( strcmp( comedi_get_board_name( dev ), result ) )
+ if( strcmp( comedi_get_board_name( dev ), parsed_file->board_name ) )
{
- fprintf( stderr, "board name does not match calibration file\n" );
+ COMEDILIB_DEBUG( 3, "board name does not match '%s' from calibration file\n",
+ parsed_file->board_name );
return -1;
}
return 0;
}
-static inline int num_calibrations( PerlInterpreter *my_perl )
-{
- return extract_ph_integer( my_perl, "scalar( @{$cal->{calibrations}} );" );
-}
-
-static int extract_array_element( PerlInterpreter *my_perl, unsigned int cal_index,
- const char *array_name, unsigned int array_index )
-{
- char element[ 100 ];
-
- snprintf( element, sizeof( element ),
- "$cal->{ calibrations }[ %i ]->{ %s }[ %i ];", cal_index, array_name, array_index );
- return extract_ph_integer( my_perl, element );
-}
-
-static int extract_array_length( PerlInterpreter *my_perl, unsigned int cal_index,
- const char *array_name )
+static inline int valid_channel( const comedi_calibration_t *parsed_file,
+ unsigned int cal_index, unsigned int channel )
{
- char element[ 100 ];
+ int num_channels, i;
- snprintf( element, sizeof( element ),
- "scalar( @{ $cal->{ calibrations }[ %i ]->{ %s } } );", cal_index, array_name );
- return extract_ph_integer( my_perl, element );
-}
-
-static int extract_subdevice( PerlInterpreter *my_perl, unsigned int cal_index )
-{
- char element[ 100 ];
+ num_channels = parsed_file->settings[ cal_index ].num_channels;
+ if( num_channels == 0 ) return 1;
+ for( i = 0; i < num_channels; i++ )
+ {
+ if( parsed_file->settings[ cal_index ].channels[ i ] == channel )
+ return 1;
+ }
- snprintf( element, sizeof( element ),
- "$cal->{ calibrations }[ %i ]->{ subdevice };", cal_index );
- return extract_ph_integer( my_perl, element );
+ return 0;
}
-static int valid_item( PerlInterpreter *my_perl, unsigned int cal_index,
- const char *item_type, unsigned int item )
+static inline int valid_range( const comedi_calibration_t *parsed_file,
+ unsigned int cal_index, unsigned int range )
{
- int num_items, i;
+ int num_ranges, i;
- num_items = extract_array_length( my_perl, cal_index, item_type );
- if( num_items < 0 ) return 0;
- if( num_items == 0 ) return 1;
- for( i = 0; i < num_items; i++ )
+ num_ranges = parsed_file->settings[ cal_index ].num_ranges;
+ if( num_ranges == 0 ) return 1;
+ for( i = 0; i < num_ranges; i++ )
{
- if( extract_array_element( my_perl, cal_index, item_type, i ) == item )
+ if( parsed_file->settings[ cal_index ].ranges[ i ] == range )
return 1;
}
return 0;
}
-static inline int valid_range( PerlInterpreter *my_perl, unsigned int cal_index,
- unsigned int range )
+static inline int valid_aref( const comedi_calibration_t *parsed_file,
+ unsigned int cal_index, unsigned int aref )
{
- return valid_item( my_perl, cal_index, "ranges", range );
-}
+ int num_arefs, i;
-static inline int valid_channel( PerlInterpreter *my_perl, unsigned int cal_index,
- unsigned int channel )
-{
- return valid_item( my_perl, cal_index, "channels", channel );
-}
+ num_arefs = parsed_file->settings[ cal_index ].num_arefs;
+ if( num_arefs == 0 ) return 1;
+ for( i = 0; i < num_arefs; i++ )
+ {
+ if( parsed_file->settings[ cal_index ].arefs[ i ] == aref )
+ return 1;
+ }
-static inline int valid_aref( PerlInterpreter *my_perl, unsigned int cal_index,
- unsigned int aref )
-{
- return valid_item( my_perl, cal_index, "arefs", aref );
+ return 0;
}
-static int find_calibration( PerlInterpreter *my_perl, unsigned int subdev,
- unsigned int channel, unsigned int range, unsigned int aref )
+static int apply_calibration( comedi_t *dev, const comedi_calibration_t *parsed_file,
+ unsigned int subdev, unsigned int channel, unsigned int range, unsigned int aref )
{
- int num_cals, i;
+ int num_cals, i, retval;
+ int found_cal = 0;
- num_cals = num_calibrations( my_perl );
- if( num_cals < 0 ) return num_cals;
+ num_cals = parsed_file->num_settings;
for( i = 0; i < num_cals; i++ )
{
- if( extract_subdevice( my_perl, i ) != subdev ) continue;
- if( valid_range( my_perl, i, range ) == 0 ) continue;
- if( valid_channel( my_perl, i, channel ) == 0 ) continue;
- if( valid_aref( my_perl, i, aref ) == 0 ) continue;
- break;
+ if( parsed_file->settings[ i ].subdevice != subdev ) continue;
+ if( valid_range( parsed_file, i, range ) == 0 ) continue;
+ if( valid_channel( parsed_file, i, channel ) == 0 ) continue;
+ if( valid_aref( parsed_file, i, aref ) == 0 ) continue;
+
+ retval = set_calibration( dev, parsed_file, i );
+ if( retval < 0 ) return retval;
+ found_cal = 1;
+ }
+ if( found_cal == 0 )
+ {
+ COMEDILIB_DEBUG( 3, "failed to find matching calibration\n" );
+ return -1;
}
- if( i == num_cals ) return -1;
- return i;
+ return 0;
}
-static int set_calibration( comedi_t *dev, PerlInterpreter *my_perl,
+static int set_calibration( comedi_t *dev, const comedi_calibration_t *parsed_file,
unsigned int cal_index )
{
int i, retval, num_caldacs;
- num_caldacs = extract_array_length( my_perl, cal_index, "caldacs" );
- if( num_caldacs < 0 ) return num_caldacs;
+ num_caldacs = parsed_file->settings[ cal_index ].num_caldacs;
+ COMEDILIB_DEBUG( 4, "num_caldacs %i\n", num_caldacs );
for( i = 0; i < num_caldacs; i++ )
{
- int subdev, channel, value;
- char *element;
-
- asprintf( &element, "$cal->{calibrations}[ %i ]->{caldacs}[ %i ]->{subdevice};",
- cal_index, i );
- subdev = extract_ph_integer( my_perl, element );
- free( element );
- if( subdev < 0 )
- {
- fprintf( stderr, "failed to extract subdev\n" );
- return subdev;
- }
-
- asprintf( &element, "$cal->{calibrations}[ %i ]->{caldacs}[ %i ]->{channel};",
- cal_index, i );
- channel = extract_ph_integer( my_perl, element );
- free( element );
- if( channel < 0 )
- {
- fprintf( stderr, "failed to extract channel\n" );
- return channel;
- }
+ comedi_caldac_t caldac;
- asprintf( &element, "$cal->{calibrations}[ %i ]->{caldacs}[ %i ]->{value};",
- cal_index, i );
- value = extract_ph_integer( my_perl, element );
- free( element );
- if( value < 0 )
- {
- fprintf( stderr, "failed to extract value\n" );
- return value;
- }
-
- retval = comedi_data_write( dev, subdev, channel, 0, 0, value );
+ caldac = parsed_file->settings[ cal_index ].caldacs[ i ];
+ COMEDILIB_DEBUG( 4, "subdev %i, ch %i, val %i\n", caldac.subdevice,
+ caldac.channel,caldac.value);
+ retval = comedi_data_write( dev, caldac.subdevice, caldac.channel,
+ 0, 0, caldac.value );
if( retval < 0 ) return retval;
}
return 0;
}
-static PerlInterpreter* alloc_my_perl( void )
+EXPORT_ALIAS_DEFAULT(_comedi_apply_parsed_calibration,comedi_apply_parsed_calibration,0.7.20);
+int _comedi_apply_parsed_calibration( comedi_t *dev, unsigned int subdev, unsigned int channel,
+ unsigned int range, unsigned int aref, const comedi_calibration_t *calibration )
{
- PerlInterpreter *my_perl;
- char *embedding[] = { "", "-e", "0" };
+ int retval;
+
+ retval = check_cal_file( dev, calibration );
+ if( retval < 0 ) return retval;
- my_perl = perl_alloc();
- if( my_perl == NULL )
+ retval = apply_calibration( dev, calibration, subdev, channel, range, aref );
+ return retval;
+}
+
+/* munge characters in board name that will cause problems with file paths */
+static void fixup_board_name( char *name )
+{
+ while( ( name = strchr( name, '/' ) ) )
{
- fprintf( stderr, "failed to alloc perl interpreter\n");
- return my_perl;
+ if( name )
+ {
+ *name = '-';
+ name++;
+ }
}
- perl_construct( my_perl );
- perl_parse(my_perl, NULL, 3, embedding, NULL);
-
- return my_perl;
}
-static int startup_my_perl( PerlInterpreter *my_perl, const char *file_path )
+EXPORT_ALIAS_DEFAULT(_comedi_get_default_calibration_path,comedi_get_default_calibration_path,0.7.20);
+char* _comedi_get_default_calibration_path( comedi_t *dev )
{
- int retval;
- char perl_prog[ 1024 ];
+ struct stat file_stats;
+ char *file_path;
+ char *board_name, *temp;
+ char *driver_name;
- snprintf( perl_prog, sizeof( perl_prog ),
- "
- my $hash = `cat '%s'`;
- eval \"\\$cal = $hash;\";
- ", file_path );
+ if( fstat( comedi_fileno( dev ), &file_stats ) < 0 )
+ {
+ COMEDILIB_DEBUG( 3, "failed to get file stats of comedi device file\n" );
+ return NULL;
+ }
- retval = perl_run( my_perl );
- if( retval )
+ driver_name = comedi_get_driver_name( dev );
+ if( driver_name == NULL )
{
- fprintf( stderr, "nonzero exit from perl_run\n");
- return -1;
+ return NULL;
+ }
+ temp = comedi_get_board_name( dev );
+ if( temp == NULL )
+ {
+ return NULL;
}
- eval_pv( perl_prog, FALSE );
+ board_name = strdup( temp );
- return 0;
-}
+ fixup_board_name( board_name );
+ asprintf( &file_path, LOCALSTATEDIR "/lib/comedi/calibrations/%s_%s_comedi%li",
+ driver_name, board_name, ( unsigned long ) minor( file_stats.st_rdev ) );
-static void cleanup_my_perl( PerlInterpreter *my_perl )
-{
- perl_destruct( my_perl );
- perl_free( my_perl );
+ free( board_name );
+ return file_path;
}
-EXPORT_SYMBOL(comedi_apply_calibration,0.7.20);
-int comedi_apply_calibration( comedi_t *dev, unsigned int subdev, unsigned int channel,
+EXPORT_ALIAS_DEFAULT(_comedi_apply_calibration,comedi_apply_calibration,0.7.20);
+int _comedi_apply_calibration( comedi_t *dev, unsigned int subdev, unsigned int channel,
unsigned int range, unsigned int aref, const char *cal_file_path )
{
- struct stat file_stats;
char file_path[ 1024 ];
int retval;
- int cal_index;
- PerlInterpreter *my_perl;
+ comedi_calibration_t *parsed_file;
if( cal_file_path )
{
strncpy( file_path, cal_file_path, sizeof( file_path ) );
}else
{
- if( fstat( comedi_fileno( dev ), &file_stats ) < 0 )
- {
- fprintf( stderr, "failed to get file stats of comedi device file\n" );
- return -1;
- }
-
- snprintf( file_path, sizeof( file_path ), "/etc/comedi/calibrations/%s_0x%lx",
- comedi_get_board_name( dev ),
- ( unsigned long ) file_stats.st_ino );
- }
-
- my_perl = alloc_my_perl();
- if( my_perl == NULL )
- return -1;
+ char *temp;
- retval = startup_my_perl( my_perl, file_path );
- if( retval < 0 )
- {
- cleanup_my_perl( my_perl );
- return retval;
+ temp = comedi_get_default_calibration_path( dev );
+ if( temp == NULL ) return -1;
+ strncpy( file_path, temp, sizeof( file_path ) );
+ free( temp );
}
- retval = check_cal_file( dev, my_perl );
- if( retval < 0 )
+ parsed_file = comedi_parse_calibration_file( file_path );
+ if( parsed_file == NULL )
{
- cleanup_my_perl( my_perl );
- return retval;
+ COMEDILIB_DEBUG( 3, "failed to parse calibration file\n" );
+ return -1;
}
- cal_index = find_calibration( my_perl, subdev, channel, range, aref );
- if( cal_index < 0 )
- {
- cleanup_my_perl( my_perl );
- return cal_index;
- }
+ retval = comedi_apply_parsed_calibration( dev, subdev, channel, range, aref, parsed_file );
- retval = set_calibration( dev, my_perl, cal_index );
- if( retval < 0 );
- {
- cleanup_my_perl( my_perl );
- return retval;
- }
+ comedi_cleanup_calibration( parsed_file );
- return 0;
+ return retval;
}
projects / comedilib.git / blobdiff