Changed comedi_set_calibration() to comedi_apply_calibration(), and

made it much faster, it takes <100msec to run instead of >1sec.
It requires linking to libperl now (hope that's
okay).  Renamed DEBUG() and _() in libinternal.h to COMEDILIB_DEBUG()
and GETTEXT() in order to avoid conflicts with perl headers.

diff --git a/doc/funcref b/doc/funcref
index ef440a44b0cbef7d428fcc1d1e6ec343de7518d0..545a068cb3ec4f157945ddf1a5f66d59927aae8c 100644 (file)
--- a/doc/funcref
+++ b/doc/funcref
@@ -831,7 +831,7 @@ Description:
 
  The previous out-of-range behavior is returned.
 
-Function: comedi_set_calibration -- set calibration
+Function: comedi_apply_calibration -- set calibration
 Retval: int
 Param: comedi_t * device
 Param: unsigned int subdevice

diff --git a/include/comedilib.h b/include/comedilib.h
index f63a2ebf973b2d2c5b3d4bf869409a1d06b61300..b24c944c6d058195425547234f17dd12968121b3 100644 (file)
--- a/include/comedilib.h
+++ b/include/comedilib.h
@@ -193,7 +193,7 @@ int comedi_get_rangetype(comedi_t *it,unsigned int subdevice,
    compatibility.  In practice, this is a holding place for the next
    library ABI version change.
  */
-int comedi_set_calibration( comedi_t *dev, unsigned int subdev, unsigned int channel,
+int comedi_apply_calibration( comedi_t *dev, unsigned int subdev, unsigned int channel,
        unsigned int range, unsigned int aref, const char *cal_file_path);
 
 

diff --git a/lib/Makefile b/lib/Makefile
index 4ca23d434e540bc4baedfacdc2c4f0dae267b86a..dea449b3246e337b65454f2febd0d87286204b3a 100644 (file)
--- a/lib/Makefile
+++ b/lib/Makefile
@@ -2,7 +2,10 @@
 include ../Config
 include ../version
 
-CFLAGS += -fPIC -I../include -I.
+PERL_LDFLAGS := -lperl $(shell perl -MConfig -e 'print $$Config{perllibs}')
+PERL_INC := $(shell perl -MConfig -e 'print $$Config{archlib}')/CORE
+
+CFLAGS += -fPIC -I../include -I. -I$(PERL_INC)
 
 OBJS=comedi.o timer.o sv.o range.o ioctl.o filler.o timed.o error.o \
        dio.o data.o get.o cmd.o buffer.o calib.o
@@ -11,7 +14,7 @@ SONAME=libcomedi$(SONAME_SUFFIX).so.0
 
 libcomedi.a: $(OBJS) version_script
        #$(CC) -shared -Wl,-soname,libcomedi.so,-T,version_script -o libcomedi.so.${VERSION_CODE} $(OBJS) -lm
-       $(CC) -shared -Wl,-soname,$(SONAME) -Wl,--version-script,version_script -o libcomedi.so.${version} $(OBJS) -lm
+       $(CC) -shared -Wl,-soname,$(SONAME) -Wl,--version-script,version_script -o libcomedi.so.${version} $(OBJS) -lm $(PERL_LDFLAGS)
        $(AR) rs libcomedi.a $(OBJS)
        ln -sf libcomedi.so.${version} libcomedi.so
        ln -sf libcomedi.so.${version} libcomedi.so.0

diff --git a/lib/calib.c b/lib/calib.c
index 7bb8fb4b2c667aeafd7580760ca4843bfebd23c3..c99433a805de1dd511b9309ab784c2941e7d4724 100644 (file)
--- a/lib/calib.c
+++ b/lib/calib.c
@@ -27,67 +27,36 @@
 #include <string.h>
 #include <comedilib.h>
 #include <libinternal.h>
+#include <EXTERN.h>
+#include <perl.h>
 
-static int extract_ph_string( const char *file_path, const char *hash_ref,
-       const char *element, char *result, unsigned int result_size )
+static int extract_ph_string( PerlInterpreter *my_perl, const char *perl_statement,
+       char *result, unsigned int result_size )
 {
-       char perl_prog[ 1024 ];
-       FILE *perl_stdout;
-       int retval;
-
-       snprintf( perl_prog, sizeof( perl_prog ),
-               "perl -e '
-               use strict;
-               use warnings;
-               my $hash;
-               my $%s;
-               $hash = `cat %s`;
-               eval \"\\$%s = $hash;\";
-               print %s;
-               '",
-               hash_ref, file_path, hash_ref, element );
-
-       perl_stdout = popen( perl_prog, "r");
-       if( perl_stdout == NULL )
-       {
-               fprintf( stderr, "popen() failed in ph_extract_element()\n" );
-               return -1;
-       }
-
-       if( fgets( result, result_size, perl_stdout ) == NULL )
-       {
-               fprintf( stderr, "fgets() returned NULL in ph_extract_element()\n" );
-               return -1;
-       }
-
-       retval = pclose( perl_stdout );
-       if( retval )
-       {
-               fprintf( stderr, "perl returned error %i\n in ph_extract_element()", retval );
-               return -1;
-       }
+       SV *perl_retval;
+       STRLEN len;
 
+       perl_retval = eval_pv( perl_statement, FALSE );
+       strncpy( result, SvPV( perl_retval, len ), result_size );
        return 0;
 }
 
-static int extract_ph_integer( const char *file_path, const char *hash_ref,
-       const char *element )
+static int extract_ph_integer( PerlInterpreter *my_perl, const char *perl_statement )
 {
-       char result[ 100 ];
-       int retval;
+       SV *perl_retval;
+       int result;
 
-       retval = extract_ph_string( file_path, hash_ref, element, result, sizeof( result ) );
-       if( retval < 0 ) return retval;
-
-       return strtol( result, NULL, 0 );
+       perl_retval = eval_pv( perl_statement, FALSE );
+       result = SvIV( perl_retval );
+       return result;
 }
 
-static int check_cal_file( comedi_t *dev, const char *file_path )
+static int check_cal_file( comedi_t *dev, PerlInterpreter *my_perl )
 {
        char result[ 100 ];
        int retval;
 
-       retval = extract_ph_string( file_path, "cal", "$cal->{driver_name}",
+       retval = extract_ph_string( my_perl, "$cal->{driver_name};",
                result, sizeof( result ) );
        if( retval < 0 ) return retval;
 
@@ -97,7 +66,7 @@ static int check_cal_file( comedi_t *dev, const char *file_path )
                return -1;
        }
 
-       retval = extract_ph_string( file_path, "cal", "$cal->{board_name}",
+       retval = extract_ph_string( my_perl, "$cal->{board_name};",
                result, sizeof( result ) );
        if( retval < 0 ) return retval;
 
@@ -110,89 +79,89 @@ static int check_cal_file( comedi_t *dev, const char *file_path )
        return 0;
 }
 
-static inline int num_calibrations( const char *file_path )
+static inline int num_calibrations( PerlInterpreter *my_perl )
 {
-       return extract_ph_integer( file_path, "cal", "scalar( @{$cal->{calibrations}} )" );
+       return extract_ph_integer( my_perl, "scalar( @{$cal->{calibrations}} );" );
 }
 
-static int extract_array_element( const char *file_path, unsigned int cal_index,
+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( file_path, "cal", element );
+               "$cal->{ calibrations }[ %i ]->{ %s }[ %i ];", cal_index, array_name, array_index );
+       return extract_ph_integer( my_perl, element );
 }
 
-static int extract_array_length( const char *file_path, unsigned int cal_index,
+static int extract_array_length( PerlInterpreter *my_perl, unsigned int cal_index,
        const char *array_name )
 {
        char element[ 100 ];
 
        snprintf( element, sizeof( element ),
-               "scalar( @{ $cal->{ calibrations }[ %i ]->{ %s } } )", cal_index, array_name );
-       return extract_ph_integer( file_path, "cal", element );
+               "scalar( @{ $cal->{ calibrations }[ %i ]->{ %s } } );", cal_index, array_name );
+       return extract_ph_integer( my_perl, element );
 }
 
-static int extract_subdevice( const char *file_path, unsigned int cal_index )
+static int extract_subdevice( PerlInterpreter *my_perl, unsigned int cal_index )
 {
        char element[ 100 ];
 
        snprintf( element, sizeof( element ),
-               "$cal->{ calibrations }[ %i ]->{ subdevice }", cal_index );
-       return extract_ph_integer( file_path, "cal", element );
+               "$cal->{ calibrations }[ %i ]->{ subdevice };", cal_index );
+       return extract_ph_integer( my_perl, element );
 }
 
-static int valid_item( const char *file_path, unsigned int cal_index,
+static int valid_item( PerlInterpreter *my_perl, unsigned int cal_index,
        const char *item_type, unsigned int item )
 {
        int num_items, i;
 
-       num_items = extract_array_length( file_path, cal_index, item_type );
+       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++ )
        {
-               if( extract_array_element( file_path, cal_index, item_type, i ) == item )
+               if( extract_array_element( my_perl, cal_index, item_type, i ) == item )
                        return 1;
        }
 
        return 0;
 }
 
-static inline int valid_range( const char *file_path, unsigned int cal_index,
+static inline int valid_range( PerlInterpreter *my_perl, unsigned int cal_index,
        unsigned int range )
 {
-       return valid_item( file_path, cal_index, "ranges", range );
+       return valid_item( my_perl, cal_index, "ranges", range );
 }
 
-static inline int valid_channel( const char *file_path, unsigned int cal_index,
+static inline int valid_channel( PerlInterpreter *my_perl, unsigned int cal_index,
        unsigned int channel )
 {
-       return valid_item( file_path, cal_index, "channels", channel );
+       return valid_item( my_perl, cal_index, "channels", channel );
 }
 
-static inline int valid_aref( const char *file_path, unsigned int cal_index,
+static inline int valid_aref( PerlInterpreter *my_perl, unsigned int cal_index,
        unsigned int aref )
 {
-       return valid_item( file_path, cal_index, "arefs", aref );
+       return valid_item( my_perl, cal_index, "arefs", aref );
 }
 
-static int find_calibration( const char *file_path, unsigned int subdev,
+static int find_calibration( PerlInterpreter *my_perl, unsigned int subdev,
        unsigned int channel, unsigned int range, unsigned int aref )
 {
        int num_cals, i;
 
-       num_cals = num_calibrations( file_path );
+       num_cals = num_calibrations( my_perl );
        if( num_cals < 0 ) return num_cals;
 
        for( i = 0; i < num_cals; i++ )
        {
-               if( extract_subdevice( file_path, i ) != subdev ) continue;
-               if( valid_range( file_path, i, range ) == 0 ) continue;
-               if( valid_channel( file_path, i, channel ) == 0 ) continue;
-               if( valid_aref( file_path, i, aref ) == 0 ) continue;
+               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( i == num_cals ) return -1;
@@ -200,12 +169,12 @@ static int find_calibration( const char *file_path, unsigned int subdev,
        return i;
 }
 
-static int set_calibration( comedi_t *dev, const char *file_path,
+static int set_calibration( comedi_t *dev, PerlInterpreter *my_perl,
        unsigned int cal_index )
 {
        int i, retval, num_caldacs;
 
-       num_caldacs = extract_array_length( file_path, cal_index, "caldacs" );
+       num_caldacs = extract_array_length( my_perl, cal_index, "caldacs" );
        if( num_caldacs < 0 ) return num_caldacs;
 
        for( i = 0; i < num_caldacs; i++ )
@@ -213,9 +182,9 @@ static int set_calibration( comedi_t *dev, const char *file_path,
                int subdev, channel, value;
                char *element;
 
-               asprintf( &element, "$cal->{calibrations}[ %i ]->{caldacs}[ %i ]->{subdevice}",
+               asprintf( &element, "$cal->{calibrations}[ %i ]->{caldacs}[ %i ]->{subdevice};",
                        cal_index, i );
-               subdev = extract_ph_integer( file_path, "cal", element );
+               subdev = extract_ph_integer( my_perl, element );
                free( element );
                if( subdev < 0 )
                {
@@ -223,9 +192,9 @@ static int set_calibration( comedi_t *dev, const char *file_path,
                        return subdev;
                }
 
-               asprintf( &element, "$cal->{calibrations}[ %i ]->{caldacs}[ %i ]->{channel}",
+               asprintf( &element, "$cal->{calibrations}[ %i ]->{caldacs}[ %i ]->{channel};",
                        cal_index, i );
-               channel = extract_ph_integer( file_path, "cal", element );
+               channel = extract_ph_integer( my_perl, element );
                free( element );
                if( channel < 0 )
                {
@@ -233,9 +202,9 @@ static int set_calibration( comedi_t *dev, const char *file_path,
                        return channel;
                }
 
-               asprintf( &element, "$cal->{calibrations}[ %i ]->{caldacs}[ %i ]->{value}",
+               asprintf( &element, "$cal->{calibrations}[ %i ]->{caldacs}[ %i ]->{value};",
                        cal_index, i );
-               value = extract_ph_integer( file_path, "cal", element );
+               value = extract_ph_integer( my_perl, element );
                free( element );
                if( value < 0 )
                {
@@ -250,14 +219,60 @@ static int set_calibration( comedi_t *dev, const char *file_path,
        return 0;
 }
 
-EXPORT_SYMBOL(comedi_set_calibration,0.7.20);
-int comedi_set_calibration( comedi_t *dev, unsigned int subdev, unsigned int channel,
+static PerlInterpreter* alloc_my_perl( void )
+{
+       PerlInterpreter *my_perl;
+       char *embedding[] = { "", "-e", "0" };
+
+       my_perl = perl_alloc();
+       if( my_perl == NULL )
+       {
+               fprintf( stderr, "failed to alloc perl interpreter\n");
+               return my_perl;
+       }
+       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 )
+{
+       int retval;
+       char perl_prog[ 1024 ];
+
+       snprintf( perl_prog, sizeof( perl_prog ),
+               "
+               my $hash = `cat '%s'`;
+               eval \"\\$cal = $hash;\";
+               ", file_path );
+
+       retval = perl_run( my_perl );
+       if( retval )
+       {
+               fprintf( stderr, "nonzero exit from perl_run\n");
+               return -1;
+       }
+       eval_pv( perl_prog, FALSE );
+
+       return 0;
+}
+
+static void cleanup_my_perl( PerlInterpreter *my_perl )
+{
+       perl_destruct( my_perl );
+       perl_free( my_perl );
+}
+
+EXPORT_SYMBOL(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;
 
        if( cal_file_path )
        {
@@ -275,14 +290,37 @@ int comedi_set_calibration( comedi_t *dev, unsigned int subdev, unsigned int cha
                        ( unsigned long ) file_stats.st_ino );
        }
 
-       retval = check_cal_file( dev, file_path );
-       if( retval < 0 ) return retval;
+       my_perl = alloc_my_perl();
+       if( my_perl == NULL )
+               return -1;
 
-       cal_index = find_calibration( file_path, subdev, channel, range, aref );
-       if( cal_index < 0 ) return cal_index;
-       
-       retval = set_calibration( dev, file_path, cal_index );
-       if( retval < 0 ) return retval;
+       retval = startup_my_perl( my_perl, file_path );
+       if( retval < 0 )
+       {
+               cleanup_my_perl( my_perl );
+               return retval;
+       }
+
+       retval = check_cal_file( dev, my_perl );
+       if( retval < 0 )
+       {
+               cleanup_my_perl( my_perl );
+               return retval;
+       }
+
+       cal_index = find_calibration( my_perl, subdev, channel, range, aref );
+       if( cal_index < 0 )
+       {
+               cleanup_my_perl( my_perl );
+               return cal_index;
+       }
+
+       retval = set_calibration( dev, my_perl, cal_index );
+       if( retval < 0 );
+       {
+               cleanup_my_perl( my_perl );
+               return retval;
+       }
 
        return 0;
 }

diff --git a/lib/cmd.c b/lib/cmd.c
index 21caf0f874707947b94ce531873b031ae02544c0..88ed2aaa99869ce0658846c15dbc99dbafcc1cb9 100644 (file)
--- a/lib/cmd.c
+++ b/lib/cmd.c
@@ -96,7 +96,7 @@ static int __generic_timed(comedi_t *it,unsigned int s,
                cmd->start_src=TRIG_INT;
                cmd->start_arg=0;
        }else{
-               DEBUG(3,"can't find good start_src\n");
+               COMEDILIB_DEBUG(3,"can't find good start_src\n");
                return -1;
        }
 
@@ -123,7 +123,7 @@ static int __generic_timed(comedi_t *it,unsigned int s,
                cmd->scan_begin_src = TRIG_TIMER;
                cmd->scan_begin_arg = ns;
        }else{
-               DEBUG(3,"comedi_get_cmd_generic_timed: can't do timed?\n");
+               COMEDILIB_DEBUG(3,"comedi_get_cmd_generic_timed: can't do timed?\n");
                return -1;
        }
 
@@ -137,18 +137,18 @@ static int __generic_timed(comedi_t *it,unsigned int s,
                cmd->stop_src=TRIG_NONE;
                cmd->stop_arg=0;
        }else{
-               DEBUG(3,"comedi_get_cmd_generic_timed: can't find a good stop_src\n");
+               COMEDILIB_DEBUG(3,"comedi_get_cmd_generic_timed: can't find a good stop_src\n");
                return -1;
        }
 
        cmd->chanlist_len = 1;
 
        ret=comedi_command_test(it,cmd);
-       DEBUG(3,"comedi_get_cmd_generic_timed: test 1 returned %d\n",ret);
+       COMEDILIB_DEBUG(3,"comedi_get_cmd_generic_timed: test 1 returned %d\n",ret);
        if(ret==3){
                /* good */
                ret=comedi_command_test(it,cmd);
-               DEBUG(3,"comedi_get_cmd_generic_timed: test 2 returned %d\n",ret);
+               COMEDILIB_DEBUG(3,"comedi_get_cmd_generic_timed: test 2 returned %d\n",ret);
        }
        if(ret==4 || ret==0){
                __comedi_errno = 0;

diff --git a/lib/comedi.c b/lib/comedi.c
index e7d6951146d6b463be419c46df8327405034f1fa..7c6a69e9f544f33b7c3d27e4252d9900328a2166 100644 (file)
--- a/lib/comedi.c
+++ b/lib/comedi.c
@@ -45,7 +45,7 @@ INTERNAL void initialize(void)
 
        if( (s=getenv("COMEDILIB_LOGLEVEL")) ){
                __comedi_loglevel=strtol(s,NULL,0);
-               DEBUG(3,"setting loglevel to %d\n",__comedi_loglevel);
+               COMEDILIB_DEBUG(3,"setting loglevel to %d\n",__comedi_loglevel);
        }
 }
   

diff --git a/lib/error.c b/lib/error.c
index 4881f247a268f1017549ac4cd9c7c1e7035f70c5..b8740debc3b3db937006a93f75f006e2a7485ec6 100644 (file)
--- a/lib/error.c
+++ b/lib/error.c
@@ -65,7 +65,7 @@ char *comedi_strerror(int errnum)
        if(errnum<COMEDI_NOERROR || errnum>=COMEDI_NOERROR+n_errors)
                return strerror(errnum);
 
-       return _(__comedilib_error_strings[errnum-COMEDI_NOERROR]);
+       return GETTEXT(__comedilib_error_strings[errnum-COMEDI_NOERROR]);
 }
 
 EXPORT_SYMBOL(comedi_perror,0.7.18);

diff --git a/lib/libinternal.h b/lib/libinternal.h
index 86173345778e1c1c42c90a082366136aeee3bab3..139ba55d915969fc70ae5787f7785316ccf659cd 100644 (file)
--- a/lib/libinternal.h
+++ b/lib/libinternal.h
@@ -43,9 +43,9 @@
 /* gettext()ization */
 
 #ifdef I18N
-#define _(a) gettext((a))
+#define GETTEXT(a) gettext((a))
 #else
-#define _(a) (a)
+#define GETTEXT(a) (a)
 #endif
 #define _s(a) (a)
 
@@ -53,7 +53,7 @@
 #define debug_ptr(a)    if(!(a))fprintf(stderr," ** NULL pointer: " __FILE__ ", line %d\n",__LINE__);
 #define debug_int(a)    if((a)<0)fprintf(stderr," ** error: " __FILE__ ", line %d\n",__LINE__);
 
-#define DEBUG(level,format,args...) do{if(__comedi_loglevel>=(level))fprintf(stderr,__FUNCTION__ ": " format, ## args);}while(0)
+#define COMEDILIB_DEBUG(level,format,args...) do{if(__comedi_loglevel>=(level))fprintf(stderr,__FUNCTION__ ": " format, ## args);}while(0)
 
 #define COMEDI_VERSION_CODE(a,b,c) (((a)<<16) | ((b)<<8) | (c))