From d7ee6c4556d01f01024b242c00d73eca7a0fdb91 Mon Sep 17 00:00:00 2001 From: Philipp Date: Tue, 5 Mar 2024 18:09:50 +0100 Subject: [PATCH] Updated TTY interface. --- .github/workflows/build.yml | 1 - Makefile | 18 +-- app/dmfs.f90 | 82 ++++++++---- app/dmpipe.f90 | 249 +++++++++++++++++++++++------------- app/dmserial.f90 | 160 +++++++++++++---------- guide/guide.adoc | 147 ++++++++++++--------- src/dm_db.f90 | 2 +- src/dm_geocom.f90 | 89 ++++++++++--- src/dm_tty.f90 | 165 ++++++++++++++++++++---- src/dm_util.f90 | 12 +- 10 files changed, 625 insertions(+), 300 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 16c5679..25d0c4e 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -26,7 +26,6 @@ jobs: - name: Configure System (Linux) if: contains(matrix.os, 'ubuntu') run: | - ls -al /dev/ sudo sysctl fs.mqueue.msg_max=100 sudo sysctl fs.mqueue.msgsize_max=16384 diff --git a/Makefile b/Makefile index bd66a15..84703e4 100644 --- a/Makefile +++ b/Makefile @@ -213,11 +213,11 @@ SRC = src/dm_version.f90 src/dm_kind.f90 src/dm_platform.f90 src/dm_ascii.f90 \ src/dm_time.f90 src/dm_timer.f90 src/dm_base64.f90 src/dm_path.f90 \ src/dm_file.f90 src/dm_hash.f90 src/dm_hash_table.f90 src/dm_hdf5.f90 \ src/dm_unit.f90 src/dm_id.f90 src/dm_uuid.f90 src/dm_arg.f90 \ - src/dm_signal.f90 src/dm_system.f90 src/dm_pipe.f90 src/dm_tty.f90 \ - src/dm_sem.f90 src/dm_mutex.f90 src/dm_dp.f90 src/dm_fifo.f90 \ - src/dm_node.f90 src/dm_sensor.f90 src/dm_target.f90 src/dm_response.f90 \ - src/dm_request.f90 src/dm_observ.f90 src/dm_log.f90 src/dm_job.f90 \ - src/dm_plot.f90 src/dm_report.f90 src/dm_regex.f90 src/dm_sync.f90 \ + src/dm_signal.f90 src/dm_system.f90 src/dm_pipe.f90 src/dm_sem.f90 \ + src/dm_mutex.f90 src/dm_dp.f90 src/dm_fifo.f90 src/dm_node.f90 \ + src/dm_sensor.f90 src/dm_target.f90 src/dm_response.f90 src/dm_request.f90 \ + src/dm_observ.f90 src/dm_log.f90 src/dm_job.f90 src/dm_tty.f90 \ + src/dm_plot.f90 src/dm_report.f90 src/dm_regex.f90 src/dm_sync.f90 \ src/dm_beat.f90 src/dm_mqueue.f90 src/dm_logger.f90 src/dm_test.f90 \ src/dm_nml.f90 src/dm_sql.f90 src/dm_db.f90 src/dm_z.f90 src/dm_person.f90 \ src/dm_mail.f90 src/dm_http.f90 src/dm_mime.f90 src/dm_api.f90 \ @@ -234,9 +234,9 @@ OBJ = dm_version.o dm_kind.o dm_platform.o dm_ascii.o dm_const.o dm_error.o \ dm_string.o dm_type.o dm_format.o dm_ansi.o dm_env.o dm_util.o dm_time.o \ dm_timer.o dm_base64.o dm_path.o dm_file.o dm_hash.o dm_hash_table.o \ dm_hdf5.o dm_unit.o dm_id.o dm_uuid.o dm_arg.o dm_signal.o dm_system.o \ - dm_pipe.o dm_tty.o dm_sem.o dm_mutex.o dm_dp.o dm_fifo.o dm_node.o \ - dm_sensor.o dm_target.o dm_response.o dm_request.o dm_observ.o dm_log.o \ - dm_job.o dm_plot.o dm_report.o dm_regex.o dm_sync.o dm_beat.o dm_mqueue.o \ + dm_pipe.o dm_sem.o dm_mutex.o dm_dp.o dm_fifo.o dm_node.o dm_sensor.o \ + dm_target.o dm_response.o dm_request.o dm_observ.o dm_log.o dm_job.o \ + dm_tty.o dm_plot.o dm_report.o dm_regex.o dm_sync.o dm_beat.o dm_mqueue.o \ dm_logger.o dm_test.o dm_nml.o dm_sql.o dm_db.o dm_z.o dm_person.o dm_mail.o \ dm_http.o dm_mime.o dm_api.o dm_rpc.o dm_mqtt.o dm_cgi.o dm_fcgi.o dm_block.o \ dm_csv.o dm_json.o dm_jsonl.o dm_html.o dm_atom.o dm_cgi_router.o dm_la.o \ @@ -381,7 +381,6 @@ $(OBJ): $(SRC) $(FC) $(FFLAGS) $(LDFLAGS) -c src/dm_signal.f90 $(FC) $(FFLAGS) $(LDFLAGS) -c src/dm_system.f90 $(FC) $(FFLAGS) $(LDFLAGS) -c src/dm_pipe.f90 - $(FC) $(FFLAGS) $(LDFLAGS) -c src/dm_tty.f90 $(FC) $(FFLAGS) $(LDFLAGS) -c src/dm_sem.f90 $(FC) $(FFLAGS) $(LDFLAGS) -c src/dm_mutex.f90 $(FC) $(FFLAGS) $(LDFLAGS) -c src/dm_dp.f90 @@ -394,6 +393,7 @@ $(OBJ): $(SRC) $(FC) $(FFLAGS) $(LDFLAGS) -c src/dm_observ.f90 $(FC) $(FFLAGS) $(LDFLAGS) -c src/dm_log.f90 $(FC) $(FFLAGS) $(LDFLAGS) -c src/dm_job.f90 + $(FC) $(FFLAGS) $(LDFLAGS) -c src/dm_tty.f90 $(FC) $(FFLAGS) $(LDFLAGS) -c src/dm_plot.f90 $(FC) $(FFLAGS) $(LDFLAGS) -c src/dm_report.f90 $(FC) $(FFLAGS) $(LDFLAGS) -c src/dm_regex.f90 diff --git a/app/dmfs.f90 b/app/dmfs.f90 index 22e02c1..f1cba20 100644 --- a/app/dmfs.f90 +++ b/app/dmfs.f90 @@ -221,13 +221,17 @@ integer function read_observ(observ, node_id, sensor_id, source, debug) result(r character(len=*), intent(in) :: source !! Source of observation. logical, intent(in), optional :: debug !! Output debug messages. + character(len=REQUEST_RESPONSE_LEN) :: raw ! Raw response (unescaped). + integer :: delay integer :: fu, stat - integer :: i, j + integer :: i, j, n logical :: debug_ type(request_type), pointer :: request ! Next request to execute. type(response_type), pointer :: response ! Single response in request. + rc = E_EMPTY + debug_ = .true. if (present(debug)) debug_ = debug @@ -238,16 +242,21 @@ integer function read_observ(observ, node_id, sensor_id, source, debug) result(r observ%source = source observ%timestamp = dm_time_now() - if (observ%nrequests == 0) then + n = observ%nrequests + + if (n == 0) then if (debug_) call dm_log_debug('no requests in observ ' // observ%name, observ=observ) + observ%error = rc return end if ! Read files in requests sequentially. - req_loop: do i = 1, observ%nrequests + req_loop: do i = 1, n ! Get pointer to next request. request => observ%requests(i) + if (debug_) call dm_log_debug('starting ' // request_name_string(request%name, i, n), observ=observ) + ! Initialise request. request%timestamp = dm_time_now() request%error = E_IO @@ -264,23 +273,28 @@ integer function read_observ(observ, node_id, sensor_id, source, debug) result(r if (stat == 0) request%error = E_NONE if (dm_is_error(request%error)) then - call dm_log_error('failed to open ' // trim(request%request), & + call dm_log_error('failed to open file ' // trim(request%request), & observ=observ, error=request%error) cycle req_loop end if - ! Read until the request pattern matches. + ! Read until the request pattern matches or end is reached. read_loop: do rc = E_EOF - read (fu, '(a)', iostat=stat) request%response + read (fu, '(a)', iostat=stat) raw if (is_iostat_end(stat)) exit read_loop if (stat /= 0) cycle read_loop ! Try to extract the response values. + request%response = dm_ascii_escape(raw) rc = dm_regex_request(request) if (dm_is_error(rc)) then - if (debug_) call dm_log_debug('line does not match pattern', observ=observ, error=rc) + if (debug_) then + call dm_log_debug('response of ' // request_name_string(request%name, i) // & + ' does not match pattern', observ=observ, error=request%error) + end if + cycle read_loop end if @@ -288,8 +302,10 @@ integer function read_observ(observ, node_id, sensor_id, source, debug) result(r do j = 1, request%nresponses response => request%responses(j) if (dm_is_ok(response%error)) cycle + call dm_log_warning('failed to extract response ' // trim(response%name) // & - ' of request ' // dm_itoa(i), observ=observ, error=response%error) + ' of ' // request_name_string(request%name, i), & + observ=observ, error=response%error) end do ! Cycle on error or exit on success. @@ -300,9 +316,7 @@ integer function read_observ(observ, node_id, sensor_id, source, debug) result(r ! Close file. close (fu) - ! Save response and return code. - request%response = dm_ascii_escape(request%response) - request%error = rc + request%error = rc ! Create log message and repeat. if (dm_is_error(rc)) then @@ -311,24 +325,42 @@ integer function read_observ(observ, node_id, sensor_id, source, debug) result(r cycle req_loop end if - if (debug_) then - call dm_log_debug('finished request ' // dm_itoa(i) // ' of ' // & - dm_itoa(observ%nrequests), observ=observ) - end if + if (debug_) call dm_log_debug('finished ' // request_name_string(request%name, i, n), observ=observ) ! Wait the set delay time of the request. delay = max(0, request%delay) if (delay <= 0) cycle req_loop - if (debug_) then - call dm_log_debug('next request of observ ' // trim(observ%name) // & + if (debug_ .and. i < n) then + call dm_log_debug('next ' // request_name_string(observ%requests(i + 1)%name, i + 1, n, observ%name) // & ' in ' // dm_itoa(delay / 1000) // ' sec', observ=observ) + else if (debug_) then + call dm_log_debug('next observ in ' // dm_itoa(delay / 1000) // ' sec', observ=observ) end if - call dm_usleep(delay * 1000) + call dm_usleep(delay * 1000) ! [msec] to [us]. end do req_loop end function read_observ + pure function request_name_string(request_name, i, n, observ_name) result(str) + !! Returns string of request name and index for logging. + character(len=*), intent(in) :: request_name !! Request name. + integer, intent(in) :: i !! Request index. + integer, intent(in), optional :: n !! Number of requests in observation. + character(len=*), intent(in), optional :: observ_name !! Observation name. + character(len=:), allocatable :: str !! Result. + + if (present(n)) then + str = 'request ' // trim(request_name) // ' (' // dm_itoa(i) // ')' + else + str = 'request ' // trim(request_name) // ' (' // dm_itoa(i) // ' of ' // dm_itoa(n) // ')' + end if + + if (present(observ_name)) then + str = str // ' of observ ' // trim(observ_name) + end if + end function request_name_string + integer function write_observ(observ, unit, format) result(rc) !! Writes observation to file unit, in CSV or JSON Lines format. type(observ_type), intent(inout) :: observ !! Observation to write. @@ -385,23 +417,23 @@ subroutine run(app) observ => job%observ if (debug) then - call dm_log_debug('starting observ ' // trim(observ%name) // & - ' for sensor ' // app%sensor, observ=observ) + call dm_log_debug('starting observ ' // trim(observ%name) // ' for sensor ' // & + app%sensor, observ=observ) end if ! Read observation from file system. rc = read_observ(observ, app%node, app%sensor, app%name, debug=debug) - if (debug) then - call dm_log_debug('finished observ ' // trim(observ%name) // & - ' for sensor ' // app%sensor, observ=observ) - end if - ! Forward observation via message queue. rc = dm_mqueue_forward(observ, app%name, APP_MQ_BLOCKING) ! Output observation. rc = output_observ(observ, app%output_type) + + if (debug) then + call dm_log_debug('finished observ ' // trim(observ%name) // ' for sensor ' // & + app%sensor, observ=observ) + end if end if ! Wait delay time of the job if set (absolute). diff --git a/app/dmpipe.f90 b/app/dmpipe.f90 index fcd003c..80590d3 100644 --- a/app/dmpipe.f90 +++ b/app/dmpipe.f90 @@ -214,6 +214,154 @@ integer function read_config(app) result(rc) call dm_config_close(config) end function read_config + integer function read_observ(pipe, observ, node_id, sensor_id, source, debug) result(rc) + !! Reads observation from pipe. + type(pipe_type), intent(inout) :: pipe !! Pipe to read from. + type(observ_type), target, intent(inout) :: observ !! Observation to read. + character(len=*), intent(in) :: node_id !! Node id of observation. + character(len=*), intent(in) :: sensor_id !! Sensor id of observation. + character(len=*), intent(in) :: source !! Source of observation. + logical, intent(in), optional :: debug !! Output debug messages. + + character(len=REQUEST_RESPONSE_LEN) :: raw ! Raw response (unescaped). + + integer :: delay + integer :: i, j, n + integer(kind=i8) :: sz + logical :: debug_ + + type(request_type), pointer :: request ! Next request to execute. + type(response_type), pointer :: response ! Response in request. + + rc = E_EMPTY + + debug_ = .true. + if (present(debug)) debug_ = debug + + ! Initialise observation. + observ%id = dm_uuid4() + observ%node_id = node_id + observ%sensor_id = sensor_id + observ%source = source + observ%timestamp = dm_time_now() + + n = observ%nrequests + + if (n == 0) then + if (debug_) call dm_log_debug('no requests in observ ' // observ%name, observ=observ) + observ%error = rc + return + end if + + ! Read files in requests sequentially. + req_loop: do i = 1, n + ! Get pointer to next request. + request => observ%requests(i) + + if (debug_) call dm_log_debug('starting ' // request_name_string(request%name, i, n), observ=observ) + + ! Initialise request. + request%timestamp = dm_time_now() + request%error = E_IO + + ! Open pipe. + rc = dm_pipe_open(pipe, request%request, PIPE_RDONLY) + + if (dm_is_error(rc)) then + call dm_pipe_close(pipe) + call dm_log_error('failed to open pipe to ' // request%request, observ=observ, error=rc) + cycle req_loop + end if + + ! Read until the request pattern matches or end is reached. + pipe_loop: do + ! Read from pipe. + rc = E_READ + sz = dm_pipe_read(pipe, raw) + if (sz == 0) exit pipe_loop + + request%response = dm_ascii_escape(raw) + + ! Try to extract the response values. + if (debug_) then + call dm_log_debug('parsing response of ' // request_name_string(request%name, i), & + observ=observ) + end if + + rc = dm_regex_request(request) + + if (dm_is_error(rc)) then + if (debug_) then + call dm_log_debug('response of ' // request_name_string(request%name, i) // & + ' does not match pattern', observ=observ, error=request%error) + end if + + cycle pipe_loop + end if + + ! Check responses. + do j = 1, request%nresponses + response => request%responses(j) + if (dm_is_ok(response%error)) cycle + + call dm_log_warning('failed to extract response ' // trim(response%name) // & + ' of ' // request_name_string(request%name, i), & + observ=observ, error=response%error) + end do + + ! Cycle on error. + if (dm_is_error(rc)) cycle pipe_loop + + exit pipe_loop + end do pipe_loop + + ! Close pipe. + call dm_pipe_close(pipe) + + request%error = rc + + if (dm_is_error(rc)) then + call dm_log_error('failed to read from process ' // request%request, observ=observ, error=rc) + call dm_sleep(10) ! Wait grace period. + cycle req_loop + end if + + if (debug_) call dm_log_debug('finished ' // request_name_string(request%name, i, n), observ=observ) + + ! Wait the set delay time of the request. + delay = max(0, request%delay) + if (delay <= 0) cycle req_loop + + if (debug_ .and. i < n) then + call dm_log_debug('next ' // request_name_string(observ%requests(i + 1)%name, i + 1, n, observ%name) // & + ' in ' // dm_itoa(delay / 1000) // ' sec', observ=observ) + else if (debug_) then + call dm_log_debug('next observ in ' // dm_itoa(delay / 1000) // ' sec', observ=observ) + end if + + call dm_usleep(delay * 1000) ! [msec] to [us]. + end do req_loop + end function read_observ + + pure function request_name_string(request_name, i, n, observ_name) result(str) + !! Returns string of request name and index for logging. + character(len=*), intent(in) :: request_name !! Request name. + integer, intent(in) :: i !! Request index. + integer, intent(in), optional :: n !! Number of requests in observation. + character(len=*), intent(in), optional :: observ_name !! Observation name. + character(len=:), allocatable :: str !! Result. + + if (present(n)) then + str = 'request ' // trim(request_name) // ' (' // dm_itoa(i) // ')' + else + str = 'request ' // trim(request_name) // ' (' // dm_itoa(i) // ' of ' // dm_itoa(n) // ')' + end if + + if (present(observ_name)) then + str = str // ' of observ ' // trim(observ_name) + end if + end function request_name_string + integer function write_observ(observ, unit, format) result(rc) !! Writes observation to file unit, in CSV or JSON Lines format. type(observ_type), intent(inout) :: observ @@ -236,16 +384,13 @@ subroutine run(app) !! Performs jobs in job list. type(app_type), intent(inout) :: app - integer :: delay, njobs - integer :: i, j, rc - integer(kind=i8) :: sz - logical :: debug + integer :: delay, njobs + integer :: rc + logical :: debug - type(job_type), target :: job ! Next job to run. - type(pipe_type) :: pipe ! Pipe to process. - type(observ_type), pointer :: observ ! Next observation to perform. - type(request_type), pointer :: request ! Next request to execute. - type(response_type), pointer :: response ! Response in request. + type(job_type), target :: job ! Next job to run. + type(pipe_type) :: pipe ! Pipe to process. + type(observ_type), pointer :: observ ! Next observation to perform. debug = (app%debug .or. app%verbose) @@ -273,96 +418,18 @@ subroutine run(app) observ_if: if (job%valid) then ! Get pointer to job observation. observ => job%observ - if (debug) call dm_log_debug('starting observ ' // observ%name, observ=observ) - ! Initialise observation. - observ%id = dm_uuid4() - observ%node_id = app%node - observ%sensor_id = app%sensor - observ%source = app%name - observ%timestamp = dm_time_now() - - if (observ%nrequests == 0) then - if (debug) call dm_log_debug('no requests in observ ' // observ%name, observ=observ) - exit observ_if - end if - - ! Read files in requests sequentially. - req_loop: do i = 1, observ%nrequests - ! Get pointer to next request. - request => observ%requests(i) - - ! Initialise request. - request%timestamp = dm_time_now() - request%error = E_IO - - rc = dm_pipe_open(pipe, request%request, PIPE_RDONLY) - - if (dm_is_error(rc)) then - call dm_pipe_close(pipe) - call dm_log_error('failed to open pipe to ' // request%request, & - observ=observ, error=rc) - cycle req_loop - end if - - ! Read until the request pattern matches. - read_loop: do - ! Read from pipe. - rc = E_READ - sz = dm_pipe_read(pipe, request%response) - if (sz == 0) exit read_loop - - ! Try to extract the response values. - rc = dm_regex_request(request) - - if (dm_is_error(rc)) then - call dm_log_warning('response to request ' // dm_itoa(i) // ' does not match pattern', & - observ=observ, error=rc) - cycle read_loop - end if - - ! Check responses. - do j = 1, request%nresponses - response => request%responses(j) - if (dm_is_ok(response%error)) cycle - call dm_log_warning('failed to read response ' // response%name, & - observ=observ, error=response%error) - end do - - exit read_loop - end do read_loop - - call dm_pipe_close(pipe) - - request%response = dm_ascii_escape(request%response) - request%error = rc - - if (dm_is_error(rc)) then - call dm_log_error('failed to read from process ' // request%request, & - observ=observ, error=rc) - cycle req_loop - end if - - call dm_log_debug('finished request ' // dm_itoa(i) // ' of ' // & - dm_itoa(observ%nrequests), observ=observ) - - ! Wait the set delay time of the request. - delay = max(0, request%delay) - if (delay <= 0) cycle req_loop - if (debug) then - call dm_log_debug('next request of observ ' // trim(observ%name) // & - ' in ' // dm_itoa(delay / 1000) // ' sec', observ=observ) - end if - call dm_usleep(delay * 1000) - end do req_loop + ! Read observation. + rc = read_observ(pipe, observ, app%node, app%sensor, app%name, debug=debug) ! Forward observation. - if (debug) call dm_log_debug('finished observ ' // observ%name, observ=observ) rc = dm_mqueue_forward(observ, app%name, APP_MQ_BLOCKING) ! Output observation. rc = output_observ(observ, app%output_type) + + if (debug) call dm_log_debug('finished observ ' // observ%name, observ=observ) end if observ_if ! Wait the set delay time of the job (absolute). diff --git a/app/dmserial.f90 b/app/dmserial.f90 index 21398e7..f92ba5e 100644 --- a/app/dmserial.f90 +++ b/app/dmserial.f90 @@ -315,97 +315,111 @@ integer function read_config(app) result(rc) call dm_config_close(config) end function read_config - integer function read_observ(tty, observ, debug) result(rc) - !! Sends requests sequentially to sensor and reads responses. - type(tty_type), intent(inout) :: tty !! TTY type. - type(observ_type), target, intent(inout) :: observ !! Observation to read. - logical, intent(in), optional :: debug !! Output debug messages. - - character(len=REQUEST_REQUEST_LEN) :: raw_request ! Raw request (unescaped). - character(len=REQUEST_RESPONSE_LEN) :: raw_response ! Raw response (unescaped). - character(len=REQUEST_DELIMITER_LEN) :: raw_delimiter ! Raw delimiter (unescaped). + integer function read_observ(tty, observ, node_id, sensor_id, source, debug) result(rc) + !! Sends requests sequentially to sensor and reads responses. + type(tty_type), intent(inout) :: tty !! TTY type. + type(observ_type), target, intent(inout) :: observ !! Observation to read. + character(len=*), intent(in) :: node_id !! Node id of observation. + character(len=*), intent(in) :: sensor_id !! Sensor id of observation. + character(len=*), intent(in) :: source !! Source of observation. + logical, intent(in), optional :: debug !! Output debug messages. integer :: delay - integer :: i, j + integer :: i, j, n logical :: debug_ ! Create debug messages only if necessary. type(request_type), pointer :: request ! Next request to execute. type(response_type), pointer :: response ! Single response in request. + rc = E_EMPTY + debug_ = .true. if (present(debug)) debug_ = debug - rc = E_EMPTY - + ! Initialise observation. observ%id = dm_uuid4() + observ%node_id = node_id + observ%sensor_id = sensor_id + observ%source = source observ%timestamp = dm_time_now() + observ%path = trim(tty%path) - if (observ%nrequests == 0) then + n = observ%nrequests + + if (n == 0) then call dm_log_info('no requests in observ ' // observ%name, observ=observ) observ%error = rc return end if ! Read files in requests sequentially. - req_loop: do i = 1, observ%nrequests + req_loop: do i = 1, n request => observ%requests(i) if (debug_) then - call dm_log_debug('starting request ' // dm_itoa(i) // ' of ' // & - dm_itoa(observ%nrequests), observ=observ) - call dm_log_debug('sending request: ' // request%request, observ=observ) + call dm_log_debug('sending ' // request_name_string(request%name, i, n) // & + ': ' // request%request, observ=observ) end if ! Prepare request. rc = dm_request_set_response_error(request, E_INCOMPLETE) - raw_request = dm_ascii_unescape(request%request) - raw_delimiter = dm_ascii_unescape(request%delimiter) - raw_response = ' ' - request%response = ' ' request%timestamp = dm_time_now() ! Send request to sensor. - request%error = dm_tty_flush(tty, output=.false.) - request%error = dm_tty_write(tty, trim(raw_request)) + rc = dm_tty_write(tty, request, flush=.true.) if (dm_is_error(request%error)) then - call dm_log_error('failed to write to TTY ' // app%tty, observ=observ, & - error=request%error) + request%error = rc + call dm_log_error('failed to write ' // request_name_string(request%name, i) // & + ' to TTY ' // app%tty, observ=observ, error=rc) cycle req_loop end if ! Ignore sensor response if no delimiter is set. - if (len_trim(raw_delimiter) == 0) then - if (debug_) call dm_log_debug('no delimiter set in request ' // dm_itoa(i), observ=observ) + if (len_trim(request%delimiter) == 0) then + if (debug_) then + call dm_log_debug('no delimiter in ' // request_name_string(request%name, i), observ=observ) + end if + cycle req_loop end if ! Read sensor response from TTY. - request%error = dm_tty_read(tty, raw_response, trim(raw_delimiter)) - request%response = dm_ascii_escape(raw_response) + rc = dm_tty_read(tty, request) - if (dm_is_error(request%error)) then - call dm_log_error('failed to read from TTY ' // app%tty, & - observ=observ, error=request%error) + if (dm_is_error(rc)) then + request%error = rc + call dm_log_error('failed to read response of ' // request_name_string(request%name, i) // & + ' from TTY ' // app%tty, observ=observ, error=request%error) cycle req_loop end if - if (debug_) call dm_log_debug('received response: ' // raw_response, observ=observ) + if (debug_) then + call dm_log_debug('received response for ' // request_name_string(request%name, i) // & + ': ' // request%response, observ=observ) + end if ! Do not extract responses if no pattern is set. if (len_trim(request%pattern) == 0) then - if (debug_) call dm_log_debug('no pattern in request ' // dm_itoa(i), observ=observ) + if (debug_) then + call dm_log_debug('no pattern in ' // request_name_string(request%name, i), observ=observ) + end if cycle req_loop end if ! Try to extract the response values if a regex pattern is given. - if (debug_) call dm_log_debug('extracting response values of request ' // dm_itoa(i), observ=observ) - request%error = dm_regex_request(request) + if (debug_) then + call dm_log_debug('parsing response of ' // request_name_string(request%name, i), & + observ=observ) + end if - if (dm_is_error(request%error)) then - call dm_log_warning('response to request ' // dm_itoa(i) // ' does not match pattern', & - observ=observ, error=request%error) + rc = dm_regex_request(request) + + if (dm_is_error(rc)) then + request%error = rc + call dm_log_warning('response of ' // request_name_string(request%name, i) // & + ' does not match pattern', observ=observ, error=request%error) cycle req_loop end if @@ -415,33 +429,55 @@ integer function read_observ(tty, observ, debug) result(rc) if (dm_is_error(response%error)) then call dm_log_warning('failed to extract response ' // trim(response%name) // & - ' of request ' // dm_itoa(i), observ=observ, error=response%error) + ' of ' // request_name_string(request%name, i), & + observ=observ, error=response%error) cycle end if if (debug_) then - call dm_log_debug('extracted response ' // trim(response%name) // & - ' of request ' // dm_itoa(i), observ=observ) + call dm_log_debug('extracted response ' // trim(response%name) // ' of ' // & + request_name_string(request%name, i), observ=observ) end if end do if (debug_) then - call dm_log_debug('finished request ' // dm_itoa(i) // ' of ' // & - dm_itoa(observ%nrequests), observ=observ) + call dm_log_debug('finished ' // request_name_string(request%name, i, n), observ=observ) end if ! Wait the set delay time of the request. delay = max(0, request%delay) if (delay <= 0) cycle req_loop - if (debug_) then - call dm_log_debug('next request of observ ' // trim(observ%name) // & + + if (debug_ .and. i < n) then + call dm_log_debug('next ' // request_name_string(observ%requests(i + 1)%name, i + 1, n, observ%name) // & ' in ' // dm_itoa(delay / 1000) // ' sec', observ=observ) + else if (debug_) then + call dm_log_debug('next observ in ' // dm_itoa(delay / 1000) // ' sec', observ=observ) end if - call dm_usleep(delay * 1000) + call dm_usleep(delay * 1000) ! [msec] to [us]. end do req_loop end function read_observ + pure function request_name_string(request_name, i, n, observ_name) result(str) + !! Returns string of request name and index for logging. + character(len=*), intent(in) :: request_name !! Request name. + integer, intent(in) :: i !! Request index. + integer, intent(in), optional :: n !! Number of requests in observation. + character(len=*), intent(in), optional :: observ_name !! Observation name. + character(len=:), allocatable :: str !! Result. + + if (present(n)) then + str = 'request ' // trim(request_name) // ' (' // dm_itoa(i) // ')' + else + str = 'request ' // trim(request_name) // ' (' // dm_itoa(i) // ' of ' // dm_itoa(n) // ')' + end if + + if (present(observ_name)) then + str = str // ' of observ ' // trim(observ_name) + end if + end function request_name_string + integer function run(app, tty) result(rc) !! Performs jobs in job list. type(app_type), intent(inout) :: app !! App settings. @@ -455,16 +491,16 @@ integer function run(app, tty) result(rc) debug = (app%debug .or. app%verbose) call dm_log_info('started ' // app%name) + + ! Try to open TTY/PTY. call dm_log_debug('opening TTY ' // trim(app%tty) // ' to sensor ' // trim(app%sensor) // & ' (' // dm_itoa(tty%baud_rate) // ' ' // dm_itoa(app%byte_size) // & dm_upper(app%parity(1:1)) // dm_itoa(app%stop_bits) // ')') - ! Open TTY/PTY. do rc = dm_tty_open(tty) if (dm_is_ok(rc)) exit - call dm_log_error('failed to open TTY ' // app%tty, error=rc) - call dm_log_debug('trying to open TTY again in 5 sec', error=rc) + call dm_log_error('failed to open TTY ' // trim(app%tty) // ', trying again in 5 sec', error=rc) call dm_sleep(5) end do @@ -492,37 +528,31 @@ integer function run(app, tty) result(rc) ! Get pointer to job observation. observ => job%observ - ! Initialise observation. - observ%node_id = app%node - observ%sensor_id = app%sensor - observ%source = app%name - observ%path = trim(app%tty) - if (debug) then - call dm_log_debug('starting observ ' // trim(observ%name) // & - ' for sensor ' // app%sensor, observ=observ) + call dm_log_debug('starting observ ' // trim(observ%name) // ' for sensor ' // & + app%sensor, observ=observ) end if ! Read observation from TTY. - rc = read_observ(tty, observ, debug=debug) - - if (debug) then - call dm_log_debug('finished observ ' // trim(observ%name) // & - ' for sensor ' // app%sensor, observ=observ) - end if + rc = read_observ(tty, observ, app%node, app%sensor, app%name, debug=debug) ! Forward observation. rc = dm_mqueue_forward(observ, app%name, blocking=APP_MQ_BLOCKING) ! Output observation. rc = output_observ(observ, app%output_type) + + if (debug) then + call dm_log_debug('finished observ ' // trim(observ%name) // ' for sensor ' // & + app%sensor, observ=observ) + end if end if ! Wait the set delay time of the job (absolute). delay = max(0, job%delay) if (delay <= 0) cycle job_loop if (debug) call dm_log_debug('next job in ' // dm_itoa(delay / 1000) // ' sec', observ=observ) - call dm_usleep(delay * 1000) + call dm_usleep(delay * 1000) ! [msec] to [us]. end do job_loop if (dm_tty_connected(tty)) then diff --git a/guide/guide.adoc b/guide/guide.adoc index bd36517..c127f5b 100644 --- a/guide/guide.adoc +++ b/guide/guide.adoc @@ -179,8 +179,8 @@ The shell script requires _curl(1)_ and _unzip(1)_. This section describes how to build the DMPACK library and programs from source, with POSIX Make or the link:https://fpm.fortran-lang.org/[Fortran Package Manager] (FPM). At the moment, support for the Fortran Package Manager is experimental. -The shared library `libgfortran.so` must be present on the target system if the -DMPACK programs have been compiled with GNU Fortran. +The shared libraries `libgfortran.so` and `libquadmath.so` must be present on +the target system if the DMPACK programs have been compiled with GNU Fortran. Either build with GNU/BSD Make or with the Fortran Package Manager. It is recommended to use _make(1)_. To display the available build targets, run: @@ -195,6 +195,9 @@ Or, to output the selected build options, run for instance: $ make options PREFIX=/opt .... +See section <> on how to configure the operating system +after the installation. + === FreeBSD [[freebsd]] First, install the build and run-time dependencies: @@ -4367,7 +4370,7 @@ Dump only table `logs` of a log database: $ sqlite3 /var/dmpack/log.sqlite ".dump 'logs'" > log.sql .... -== System Configuration +== System Configuration [[system-configuration]] Additional changes to the system configuration should be considered to prevent issues while conducting a long-term monitoring. @@ -4578,6 +4581,25 @@ script to your configuration. == GeoCOM API +The official GeoCOM API is divided into the following sub-systems: + +[cols="1,4"] +|=== +| Acronym | Name + +| `AUT` | Automation +| `BAP` | Basic Applications +| `BMM` | Basic Man–Machine Interface +| `COM` | Communication Settings +| `CSV` | Central Services +| `EDM` | Electronic Distance Measurement +| `FTR` | File Transfer +| `IMG` | Image Processing +| `MOT` | Motorisation +| `SUP` | Supervisor +| `TMC` | Theodolite Measurement and Calculation +|=== + All GeoCOM named parameters provided by DMPACK start with prefix `GEOCOM_`. [%autowidth] @@ -4700,6 +4722,20 @@ All GeoCOM named parameters provided by DMPACK start with prefix `GEOCOM_`. | `GEOCOM_BAP_SINGLE_REF_PRECISE` | IR precise (TM30/TS30). |=== +.GEOCOM_COM_BAUD_RATE: Baud rate [[geocom-api-com-baud-rate]] +[%autowidth] +|=== +| Name | Description + +| `GEOCOM_COM_BAUD_2400` | 2400 baud. +| `GEOCOM_COM_BAUD_4800` | 4800 baud. +| `GEOCOM_COM_BAUD_9600` | 9600 baud. +| `GEOCOM_COM_BAUD_19200` | 19200 baud (default). +| `GEOCOM_COM_BAUD_38400` | 38400 baud. +| `GEOCOM_COM_BAUD_57600` | 57600 baud. +| `GEOCOM_COM_BAUD_115200` | 115200 baud. +|=== + .GEOCOM_COM_FORMAT: Transmission data format [[geocom-api-com-format]] [%autowidth] |=== @@ -4952,41 +4988,49 @@ table of observations to perform, for example: [source,lua] .... -observs = { +jobs = { { -- -- Start and initialisation of station p99. + -- Attribute `onetime` must be enabled! -- - name = "init", - target_id = "p99", - receivers = { "dmdb" }, - requests = { - geocom_beep_normal(), - geocom_set_refraction_mode(1), - geocom_set_inclination_correction(true), - geocom_set_user_atr_mode(true), - geocom_set_target_type(GEOCOM_BAP_REFL_USE), - geocom_set_prism_type(GEOCOM_BAP_PRISM_ROUND) + onetime = true, + delay = 5 * 1000, + observation = { + name = "init_tps", + target_id = "p99", + receivers = { "dmdb" }, + requests = { + geocom_beep_normal(), + geocom_set_refraction_mode(1), + geocom_set_inclination_correction(true), + geocom_set_user_atr_mode(true), + geocom_set_target_type(GEOCOM_BAP_REFL_USE), + geocom_set_prism_type(GEOCOM_BAP_PRISM_ROUND) } }, { -- -- Single measurement of target p01. -- - name = "get_p01", - target_id = "p01", - receivers = { "dmdb" }, - requests = { - geocom_set_position(gon2rad(0.0), gon2rad(100.0), GEOCOM_AUT_NORMAL, GEOCOM_AUT_TARGET), - geocom_do_measure(GEOCOM_TMC_DEF_DIST, GEOCOM_TMC_AUTO_INC), - geocom_get_simple_measurement(3000, GEOCOM_TMC_AUTO_INC) + onetime = false, + delay = 10 * 1000, + observation = { + name = "get_p01", + target_id = "p01", + receivers = { "dmdb" }, + requests = { + geocom_set_position(gon2rad(0.0), gon2rad(100.0), GEOCOM_AUT_NORMAL, GEOCOM_AUT_TARGET), + geocom_do_measure(GEOCOM_TMC_DEF_DIST, GEOCOM_TMC_AUTO_INC), + geocom_get_simple_measurement(3000, GEOCOM_TMC_AUTO_INC) + } } } } .... -The targets `p01` and `p99` have to exist in the observation database. - +The targets `p01` and `p99` have to exist in the observation database. The +performed observations are forwarded to <>. === Parameters @@ -5045,29 +5089,10 @@ print(gon) === GeoCOM The GeoCOM API for Lua is used to automate the creation of observation requests -in DMPACK configuration files. The official GeoCOM API is divided into the -following sub-systems: - -[cols="1,4"] -|=== -| Acronym | Name - -| `AUT` | Automation -| `BAP` | Basic Applications -| `BMM` | Basic Man–Machine Interface -| `COM` | Communication Settings -| `CSV` | Central Services -| `EDM` | Electronic Distance Measurement -| `FTR` | File Transfer -| `IMG` | Image Processing -| `MOT` | Motorisation -| `SUP` | Supervisor -| `TMC` | Theodolite Measurement and Calculation -|=== - -The Lua function names do not match the GeoCOM API names. All functions start -with prefix `geocom_`, all named parameters with `GEOCOM_`. The names of the -requests are set to the name of the respective function without the prefix. +in DMPACK configuration files. The Lua function names do not match the official +GeoCOM API names. All functions start with prefix `geocom_`, all named +parameters with `GEOCOM_`. The names of the requests are set to the name of the +respective function without prefix. .Comparison of the DMPACK Lua API and the official GeoCOM API [cols="3,2"] @@ -5263,7 +5288,7 @@ is valid, only files older than the deletion date are deleted. Returns request of *TMC_DoMeasure* procedure. Creates request for trying a distance measurement. This command does not return any values. If a distance measurement is performed in measurement program `GEOCOM_TMC_DEF_DIST`, the -distance sensor will work with the set EDM mode. +distance sensor will work in the set EDM mode. ==== geocom_download(block_number) [[lua-api-geocom-download]] @@ -5482,7 +5507,7 @@ the condition of the Lock-In control. ==== geocom_get_measurement_program() [[lua-api-geocom-get-measurement-program]] Returns request of *BAP_GetMeasPrg* procedure. Creates request for getting the -distance measurement program of the instrument. +distance measurement mode of the instrument. ==== geocom_get_power() [[lua-api-geocom-get-power]] @@ -5548,10 +5573,10 @@ instruments, but has only effects for instruments equipped with PowerSearch. Returns request of *TMC_GetSignal* procedure. Creates request for getting the EDM signal intensity. The function can only perform a measurement if the signal -measurement program is activated. Start the signal measurement program with -<> in program -`GEOCOM_TMC_SIGNAL`. After the measurement, the EDM must be switched off with -program `GEOCOM_TMC_CLEAR`. While measuring, there is no angle data available. +measurement mode is activated. Start the signal measurement with +<> in mode `GEOCOM_TMC_SIGNAL`. +After the measurement, the EDM must be switched off with mode +`GEOCOM_TMC_CLEAR`. While measuring, there is no angle data available. ==== geocom_get_simple_coordinates(wait_time, inc_mode) [[lua-api-geocom-get-simple-coordinates]] @@ -5680,15 +5705,17 @@ is set to ≤ 400 m. Returns request of *AUT_PS_SearchNext* procedure. The function executes the 360° default PowerSearch and searches for the next targets. A previously defined PowerSearch window of -<> is not taken +<> is not taken into account. Use API call -<> first. +<> first. ==== geocom_ps_search_window() [[lua-api-geocom-ps-search-window]] Returns request of *AUT_PS_SearchWindow* procedure. Creates request for starting PowerSearch. The function starts PowerSearch in the window defined by API calls -*AUT_SetSearchArea* and *AUT_PS_SetRange* (requires GeoCOM robotic licence). +<> and +<> (requires GeoCOM robotic +licence). ==== geocom_ps_set_range(min_dist, max_dist) [[lua-api-geocom-ps-set-range]] @@ -5769,10 +5796,9 @@ GeoCOM server to handle binary communication (not supported by DMPACK). Returns request of *SUP_SetConfig* procedure. Creates request for setting the power management configuration. The argument `timeout` sets the duration after -which the instrument switches into the mode `auto_power` -(`GEOCOM_SUP_AUTO_POWER`) when no user activity occured (key press, GeoCOM -communication). The value must be between 60,000 m/s (1 min) and 6,000,000 m/s -(100 min). +which the instrument switches into the mode `auto_power` when no user activity +occured (key press, GeoCOM communication). The value must be between 60,000 m/s +(1 min) and 6,000,000 m/s (100 min). ==== geocom_set_date_time(year, month, day, hour, minute, second) [[lua-api-geocom-set-date-time]] @@ -5816,8 +5842,7 @@ value is 1.99975, the resulting value will be 2.0. Returns request of *TMC_SetEdmMode* procedure. Creates request for setting the EDM measurement mode. The EDM mode set by this function is used by -<> in program -`GEOCOM_TMC_DEF_DIST`. +<> in mode `GEOCOM_TMC_DEF_DIST`. ==== geocom_set_egl_intensity(intensity) [[lua-api-geocom-set-egl-intensity]] diff --git a/src/dm_db.f90 b/src/dm_db.f90 index bf0fd63..08a8a3a 100644 --- a/src/dm_db.f90 +++ b/src/dm_db.f90 @@ -1311,7 +1311,7 @@ integer function dm_db_has_table(db, table, has) result(rc) !! * `E_DB_TYPE` if query result is of unexpected type. !! * `E_INVALID` if argument `table` is invalid. type(db_type), intent(inout) :: db !! Database type. - integer, intent(in) :: table !! Table enum. + integer, intent(in) :: table !! Table enumerator. logical, intent(out), optional :: has !! Boolean result. integer :: stat diff --git a/src/dm_geocom.f90 b/src/dm_geocom.f90 index 6a90f17..2e9f050 100644 --- a/src/dm_geocom.f90 +++ b/src/dm_geocom.f90 @@ -24,6 +24,7 @@ module dm_geocom !! call geocom%close() !! ``` use :: dm_error + use :: dm_file use :: dm_geocom_api use :: dm_geocom_error use :: dm_geocom_type @@ -31,6 +32,7 @@ module dm_geocom use :: dm_request use :: dm_response use :: dm_tty + use :: dm_util implicit none (type, external) private @@ -104,29 +106,74 @@ subroutine geocom_close(this) if (dm_tty_connected(this%tty)) call dm_tty_close(this%tty) end subroutine geocom_close - subroutine geocom_open(this, path, baud_rate, nretries, error) + subroutine geocom_open(this, path, baud_rate, retries, error) !! Opens TTY connection to robotic total station. !! + !! The argument `baud_rate` must be one of the following: + !! + !! * `GEOCOM_COM_BAUD_2400` + !! * `GEOCOM_COM_BAUD_4800` + !! * `GEOCOM_COM_BAUD_9600` + !! * `GEOCOM_COM_BAUD_19200` + !! * `GEOCOM_COM_BAUD_38400` + !! * `GEOCOM_COM_BAUD_57600` + !! * `GEOCOM_COM_BAUD_115200` + !! !! The function returns the following error codes: !! + !! * `E_EXIST` if the TTY is already connected. !! * `E_INVALID` if baud rate is invalid. + !! * `E_NOT_FOUND` if path does no exist. class(geocom_class), intent(inout) :: this !! GeoCOM object. character(len=*), intent(in) :: path !! Path of TTY. - integer, intent(in) :: baud_rate !! Baud rate enumerator. - integer, intent(in), optional :: nretries !! Number of retries + integer, intent(in) :: baud_rate !! Baud rate value. + integer, intent(in), optional :: retries !! Number of retries integer, intent(out), optional :: error !! DMPACK error code - integer :: nretries_, rc + integer :: baud, i, retries_, rc + + i = 0 + retries_ = 0 + if (present(retries)) retries_ = retries - nretries_ = 0 - if (present(nretries)) nretries_ = nretries + tty_block: block + rc = E_INVALID + select case (baud_rate) + case (GEOCOM_COM_BAUD_2400) + baud = TTY_B2400 + case (GEOCOM_COM_BAUD_4800) + baud = TTY_B4800 + case (GEOCOM_COM_BAUD_9600) + baud = TTY_B9600 + case (GEOCOM_COM_BAUD_19200) + baud = TTY_B19200 + case (GEOCOM_COM_BAUD_38400) + baud = TTY_B38400 + case (GEOCOM_COM_BAUD_57600) + baud = TTY_B57600 + case (GEOCOM_COM_BAUD_115200) + baud = TTY_B115200 + continue + case default + exit tty_block + end select - rc = E_INVALID - if (.not. dm_tty_valid_baud_rate(baud_rate)) return + rc = E_NOT_FOUND + if (.not. dm_file_exists(path)) exit tty_block - rc = E_NONE + rc = E_EXIST + if (dm_tty_connected(this%tty)) exit tty_block - !! ... TODO ... + do + ! Try to open TTY. + if (i > retries_) exit + rc = dm_tty_open(this%tty, path, baud, TTY_BYTE_SIZE8, TTY_PARITY_NONE, TTY_STOP_BITS1) + if (dm_is_ok(rc)) exit + call dm_sleep(1) + end do + end block tty_block + + if (present(error)) error = rc end subroutine geocom_open subroutine geocom_send(this, request, error) @@ -137,15 +184,23 @@ subroutine geocom_send(this, request, error) integer :: grc, rc - !! Send request to sensor. - !! ... TODO ... - + this%grc = GRC_UNDEFINED this%request = request - !! Get GeoCOM return code from response. - this%grc = GRC_UNDEFINED - call dm_request_get(request, 'grc', grc, error=rc) - if (dm_is_ok(rc)) this%grc = grc + tty_block: block + rc = E_IO + if (.not. dm_tty_connected(this%tty)) exit tty_block + + ! Send request to sensor. + rc = dm_tty_write(this%tty, this%request, flush=.true.) + if (dm_is_error(rc)) exit tty_block + + ! Get GeoCOM return code from response. + call dm_request_get(request, 'grc', grc, error=rc) + if (dm_is_ok(rc)) this%grc = grc + end block tty_block + + if (present(error)) error = rc end subroutine geocom_send ! ************************************************************************** diff --git a/src/dm_tty.f90 b/src/dm_tty.f90 index f212077..28be1e0 100644 --- a/src/dm_tty.f90 +++ b/src/dm_tty.f90 @@ -71,6 +71,18 @@ module dm_tty integer(kind=c_int), private :: fd = -1 !! Unix file descriptor. end type tty_type + interface dm_tty_read + !! Generic TTY read function. + module procedure :: dm_tty_read_bytes + module procedure :: dm_tty_read_request + end interface + + interface dm_tty_write + !! Generic TTY write function. + module procedure :: dm_tty_write_bytes + module procedure :: dm_tty_write_request + end interface + ! Public procedures. public :: dm_tty_baud_rate_from_value public :: dm_tty_byte_size_from_value @@ -80,7 +92,9 @@ module dm_tty public :: dm_tty_open public :: dm_tty_parity_from_name public :: dm_tty_read + public :: dm_tty_read_bytes public :: dm_tty_read_raw + public :: dm_tty_read_request public :: dm_tty_set_attributes public :: dm_tty_stop_bits_from_value public :: dm_tty_valid_baud_rate @@ -89,6 +103,8 @@ module dm_tty public :: dm_tty_valid_stop_bits public :: dm_tty_valid_timeout public :: dm_tty_write + public :: dm_tty_write_bytes + public :: dm_tty_write_request contains integer function dm_tty_baud_rate_from_value(value, error) result(baud_rate) !! Returns baud rate enumerator from numeric value. If the value is @@ -226,27 +242,55 @@ integer function dm_tty_flush(tty, input, output) result(rc) rc = E_NONE end function dm_tty_flush - integer function dm_tty_open(tty) result(rc) + integer function dm_tty_open(tty, path, baud_rate, byte_size, parity, stop_bits) result(rc) !! Opens TTY/PTS device in set access mode and applies serial port - !! attributes. + !! attributes. The arguments `baud_rate`, `byte_size`, `parity`, and + !! `stop_bits` must be valid enumerators. !! !! The function returns the following error codes: !! !! * `E_EXIST` if the TTY is already connected. - !! * `E_INVALID` if the TTY flags are invalid. + !! * `E_INVALID` if the TTY parameters or flags are invalid. !! * `E_IO` if opening the TTY failed. - !! * `E_SYSTEM` if setting the TTY attributes or flushing the buffers - !! failed. + !! * `E_SYSTEM` if setting the TTY attributes or flushing the buffers failed. use :: unix - type(tty_type), intent(inout) :: tty !! TTY type. + type(tty_type) , intent(inout) :: tty !! TTY type. + character(len=*), intent(in), optional :: path !! Device path. + integer, intent(in), optional :: baud_rate !! Baud rate enumerator (`TTY_B_*`). + integer, intent(in), optional :: byte_size !! Byte size enumerator (`TTY_BYTE_SIZE*`). + integer, intent(in), optional :: parity !! Parity enumerator (`TTY_PARITY_*`). + integer, intent(in), optional :: stop_bits !! Stop bits enumerator (`TTY_STOP_BITS*`). integer(kind=c_int) :: flags rc = E_EXIST if (dm_tty_connected(tty)) return - ! Set flags. + ! Set arguments. rc = E_INVALID + if (present(path)) tty%path = path + + if (present(baud_rate)) then + if (.not. dm_tty_valid_baud_rate(baud_rate)) return + tty%baud_rate = baud_rate + end if + + if (present(byte_size)) then + if (.not. dm_tty_valid_byte_size(byte_size)) return + tty%byte_size = byte_size + end if + + if (present(parity)) then + if (.not. dm_tty_valid_parity(parity)) return + tty%parity = parity + end if + + if (present(stop_bits)) then + if (.not. dm_tty_valid_stop_bits(stop_bits)) return + tty%stop_bits = stop_bits + end if + + ! Set flags. flags = ior(O_NOCTTY, O_SYNC) flags = ior(flags, O_NONBLOCK) @@ -296,9 +340,14 @@ integer function dm_tty_parity_from_name(name, error) result(parity) if (present(error)) error = E_NONE end function dm_tty_parity_from_name - integer function dm_tty_read(tty, buffer, del, nbytes) result(rc) + integer function dm_tty_read_bytes(tty, buffer, del, nbytes) result(rc) !! Reads from TTY into `buf` until delimiter `del` occurs. The !! number of bytes read is returned in `n`. + !! + !! The function returns the following error codes: + !! + !! * `E_BOUNDS` if end of buffer is reached. + !! * `E_READ` if the read operation failed. type(tty_type), intent(inout) :: tty !! TTY type. character(len=*), intent(inout) :: buffer !! Input buffer. character(len=*), intent(in) :: del !! Delimiter. @@ -308,8 +357,6 @@ integer function dm_tty_read(tty, buffer, del, nbytes) result(rc) integer :: i, j, k integer(kind=i8) :: n, sz - rc = E_READ - i = 1 j = len(buffer) k = len(del) @@ -336,17 +383,43 @@ integer function dm_tty_read(tty, buffer, del, nbytes) result(rc) end do if (present(nbytes)) nbytes = n - end function dm_tty_read + end function dm_tty_read_bytes integer(kind=i8) function dm_tty_read_raw(tty, byte) result(n) - !! Reads single byte from file descriptor. + !! Reads single byte from file descriptor, and returns `1_i0` on + !! success. use :: unix, only: c_read type(tty_type), intent(inout) :: tty !! TTY type. character, target, intent(out) :: byte !! Byte read. - n = int(c_read(tty%fd, c_loc(byte), int(1, kind=c_size_t)), kind=i8) + n = int(c_read(tty%fd, c_loc(byte), 1_c_size_t), kind=i8) end function dm_tty_read_raw + integer function dm_tty_read_request(tty, request) result(rc) + !! Reads TTY response into request. The request delimiter is unescaped. + !! The response is escaped before being stored in the request. + !! + !! The function returns the following error codes: + !! + !! * `E_BOUNDS` if the response is longer than `REQUEST_RESPONSE_LEN`. + !! * `E_READ` if reading from TTY failed. + use :: dm_ascii, only: dm_ascii_escape, dm_ascii_unescape + use :: dm_request + type(tty_type), intent(inout) :: tty !! TTY type. + type(request_type), intent(inout) :: request !! Request type. + + character(len=REQUEST_RESPONSE_LEN) :: raw ! Raw response (unescaped). + character(len=REQUEST_DELIMITER_LEN) :: del ! Raw delimiter (unescaped). + + del = dm_ascii_unescape(request%delimiter) + raw = ' ' + + rc = dm_tty_read(tty, raw, trim(del)) + + request%error = rc + request%response = dm_ascii_escape(raw) + end function dm_tty_read_request + integer function dm_tty_set_attributes(tty) result(rc) !! Sets terminal attributes. Returns `E_INVALID` if the passed TTY is !! invalid, or `E_SYSTEM` if one of the system calls failed. @@ -606,26 +679,70 @@ pure elemental logical function dm_tty_valid_timeout(timeout) result(valid) if (timeout >= 0) valid = .true. end function dm_tty_valid_timeout - integer function dm_tty_write(tty, bytes) result(rc) - !! Writes given string to TTY. Returns `E_WRITE` on error. + integer function dm_tty_write_bytes(tty, bytes, n, flush) result(rc) + !! Writes given string to TTY. Returns `E_WRITE` on error. The function + !! may cause an access violation if `n` is greater than the length of + !! `bytes`. + !! + !! The function returns the following error codes: + !! + !! * `E_SYSTEM` if flushing the input buffer failed. + !! * `E_WRITE` if writing to TTY failed. use :: unix, only: c_write - type(tty_type), intent(inout) :: tty !! TTY type. - character(len=*), intent(in) :: bytes !! Bytes to send. + type(tty_type), intent(inout) :: tty !! TTY type. + character(len=*), intent(in) :: bytes !! Bytes to send. + integer, intent(in), optional :: n !! Number of bytes to send. + logical, intent(in), optional :: flush !! Flush input buffer. character(kind=c_char), target :: a - integer :: i - integer(kind=c_size_t) :: n + integer :: i, n_ + integer(kind=c_size_t) :: k - rc = E_WRITE + if (present(n)) then + n_ = n + else + n_ = len(bytes) + end if + + if (present(flush)) then + rc = dm_tty_flush(tty, input=flush, output=.false.) + if (dm_is_error(rc)) return + end if - do i = 1, len(bytes) + rc = E_WRITE + do i = 1, n_ a = bytes(i:i) - n = c_write(tty%fd, c_loc(a), int(1, kind=c_size_t)) - if (n /= 1) return + k = c_write(tty%fd, c_loc(a), 1_c_size_t) + if (k /= 1) return end do rc = E_NONE - end function dm_tty_write + end function dm_tty_write_bytes + + integer function dm_tty_write_request(tty, request, flush) result(rc) + !! Writes given request to TTY. The function unescapes the request + !! string. If `flush` is `.true.`, the input buffer is flushed first. + !! + !! The function returns the following error codes: + !! + !! * `E_SYSTEM` if flushing the input buffer failed. + !! * `E_WRITE` if writing to TTY failed. + use :: dm_ascii, only: dm_ascii_unescape + use :: dm_request + type(tty_type), intent(inout) :: tty !! TTY type. + type(request_type), intent(inout) :: request !! Request type + logical, intent(in), optional :: flush !! Flush input buffer. + + character(len=REQUEST_REQUEST_LEN) :: raw ! Raw request (unescaped). + + if (present(flush)) then + rc = dm_tty_flush(tty, input=flush, output=.false.) + if (dm_is_error(rc)) return + end if + + raw = dm_ascii_unescape(request%request) + rc = dm_tty_write(tty, trim(raw)) + end function dm_tty_write_request subroutine dm_tty_close(tty) !! Closes file descriptor. diff --git a/src/dm_util.f90 b/src/dm_util.f90 index 2db2252..58f5e4e 100644 --- a/src/dm_util.f90 +++ b/src/dm_util.f90 @@ -282,20 +282,20 @@ end subroutine dm_real64_to_real32 subroutine dm_sleep(sec) !! Pauses program execution for given time in seconds. - use :: unix, only: c_usleep - integer, intent(in) :: sec !! Delay in sec. + use :: unix, only: c_useconds_t, c_usleep + integer, intent(in) :: sec !! Delay in seconds [s]. integer :: rc - rc = c_usleep(sec * 10**6) + rc = c_usleep(int(sec * 10**6, kind=c_useconds_t)) end subroutine dm_sleep subroutine dm_usleep(usec) !! Pauses program execution for given time in useconds. - use :: unix, only: c_usleep - integer, intent(in) :: usec !! Delay in usec. + use :: unix, only: c_useconds_t, c_usleep + integer, intent(in) :: usec !! Delay in useconds [us]. integer :: rc - rc = c_usleep(usec) + rc = c_usleep(int(usec, kind=c_useconds_t)) end subroutine dm_usleep ! ******************************************************************