add regexp trailing option to attempt to parse matches as numbers

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

5 files changed, 52 insertions, 32 deletions

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"