Fix handling of names

- remappings happen w.r.t global names as per ros 0.9
- the node's own name is put into the node namespace, which wasn't happening before
This commit is contained in:
Bhaskara Marthi 2010-07-31 19:35:32 +00:00
parent d169ee2eea
commit 649b55aaa3
6 changed files with 31 additions and 35 deletions

View File

@ -39,22 +39,23 @@
(in-package :roslisp)
(defun process-command-line-remappings (l)
"Process command line remappings, including the three special cases for remapping the node name, namespace, and setting parameters. Return alist of params to set."
(defun process-command-line-remappings (l base-name)
"Process command line remappings, including the three special cases for remapping the node name, namespace, and setting parameters. Return alist of params to set. Note this is order dependent since setting __ns or __name affects how remappings are interpreted."
(setf *remapped-names* (make-hash-table :test #'equal))
(let ((params nil))
(dolist (x l params)
(dbind (lhs rhs) x
(cond
((equal lhs "__ns") (setf *namespace* rhs))
((equal lhs "__name") (setf *ros-node-name* rhs))
((equal lhs "__ns") (setf *namespace* (postprocess-namespace rhs) *ros-node-name* (compute-node-name base-name)))
((equal lhs "__name") (setf base-name rhs *ros-node-name* (compute-node-name rhs)))
((equal lhs "__log") (setf *ros-log-location* rhs))
((eql (char lhs 0) #\_) (push (cons (concatenate 'string "~" (subseq lhs 1))
(let ((rhs-val (read-from-string rhs)))
(typecase rhs-val
(symbol rhs)
(otherwise rhs-val)))) params))
(t (setf (gethash lhs *remapped-names*) rhs)))))))
(t (setf (gethash (compute-global-name *namespace* *ros-node-name* lhs) *remapped-names*)
(compute-global-name *namespace* *ros-node-name* rhs))))))))
(defun postprocess-namespace (ns)
"Ensure that namespace begins and ends with /"
@ -64,9 +65,8 @@
(setf ns (concatenate 'string ns "/")))
ns)
(defun postprocess-node-name (name)
"Trim any /'s from the node name"
(string-trim '(#\/) name))
(defun compute-node-name (name)
(concatenate 'string *namespace* (string-trim '(#\/) name)))
(defun parse-remapping (string)
"If string is of the form FOO:=BAR, return foo and bar, otherwise return nil."
@ -80,16 +80,12 @@
"Postcondition: the variables *remapped-names*, *namespace*, and *ros-node-name* are set based on the argument list and the environment variable ROS_NAMESPACE as per the ros command line protocol. Also, arguments of the form _foo:=bar are interpreted by setting private parameter foo equal to bar (currently bar is just read using the lisp reader; it should eventually use yaml conventions)"
(when (stringp args)
(setq args (tokens args)))
(setq *namespace* (postprocess-namespace (or (sb-ext:posix-getenv "ROS_NAMESPACE") "/"))
*ros-node-name* (compute-node-name name))
(let ((remappings
(mapcan #'(lambda (s) (mvbind (lhs rhs) (parse-remapping s) (when lhs (list (list lhs rhs)))))
args)))
(setf *namespace* (or (sb-ext:posix-getenv "ROS_NAMESPACE") "/")
*ros-node-name* name)
(let ((params (process-command-line-remappings remappings)))
(setf *namespace* (postprocess-namespace *namespace*)
*ros-node-name* (postprocess-node-name *ros-node-name*))
params)))
(process-command-line-remappings remappings name)))
(defun command-line-args-rosout (args params)

View File

@ -64,7 +64,7 @@
(dbind (code msg vals)
(xml-rpc-call
(apply #'encode-xml-rpc-call name
(concatenate 'string "/" *ros-node-name*) ;; TODO: this assumes global namespace
*ros-node-name*
args)
:host address :port port)
(when (<= code 0) (cerror "Ignore and continue" 'ros-rpc-error

View File

@ -44,17 +44,16 @@
(declare (cons names))
(format nil "~a~{/~a~}" (first names) (rest names)))
(defun fully-qualified-name (&rest names)
"Do the translation from a client-code-specified name to a fully qualified one. Handles already-fully-qualified names, tilde for private namespace, unqualified names, and remapped names.
You can specify multiple names, which are just concatenated with /'s in between"
(defun fully-qualified-name (name)
"Do the translation from a client-code-specified name to a fully qualified one. Handles already-fully-qualified names, tilde for private namespace, unqualified names, and remapped names."
(let ((global-name (compute-global-name *namespace* *ros-node-name* name)))
(gethash global-name *remapped-names* global-name)))
(let ((name (concatenate-ros-names names)))
(defun compute-global-name (ns node-global-name name)
(case (char name 0)
(#\/ name)
(#\~ (concatenate 'string *namespace* *ros-node-name* "/" (subseq name 1)))
(otherwise
(concatenate 'string *namespace* (gethash name *remapped-names* name))))))
(#\~ (concatenate 'string node-global-name "/" (subseq name 1)))
(otherwise (concatenate 'string ns name))))
(defmacro with-fully-qualified-name (n &body body)
(assert (symbolp n))

View File

@ -176,14 +176,15 @@ Assuming spin is not true, this call will return the return value of the final s
(dbind (name &rest a &key spin &allow-other-keys) args
(declare (ignorable name a))
`(unwind-protect
(restart-case
(progn
(start-ros-node ,@args)
,@body
,@(when spin `((spin-until nil 100))))
(shutdown-ros-node (&optional a) (ros-info (roslisp top) "About to shutdown~:[~; due to condition ~:*~a~]" a)))
(shutdown-ros-node))))
`(let (*namespace*) ;; Set up a binding so that start-ros-node can set it and this will be seen in the body, but not by our caller
(unwind-protect
(restart-case
(progn
(start-ros-node ,@args)
,@body
,@(when spin `((spin-until nil 100))))
(shutdown-ros-node (&optional a) (ros-info (roslisp top) "About to shutdown~:[~; due to condition ~:*~a~]" a)))
(shutdown-ros-node)))))
(defun shutdown-ros-node ()

View File

@ -20,7 +20,7 @@
(:file "tcpros" :depends-on ("roslisp" "msg" "rosout"))
(:file "sockets" :depends-on ("roslisp" "rosout"))
(:file "slave" :depends-on ("sockets" "tcpros" "rosout"))
(:file "command-line-args" :depends-on ("roslisp" "rosout"))
(:file "command-line-args" :depends-on ("roslisp" "rosout" "namespace"))
(:file "client" :depends-on ("sockets" "namespace" "command-line-args" "msg" "rosout" "master"))
(:file "debug-levels" :depends-on ("params" "client" "rosout"))
(:file "node" :depends-on ("client"))

View File

@ -155,7 +155,7 @@
;; Stored in special variables since node is a singleton
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar *ros-node-name* nil "String holding node name")
(defvar *ros-node-name* nil "String holding node global name")
(defvar *node-status* :shutdown)
(defvar *master-uri* nil "URI of ROS master")
(defvar *default-master-uri* nil "Default master URI. Is nil (intended for convenience during interactive use).")
@ -172,7 +172,7 @@
(defvar *debug-stream-lock* (make-mutex :name "API-wide lock for the debugging output stream."))
(defvar *running-from-command-line* nil "True iff running ROS node script from command line (noninteractively)")
(defvar *broken-socket-streams* nil "Used by TCPROS to keep track of sockets that have died and shouldn't be written to any more.")
(defvar *namespace* nil "The name of the node's parent namespace")
(defvar *namespace* "/" "Dynamic variable that holds the current namespace. Bound when node starts, and by in-namespace")
(defvar *ros-log-location* nil "Name of file to which ros lisp debugging info is written")
(defvar *ros-log-stream* nil "Output stream bound to log file during node execution")
(defvar *remapped-names* nil "Hash from strings to strings containing names that have been remapped on the command line")