github302-perlre-server.bash (2845B)
1 # ble.sh contrib/config/github302-perlre-server.bash 2 # Copyright 2023 Britton Kerin <https://lists.gnu.org/archive/html/help-bash/2023-03/msg00068.html> 3 # Copyright 2023 Koichi Murase <myoga.murase@gmail.com> 4 5 # This file illustrates an example usage of "ble/util/bgproc#open" from module 6 # "util.bgproc". The server code in the shell function 7 # "ble/contrib/config:github302/perlre-server" was taken from the report by 8 # Britton Kerin at Ref. [1]. 9 # 10 # [1] https://lists.gnu.org/archive/html/help-bash/2023-03/msg00068.html 11 # 12 # Note: This example does not consider the case that the background process 13 # terminates by an error, crashes, etc. 14 15 ble-import util.bgproc 16 17 function ble/contrib/config:github302/perlre-server { 18 exec perl <(cat <<' END_PERL' 19 use strict; use warnings; 20 $| = 1; 21 while ( 1 ) { 22 my $rex = <>; 23 chomp($rex); 24 my $str = <>; 25 if ( $str =~ m/$rex/ ) { 26 # FIXME: Sadly this die argument doesn't show anywhere: 27 defined($1) or die 'group $1 unexpectedly undefined'; 28 print length($1); 29 } 30 print "\n"; 31 } 32 END_PERL 33 ) 2>/dev/tty 34 } 35 36 if ble/util/bgproc#open perlre_server ble/contrib/config:github302/perlre-server; then 37 # The main shell can send a request to fd ${perlre_server_bgproc[1]} and can 38 # read from fd ${perlre_server_bgproc[0]}. 39 ble/util/print "ble/contrib/config:github30: perlre-server (${perlre_server_bgproc[4]}) has started." >&2 40 else 41 ble/util/print 'ble/contrib/config:github30: failed to start perlre-server' >&2 42 return 1 43 fi 44 45 ## @fn ble/contrib/config:github302/perlre-match rex str 46 ## Matches the regex REX against the string STR and returns the length of the 47 ## string captured by the first matching group ($1). 48 ## 49 ## @param[in] rex 50 ## The regex to match in "perlre" syntax. 51 ## @param[in] str 52 ## The string to be matched by REX. 53 ## @var[out] ret 54 ## The resulting length of the string matched by the first capture group is 55 ## stored in this variable. When REX does not match STR, an empty value is 56 ## stored in this variable. 57 ## @exit 0 if REX successfully matches STR, or otherwise 1. 58 ## 59 function ble/contrib/config:github302/perlre-match { 60 local IFS=$' \t\n' 61 62 # Only takes the first lines of both because newlines in requests confuse the 63 # server. 64 local rex=${1%%$'\n'*} str=${2%%$'\n'*} 65 66 # We send the requests to fd ${perlre_server_bgproc[1]}. 67 ble/util/print-lines "$rex" "$str" >&"${perlre_server_bgproc[1]}" 68 69 # We can read the resposnes from fd ${perlre_server_bgproc[0]}. We set a 70 # timeout to `read' so that it doesn't lock forever in case that the expected 71 # output is not obtained by accident (e.g., for the reason that REX did not 72 # contain any capturing group accessible through $1). 73 ble/bash/read-timeout 1 -r -u "${perlre_server_bgproc[0]}" ret 74 75 [[ $ret ]] 76 }