add regexp trailing option to attempt to parse matches as numbers

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>

10 files changed, 107 insertions, 37 deletions

diff --git a/consfigurator.asd b/consfigurator.asd
index 3371996..7a6500a 100644
--- a/consfigurator.asd
+++ b/consfigurator.asd
@@ -18,6 +18,7 @@
                #:closer-mop
                #:named-readtables
                #:osicat
+               #:parse-number
                (:feature :sbcl (:require #:sb-posix))
                #:trivial-backtrace)
   :components ((:file "src/package")
diff --git a/debian/changelog b/debian/changelog
index 3f99cbe..3a00bc0 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,10 @@
+consfigurator (1.3.0-1) UNRELEASED; urgency=medium
+
+  * New upstream release.
+  * Add dep and build-dep on cl-parse-number.
+
+ -- Sean Whitton <spwhitton@spwhitton.name>  Thu, 16 Mar 2023 12:52:40 -0700
+
 consfigurator (1.2.3-1) unstable; urgency=medium
 
   * New upstream release.
diff --git a/debian/control b/debian/control
index a1a6af3..6f6e674 100644
--- a/debian/control
+++ b/debian/control
@@ -14,6 +14,7 @@ Build-Depends:
  cl-interpol,
  cl-named-readtables,
  cl-osicat,
+ cl-parse-number,
  cl-ppcre,
  cl-trivial-backtrace,
  debhelper-compat (= 13),
@@ -45,6 +46,7 @@ Depends:
  cl-interpol,
  cl-named-readtables,
  cl-osicat,
+ cl-parse-number,
  cl-ppcre,
  cl-trivial-backtrace,
  emacsen-common,
diff --git a/doc/reader.rst b/doc/reader.rst
index 1d78cd2..ed54860 100644
--- a/doc/reader.rst
+++ b/doc/reader.rst
@@ -35,9 +35,12 @@ This provides an abbreviation for shell- and Perl-style regexp matching:
       => ("two" "four" "six")
 
 Any delimiters supported by ``CL-INTERPOL`` may be used, and the ``m`` is
-always optional.  Trailing options ``g``, ``i``, ``m``, ``s`` and ``x`` are
-meaningful.  The return value depends on the numeric argument before the
-tilde:
+always optional.  Standard trailing options ``g``, ``i``, ``m``, ``s`` and
+``x`` are meaningful.  There is also ``p``, which means to attempt to parse
+the matched strings and substrings as numbers; if a substring cannot be parsed
+as a number, it is returned unmodified.
+
+The return value depends on the numeric argument before the tilde:
 
 - ``#~m//``, with no argument, returns a vector of the substrings
   corresponding to the capture groups, or if there were no capture groups,
@@ -65,8 +68,9 @@ This provides an abbreviation for shell- and Perl-style regexp substitution:
   (mapcar #~s/:.+:/`\&`/ '(":Hello:" ":Goodbye:")) => ("`:Hello:`" "`:Goodbye:`")
 
 Again, any delimiters supported by ``CL-INTERPOL`` may be used, and the same
-trailing options are meaningful.  This is ``CL-PPCRE:REGEX-REPLACE`` or
-``CL-PPCRE:REGEX-REPLACE-ALL``, which see regarding return values.
+trailing options, except for ``p``, are meaningful.  This is
+``CL-PPCRE:REGEX-REPLACE`` or ``CL-PPCRE:REGEX-REPLACE-ALL``, which see
+regarding return values.
 
 ``#>EOF>`` and ``#>>EOF>>``: Heredocs
 -------------------------------------
diff --git a/src/connection.lisp b/src/connection.lisp
index ffb0372..d1e78cb 100644
--- a/src/connection.lisp
+++ b/src/connection.lisp
@@ -216,17 +216,11 @@ connattr, or nil if nothing should be propagated.")
 
 (defmethod connection-connattr
     ((connection connection) (k (eql :remote-uid)))
-  (multiple-value-bind (match groups)
-      (re:scan-to-strings "^uid=([0-9]+)"
-                          (connection-connattr connection 'id))
-    (and match (parse-integer (elt groups 0)))))
+  (#1~/^uid=(\d+)/p (connection-connattr connection 'id)))
 
 (defmethod connection-connattr
     ((connection connection) (k (eql :remote-gid)))
-  (multiple-value-bind (match groups)
-      (re:scan-to-strings "\\) gid=([0-9]+)"
-                          (connection-connattr connection 'id))
-    (and match (parse-integer (elt groups 0)))))
+  (#1~/\) gid=(\d+)/p (connection-connattr connection 'id)))
 
 (defmethod connection-connattr
     ((connection connection) (k (eql :remote-home)))
@@ -614,16 +608,11 @@ specification of POSIX ls(1))."
   "Get the time of the last reboot, rounded down to the nearest minute."
   ;; The '-b' option to who(1) is specified in POSIX, though not the output
   ;; format; this parse is based on GNU coreutils who(1).
-  (multiple-value-bind (match groups)
-      (re:scan-to-strings
-       "([0-9]{4})-([0-9]{2})-([0-9]{2}) ([0-9]{2}):([0-9]{2})"
-       (car (runlines :env '(:TZ "UTC") "who" "-b")))
-    (if match
-        (let ((groups (map 'vector #'parse-integer groups)))
-          (encode-universal-time 0 (elt groups 4) (elt groups 3)
-                                 (elt groups 2) (elt groups 1) (elt groups 0)
-                                 0))
-        (failed-change "Could not determine time of remote's last reboot."))))
+  (aif (#~/(\d{4})-(\d{2})-(\d{2}) (\d{2}):(\d{2})/p
+        (car (runlines :env '(:TZ "UTC") "who" "-b")))
+       (encode-universal-time 0 (elt it 4) (elt it 3) (elt it 2) (elt it 1)
+                              (elt it 0) 0)
+       (failed-change "Could not determine time of remote's last reboot.")))
 
 (defun remote-executable-find (executable)
   (zerop (mrun :for-exit "command" "-v" executable)))
diff --git a/src/package.lisp b/src/package.lisp
index 157bcfb..8b8228d 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -46,6 +46,7 @@
                           #:safe-read-from-string
                           #:compile-file*
                           #:compile-file-pathname*)
+  (:shadowing-import-from #:parse-number #:parse-number)
   (:export ;; re-export from UIOP
            #:strcat
            #:string-prefix-p
@@ -90,6 +91,9 @@
            #:compile-file*
            #:compile-file-pathname*
 
+           ;; re-export from PARSE-NUMBER
+           #:parse-number
+
            ;; libc.lisp
            #:uid_t
            #:gid_t
diff --git a/src/property/disk.lisp b/src/property/disk.lisp
index 53203aa..08d1dcf 100644
--- a/src/property/disk.lisp
+++ b/src/property/disk.lisp
@@ -1207,16 +1207,14 @@ Currently only handling of LVM logical volumes is implemented."
 
 (defun parse-volume-size (volume-size-specification)
   (if (stringp volume-size-specification)
-      (multiple-value-bind (match groups)
-          (re:scan-to-strings #?/\A([0-9]+)([MGT])?\z/ volume-size-specification)
-        (unless match
-          (simple-program-error
-           "~A is not a valid volume size." volume-size-specification))
-        (* (parse-integer (elt groups 0))
-           (eswitch ((elt groups 1) :test #'string=)
-             ("M" 1)
-             ("G" 1024)
-             ("T" 1048576))))
+      (aif (#~/\A(\d+)([MGT])?\z/p volume-size-specification)
+           (* (elt it 0)
+              (eswitch ((elt it 1) :test #'string=)
+                ("M" 1)
+                ("G" 1024)
+                ("T" 1048576)))
+           (simple-program-error "~A is not a valid volume size."
+                                 volume-size-specification))
       volume-size-specification))
 
 (defmacro volumes (&body volume-specifications)
diff --git a/src/reader.lisp b/src/reader.lisp
index 3d73046..f961362 100644
--- a/src/reader.lisp
+++ b/src/reader.lisp
@@ -151,6 +151,7 @@ indented heredoc; see perlop(1)."
              (modes (loop for next = (read-char stream t :eof t)
                           while (alpha-char-p next) collect next
                           finally (unread-char next stream)))
+             (try-parse (find #\p modes))
              (scanner-args
                (list first-arg
                      :case-insensitive-mode (and (find #\i modes) t)
@@ -167,7 +168,13 @@ indented heredoc; see perlop(1)."
                (ecase op
                  (#\m
                   (cond ((member #\g modes)
-                         `(re:all-matches-as-strings ,scanner target-string))
+                         (let ((form
+                                 `(re:all-matches-as-strings ,scanner
+                                                             target-string)))
+                           (if try-parse
+                               `(aand ,form
+                                      (map-into it #'try-parse-number it))
+                               form)))
                         ((not arg)
                          ;; The number of capture groups is constant if
                          ;; FIRST-ARG is constant, so could we self-replace
@@ -177,14 +184,31 @@ indented heredoc; see perlop(1)."
                             ;; We could (coerce rest 'list) for use with
                             ;; DESTRUCTURING-BIND.  But there is already
                             ;; CL-PPCRE:REGISTER-GROUPS-BIND.
-                            (if (zerop (length rest)) zeroth rest)))
+                            (if (zerop (length rest))
+                                ,(if try-parse
+                                     '(try-parse-number zeroth)
+                                     'zeroth)
+                                ,(if try-parse
+                                     '(map-into rest #'try-parse-number rest)
+                                     'rest))))
                         ((zerop arg)
-                         `(re:scan-to-strings ,scanner target-string))
+                         (let ((form `(re:scan-to-strings ,scanner
+                                                          target-string)))
+                           (if try-parse
+                               `(multiple-value-bind (match groups) ,form
+                                  (values (try-parse-number match)
+                                          (map-into groups #'try-parse-number
+                                                    groups)))
+                               form)))
                         (t              ; ARG is a positive integer
                          `(aand
                            (nth-value 1 (re:scan-to-strings ,scanner
                                                             target-string))
-                           (values (aref it ,(1- arg)) it)))))
+                           ,(if try-parse
+                                `(values (try-parse-number
+                                          (aref it ,(1- arg)))
+                                         (map-into it #'try-parse-number it))
+                                `(values (aref it ,(1- arg)) it))))))
                  (#\s `(,(if (member #\g modes)
                              're:regex-replace-all
                              're:regex-replace)
diff --git a/src/util.lisp b/src/util.lisp
index fea974d..ec2f249 100644
--- a/src/util.lisp
+++ b/src/util.lisp
@@ -333,6 +333,11 @@ expansion as a starting point for your own DEFPACKAGE form for your consfig."
                                        else do (princ #\: s)
                                                (loop-finish)))))))))
 
+(defun try-parse-number (string &rest args &key &allow-other-keys)
+  (and string
+       (handler-case (apply #'parse-number string args)
+         (parse-error () string))))
+
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (define-constant +alphanum+
     "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
diff --git a/tests/reader.lisp b/tests/reader.lisp
index 1383196..eb4feec 100644
--- a/tests/reader.lisp
+++ b/tests/reader.lisp
@@ -108,3 +108,39 @@ line 2
 (deftest perl-tilde-reader.18
     (#~s'foo'${bar}' "foo")
   "${bar}" t)
+
+(deftest perl-tilde-reader.19
+    (#~/\d+/p "1234")
+  1234)
+
+(deftest perl-tilde-reader.19
+    (#~/(\d+)/p "1234")
+  #(1234))
+
+(deftest perl-tilde-reader.21
+    (#~/\d+/gp "1234 6789")
+  (1234 6789))
+
+(deftest perl-tilde-reader.22
+    (#0~/aa (\d+)/p "aa 1234")
+  "aa 1234" #(1234))
+
+(deftest perl-tilde-reader.22
+    (#0~/aa (.+)/p "aa bbbb")
+  "aa bbbb" #("bbbb"))
+
+(deftest perl-tilde-reader.24
+    (#0~/(\d+)../p "1234")
+  1234 #(12))
+
+(deftest perl-tilde-reader.25
+    (#1~/(\d+)../p "1234")
+  12 #(12))
+
+(deftest perl-tilde-reader.26
+    (#1~/(..)../p "aabb")
+  "aa" #("aa"))
+
+(deftest perl-tilde-reader.27
+    (#~/d(.)?$/p "d")
+  #(nil))