Mired in code
Check-in [cbf17190cb]
Not logged in
Public Repositories
mwm's Repositories

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Update to the latest code, using a database for config, and a reload option.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:cbf17190cb96d6d242b51403d8e2942b1c30afaa
User & Date: mwm@mired.org 2011-04-04 18:55:28
Context
2011-04-06
00:09
Update -destroy method to have correct parameters. check-in: c0bfb3546d user: mwm@mired.org tags: trunk
2011-04-04
18:55
Update to the latest code, using a database for config, and a reload option. check-in: cbf17190cb user: mwm@mired.org tags: trunk
2011-03-08
23:21
Add initial version of parallel n queens solvers. check-in: 203a92b61b user: mwm@mired.org tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to x10/project.clj.

1
2
3
4
5
6
7
8
9


10
11
12
13
14
(defproject x10 "1.0.0"
  :description "A simple x10 controller"
  :aot [x10.war]
  :dependencies [[org.clojure/clojure "1.2.0"]
                 [org.clojure/clojure-contrib "1.2.0"]
		 [ring/ring-core "0.3.2"]
		 [gnu.io.CommPortIdentifier "2.1.7"]
		 [ring/ring-devel "0.3.2"]
		 [ring/ring-servlet "0.3.2"]


		 [com.michaeldalal.x10 "1.0.1"]]
  :dev-dependencies [[uk.org.alienscience/leiningen-war "0.0.9"]
		     [swank-clojure "1.2.0"]
		     [javax.servlet/servlet-api "2.5"]
		     [ring/ring-jetty-adapter "0.3.2"]])






<


>
>





1
2
3
4
5
6

7
8
9
10
11
12
13
14
15
(defproject x10 "1.0.0"
  :description "A simple x10 controller"
  :aot [x10.war]
  :dependencies [[org.clojure/clojure "1.2.0"]
                 [org.clojure/clojure-contrib "1.2.0"]
		 [ring/ring-core "0.3.2"]

		 [ring/ring-devel "0.3.2"]
		 [ring/ring-servlet "0.3.2"]
		 [org.sqlite "056"]
		 [gnu.io.CommPortIdentifier "2.1.7"]
		 [com.michaeldalal.x10 "1.0.1"]]
  :dev-dependencies [[uk.org.alienscience/leiningen-war "0.0.9"]
		     [swank-clojure "1.2.0"]
		     [javax.servlet/servlet-api "2.5"]
		     [ring/ring-jetty-adapter "0.3.2"]])

Added x10/src/sql/sqlite.sql.









































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
create table controllers (
       name	string primary key,
       module	string not null,
       port	string not null,
       delay	int not null) ;

create table names (
       name	   string primary key,
       controller  string references controllers (name),
       code	   string not null,
       unit 	   string not null,
       unique (code, unit)) ;

create table groups (
       name	string not null,
       device	string references names (name)) ;

create table code (
       name    string primary key,
       command string not null) ;

Changes to x10/src/web.xml.

1
2
3
4
5





6
7
8
9
10
11
12
..
13
14
15
16
17
18
19
20
<webapp>
  <!-- Servlet class taken from first :aot namespace -->
  <servlet>
     <servlet-name>x10</servlet-name>
     <servlet-class>x10.war</servlet-class>





  </servlet>
  <servlet>
    <servlet-name>default</servlet-name>
    <servlet-class>org.mortbay.jetty.servlet.DefaultServlet</servlet-class>
  </servlet>
  <!-- Servlet is mapped to / by default  -->
  <servlet-mapping>
................................................................................
    <servlet-name>default</servlet-name>
    <url-pattern>/help.html</url-pattern>
  </servlet-mapping>
  <servlet-mapping>
     <servlet-name>x10</servlet-name>
     <url-pattern>/*</url-pattern>
  </servlet-mapping>
</webapp>
|




>
>
>
>
>







 







|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
..
18
19
20
21
22
23
24
25
<web-app>
  <!-- Servlet class taken from first :aot namespace -->
  <servlet>
     <servlet-name>x10</servlet-name>
     <servlet-class>x10.war</servlet-class>
     <load-on-startup>1</load-on-startup>
     <init-param>
       <param-name>device-db</param-name>
       <param-value>/usr/local/etc/x10.db</param-value>
     </init-param>
  </servlet>
  <servlet>
    <servlet-name>default</servlet-name>
    <servlet-class>org.mortbay.jetty.servlet.DefaultServlet</servlet-class>
  </servlet>
  <!-- Servlet is mapped to / by default  -->
  <servlet-mapping>
................................................................................
    <servlet-name>default</servlet-name>
    <url-pattern>/help.html</url-pattern>
  </servlet-mapping>
  <servlet-mapping>
     <servlet-name>x10</servlet-name>
     <url-pattern>/*</url-pattern>
  </servlet-mapping>
</web-app>

Changes to x10/src/x10/config.clj.

1
2
3
4





5
6
7
8



9
10
11
12
13
14
15
16
17

18
19
20
21
22
23

24
25
26
27
28

29
30
























































;;; Our local x10 configuration. Eventually, this will move into a database.
;; For now, just a collection of maps to vectors of strings.

(ns x10.config)






;; A list of controllers, each controller being a list of name, type, the port
;; it's connected to, and the delay in this controller requires to settle.
(def *controllers* [["cm17a" "CM17A" "/dev/cuau0" "500"]])




;; A list of all configured devices, each a list consisting of it's name, it's
;; controllers name (first element of a *controllers* vector), the house code
;; and unit it's connected to on that controller
(def *names* [["Grill" "cm17a" "A" "8"]
	      ["TV Lamp" "cm17a" "A" "10"]
	      ["Fireplace Lamp" "cm17a" "A" "11"]
	      ["Back Lamp" "cm17a" "A" "12"]
	      ["Bedroom Lamp" "cm17a" "A" "13"]

	      ["Bedroom Speakers" "cm17a" "A" "4"]
	      ["Thermostat" "cm17a" "A" "5"]
	      ["House Speakers" "cm17a" "M" "3"]
	      ["Library Lamp" "cm17a" "M" "9"]
	      ["Office Light" "cm17a" "M" "10"]
	      ["Printer" "cm17a" "M" "8"]])


;; A list of groups, each of which has the group name and then a vector of names
;; in the group (from *names*).
(def *groups* [["Living Room Lights" ["TV Lamp" "Fireplace Lamp" "Back Lamp"]]
	       ["All Lights" ["TV Lamp" "Fireplace Lamp" "Back Lamp" "Bedroom Lamp"

			      "Library Lamp" "Office Light"]]
	       ["Test" ["Office Light" "House Speakers"]]])
























































|
<

|
>
>
>
>
>

<
<
<
>
>
>

<
<
<
<
|
|
|
<
>
|
|
|
|
|
|
>

<
|
|
<
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1

2
3
4
5
6
7
8
9



10
11
12
13




14
15
16

17
18
19
20
21
22
23
24
25

26
27

28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
;;; Code to load/reload x10 configuration data from the database.


(ns x10.config
  [:use [clojure.set :only (difference)]
        [clojure.contrib.sql
	 :only (with-connection with-query-results transaction)]]
  [:require x10.core]
  [:import gnu.io.CommPortIdentifier [com.micheldalal.x10 CM17A]])




;; The *devices* ref holds the devices map for rendering and finding
;; controllers.
(def *devices* (ref {}))





;; The *ports* ref holds the map from port names (aka /dev/*) to open
;; port objects
(def *ports* (ref {}))


;;; Map from controller type names to code.
;; Note that the keys here must match the types in the controllers
;; table in the database. There should be one entry for each unique
;; controller module. It maps to a function to produce a new
;; controller given a port and delay.
(def +controller-type-map+
  {"CM17A" (fn [port delay] (x10.core.CM17A-controller. (new CM17A) port delay))})


;; Close any open ports as we shut down, or before reloading.
(defn close-ports [] (map #(.close %) (vals @*ports*)))


(defn make-ports-map [new old]
  [(apply hash-map
	  (mapcat #(if-let [port (old %)] [% port]
			   [% (.open (CommPortIdentifier/getPortIdentifier %)
				     "Mike's X10 Controller" 2000)])
		  new))
   (map old (difference (set (keys old)) (set new)))])

;; Load the device database into a set of lists.
;; Since the results are lazy, we have to force them with doall before
;; getting the next set of results.
(defn load-database [db-file]
  (with-connection  {:classname "org.sqlite.JDBC" :subprotocol "sqlite"
		     :subname db-file}
    (transaction
     [(with-query-results controllers ["select * from controllers"]
	(doall controllers))
      (with-query-results names ["select * from names order by name"]
	(doall names))
      (with-query-results groups ["select * from groups order by name"]
	(doall groups))
      (with-query-results ports ["select distinct port from controllers"]
	(doall ports))
      (with-query-results codes ["select * from code"] (doall codes))])))

;; Load the device database in db-file into the *devices* map.
(defn load-devices [db-file]
  (let [[controllers names groups ports codes] (load-database db-file)
	make-map (fn [f list] (apply sorted-map (mapcat f list)))
	controller-map (make-map (fn [{:keys [name module port delay]}]
				   [name (agent ((+controller-type-map+ module)
						 port delay)
						:error-mode :continue)])
				 controllers)
	name-map (make-map (fn [{:keys [name controller code unit]}]
			     [name (x10.core.Module. (controller-map controller)
						     name code unit (atom nil))])
			   names)
	group-map (make-map (fn [[name group]]
			      [name (x10.core.Group. name (map name-map group))])
			    (map (fn [[key vals]] [key (map :device vals)])
				 (group-by :name groups)))
	code-map (conj (make-map (fn [{:keys [name command]}]
				   [name (x10.core.Command. name command)])
				 codes)
		       {"Reload" (x10.core.Command.
				  "Reload" (str "(x10.config/load-devices \""
						db-file "\")"))})]
    (doall
     (map #(.close %) 
	  (dosync
	   (let [[ports-map closing] (make-ports-map (map :port ports)
						     (ensure *ports*))]
	     (doall (map #(x10.core/set-port @% ports-map) (vals controller-map)))
	     (ref-set *ports* ports-map)
	     (ref-set *devices* {"Devices" name-map "Groups" group-map
				 "Code" code-map})
	     closing))))))

Deleted x10/src/x10/controllers.clj.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
;;; Bottom level abstraction - an X10 controller object.
;; These map to an X10 controller attached to the computer. They
;; support three operations: open, close and and set-device. Since
;; these correspond to hardware ("things you can kick") that usually
;; can't be used in parallel, they should always be wrapped by an
;; agent.

(ns x10.controllers
  [:use [x10.config :only (*controllers*)]
   [clojure.walk :only (walk)]]
  [:import gnu.io.CommPortIdentifier [com.micheldalal.x10 CM17A]])

;; The tricky part here is that the open should only happen once. We
;; can't open things when we build the *devices* structure, as it will
;; then happen at compile time, which causes the compile to break.
(defprotocol Controller
  "X10 Controller Modules"
  (open [this] "Whatever is needed to open the controller and ports")
  (close [this] "Close & free the port for possible reuse.")
  (set-device [this code unit state]
    "Set the device at address code/unit to state"))

;;; To add a new controller type
;; Write the appropriate defrecored that instantiates the Controller
;; protocol, then add an entry to the *controller-type-map* to map the
;; name used in the config database to the record.
(deftype CM17A-controller [^CM17A controller ^String port delay]
  Controller
  (open [this]
    (when-not (.getSerialPort controller)
      (.setSerialPort controller
		      (.open (CommPortIdentifier/getPortIdentifier port)
			     "Mike's X10 Controller" 2000))
      (Thread/sleep (Integer/parseInt delay)))
    this)
  (close [this] (.close (.getSerialPort controller)) this)
  (set-device [this code unit new-state]
    (.setState controller (first code) (Integer/parseInt unit) new-state)
    (Thread/sleep (Integer/parseInt delay))
    this))


;;; Map from controller type names to code.
;; Note that the keys here must match the types in
;; config/*controllers*.  There should be one entry for each unique
;; controller type. It maps to a function to produce a new controller
;; given a port and delay.
(def *controller-type-map*
  {"CM17A" (fn [port delay] (CM17A-controller. (new CM17A) port delay))})

;;; Map of all available controllers, built from the above and
(def *controller-map*
  (walk (fn [[name module port delay]]
	  {name (agent ((*controller-type-map* module) port delay))})
	#(apply merge %)
	*controllers*))
	
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


















































































































Changes to x10/src/x10/war.clj.

1
2

3
4
5
6

7
8







9





10
(ns x10.war
  [:use [x10.web :only (handler)]

        [ring.middleware.stacktrace :only (wrap-stacktrace)]
        [ring.middleware.file :only (wrap-file)]
        [ring.util.servlet :only (defservice)]]
  (:gen-class :extends javax.servlet.http.HttpServlet))

  
(def app (wrap-stacktrace #'handler))













(defservice app)


>



|
>

<
>
>
>
>
>
>
>

>
>
>
>
>

1
2
3
4
5
6
7
8
9

10
11
12
13
14
15
16
17
18
19
20
21
22
23
(ns x10.war
  [:use [x10.web :only (handler)]
        [x10.config :only (load-devices close-ports)]
        [ring.middleware.stacktrace :only (wrap-stacktrace)]
        [ring.middleware.file :only (wrap-file)]
        [ring.util.servlet :only (defservice)]]
  (:gen-class :extends javax.servlet.http.HttpServlet
	      :exposes-methods {init initSuper}))
  

(defn -init
  ([this config]
     (. this initSuper config)
     (let [db (.getInitParameter this "device-db")]
       (load-devices db)
       (.log this (str "Setting up *devices* from " db))))
  ([this]))	; because the super config will eventually try and call this.

(defn -destroy []
  (close-ports)
  (shutdown-agents))

(def app (wrap-stacktrace #'handler))
(defservice app)

Changes to x10/src/x10/web.clj.

1
2
3
4
5

6
7
8
9
10
11
12
..
24
25
26
27
28
29
30
31

32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
;;; Web page generation for the x10 project

(ns x10.web [:use ring.middleware.params org.mired.bitchin.html
	          [clojure.string :only (join)]
	          [x10.core :only (*devices* set-state)]])


;; Execute the command on the device.
(defn do-command [command device]
  (case command
	"on" (set-state device true)
	"off" (set-state device false)
	(str "Unknown command " command ".")))
................................................................................
			     (a {:href (format "%s?display=%s" uri new-display)}
				new-display))))))
	 (apply table
		(for [device (map second (devices display))]
		  (let [fmt (format "%s?command=%%s&display=%s&what=%s" 
				    uri display (:name device))]
		    (tr (td (a {:href (format fmt "on")} "on"))
			(td {:align "center" :style (case @(:state device)

						      true  "color:green"
						      false "color:red"
						      "color:inherit")} 
			    (:name device))
			(td (a {:href (format fmt "off")} "off"))))))
	 (p response))))


;; The actual app handler
(defn my-handler [req]
  (let [{:strs [command display what] :or {display "Devices"}} (:query-params req)
	result (if-let [device (get-in *devices* [display what])]
		 (do-command command device)
		 (if what (str "Unknown device " what " in " display ".")))]
    {:status 200 
     :headers {"Content-type" "text/html" "Cache-Control" "no-cache"}
     :body (write-page *devices* display (:uri req) result)}))

(def handler (wrap-params my-handler))




|
>







 







|
>
|
|
|








|




|


1
2
3
4
5
6
7
8
9
10
11
12
13
..
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
;;; Web page generation for the x10 project

(ns x10.web [:use ring.middleware.params org.mired.bitchin.html
	          [clojure.string :only (join)]
	          [x10.core :only (set-state)]
	          [x10.config :only (*devices*)]])

;; Execute the command on the device.
(defn do-command [command device]
  (case command
	"on" (set-state device true)
	"off" (set-state device false)
	(str "Unknown command " command ".")))
................................................................................
			     (a {:href (format "%s?display=%s" uri new-display)}
				new-display))))))
	 (apply table
		(for [device (map second (devices display))]
		  (let [fmt (format "%s?command=%%s&display=%s&what=%s" 
				    uri display (:name device))]
		    (tr (td (a {:href (format fmt "on")} "on"))
			(td {:align "center"
			     :style (case (when-let [state (:state device)] @state)
					  true  "color:green"
					  false "color:red"
					  "color:inherit")} 
			    (:name device))
			(td (a {:href (format fmt "off")} "off"))))))
	 (p response))))


;; The actual app handler
(defn my-handler [req]
  (let [{:strs [command display what] :or {display "Devices"}} (:query-params req)
	result (if-let [device (get-in @*devices* [display what])]
		 (do-command command device)
		 (if what (str "Unknown device " what " in " display ".")))]
    {:status 200 
     :headers {"Content-type" "text/html" "Cache-Control" "no-cache"}
     :body (write-page @*devices* display (:uri req) result)}))

(def handler (wrap-params my-handler))