;; 仓库路由注册表。ETS 由这个常驻进程持有,避免仓库进程退出时丢失整张表。
(defmodule lamina_repo_registry
(behaviour gen_server)
(export all))
(defun table () 'lamina_repo_registry_table)
(defun key (org-name slug)
(tuple (norm-org org-name) (to-str slug)))
;; SQLite 文本是 binary,URL 路径是 charlist;ETS 键必须统一。
(defun norm-org (org-name)
(cond
((or (=:= org-name 'none) (=:= org-name 'undefined) (=:= org-name 'null)) 'none)
((is_binary org-name) (norm-org (binary_to_list org-name)))
((or (=:= org-name "") (=:= org-name #"")) 'none)
('true org-name)))
(defun to-str (value)
(cond
((is_binary value) (binary_to_list value))
((is_list value) value)
((is_atom value) (atom_to_list value))
('true (lists:flatten (io_lib:format "~p" (list value))))))
(defun start-link ()
(gen_server:start_link #(local lamina_repo_registry)
'lamina_repo_registry 'none (list)))
(defun start_link () (start-link))
(defun init (_)
(case (ets:info (table))
('undefined
(ets:new (table) (list 'named_table 'public 'set
(tuple 'read_concurrency 'true))))
(_ 'ok))
(tuple 'ok 'ok))
(defun put (slug port)
(put 'none slug port))
(defun put (org-name slug port)
(case (ets:info (table))
('undefined 'undefined)
(_ (ets:insert (table) (tuple (key org-name slug) port)))))
(defun get (slug)
(get 'none slug))
(defun get (org-name slug)
(case (ets:lookup (table) (key org-name slug))
(`(#(,_key ,port)) `#(ok ,port))
(_ 'undefined)))
(defun delete (slug)
(delete 'none slug))
(defun delete (org-name slug)
(case (ets:info (table))
('undefined 'ok)
(_ (ets:delete (table) (key org-name slug)))))
(defun clear ()
(case (ets:info (table))
('undefined 'ok)
(_ (ets:delete_all_objects (table)))))
(defun handle_call (_msg _from state) (tuple 'reply 'ok state))
(defun handle_cast (_msg state) `#(noreply ,state))
(defun handle_info (_msg state) `#(noreply ,state))
(defun terminate (_reason _state) 'ok)
(defun code-change (_old state _extra) `#(ok ,state))