src/depth_adapter.clj

   1
   2 (ns depth_adapter
   3
   4   (:import com.interrupt.bookkeeping.cc.analysis.DepthFirstAdapter)
   5
   6         ;;(:require clojure.contrib.str-utils2)
   7         (:require clojure.contrib.http.agent)
   8         (:require clojure.contrib.io)
   9         (:require clojure.contrib.string)
  10
  11   (:use helpers)
  12   (:use clojure.xml)
  13
  14   (:require xml_handler)
  15   (:require opts_handler)
  16   (:require xpath_handler)
  17
  18   (:require commands.add)
  19   (:require commands.authenticate)
  20
  21 )
  22
  23
  24 (use 'clj-stacktrace.repl)
  25 (comment try
  26  ("foo")
  27  (catch Exception e
  28    (clj-stacktrace.repl/pst e)))
  29
  30
  31 (defn operate-dep-inputtype
  32         [node handler_block]    ;; input args ; for now we are going to load by ID
  33
  34         (let [ checks [ xml_handler option_handler xpath_handler/xpath_handler ] ]
  35
  36                         (doseq [ each_check checks ]
  37                                 (do
  38                                         ;;(println "DEBUG > each > check[" each_check "] > node[" node "]" )
  39                                         (each_check node handler_block)
  40                                 )
  41                         )
  42
  43         )
  44
  45 )
  46
  47 (defn get-depth-adapter []
  48
  49    (proxy [DepthFirstAdapter] []
  50
  51          ;; EXIT command
  52          (caseAExitCommand4 [node]
  53
  54             (println (str "DEBUG > caseAExitCommand4: " node))
  55
  56             (proxy-super inAExitCommand4 node)
  57             (proxy-super outAExitCommand4 node)
  58
  59                         (dosync
  60                                 (alter bkell/shell conj         ;; make the shell inactive to disable loop
  61                                         {       :active false }))
  62
  63          )
  64
  65
  66          ;; LOGIN command
  67          (caseALoginCommand3 [node]
  68             (println "DEBUG > caseALoginCommand3: " node)
  69
  70
  71             (proxy-super inALoginCommand3 node)
  72
  73             (if (not= (. node getLogin ) nil)
  74                (.. node getLogin (apply this) ) )
  75
  76             (if (not= (. node getLbracket ) nil)
  77                (.. node getLbracket (apply this) ) )
  78
  79       (if (not= (. node getCommandInput ) nil)
  80
  81               (do
  82
  83                 (.. node getCommandInput (apply this) )
  84
  85                         ;; execute LOGIN
  86                                 (operate-dep-inputtype node
  87                                         (fn [result_seq]
  88
  89                         (login-user result_seq)
  90                                                 (println "DEBUG > logged-in-user > " (@bkell/shell :logged-in-user))
  91                                         ))
  92                 )
  93             )
  94
  95       (if (not= (. node getRbracket ) nil)
  96                (.. node getRbracket (apply this) ) )
  97
  98       (proxy-super outALoginCommand3 node)
  99
 100          )
 101
 102          ;; PRINT command
 103          (caseAPrintCommand6 [node]
 104             ;;(println (str "caseAPrintCommand6: " node))
 105
 106         (proxy-super inAPrintCommand6 node)
 107
 108         (if (not= (. node getPrint) nil)
 109             (.. node getPrint (apply this)))
 110
 111
 112         (if (not= (. node getLbracket) nil)
 113             (.. node getLbracket (apply this)))
 114
 115         (if (not= (. node getCommandInput) nil)
 116             (.. node getCommandInput (apply this))
 117         )
 118
 119         ;; print the result
 120                 (println " > " (:previous @bkell/shell))
 121
 122         (if (not= (. node getRbracket) nil)
 123             (.. node getRbracket (apply this)))
 124
 125         (proxy-super outAPrintCommand6 node)
 126
 127      )
 128
 129      ;; CREATE command
 130     (caseACreateCommand3 [node]
 131
 132         (proxy-super inACreateCommand3 node)
 133
 134         (if (not= (. node getCreate) nil)
 135             (.. node getCreate (apply this)))
 136
 137         (if (not= (. node getLbracket) nil)
 138             (.. node getLbracket (apply this)))
 139
 140         (if (not= (. node getCommandInput) nil)
 141
 142             (do
 143             (.. node getCommandInput (apply this))
 144
 145                 ;; execute LOGIN
 146                         (operate-dep-inputtype node
 147                                 (fn [result_seq]
 148
 149                                         (println "DEBUG > create result > " result_seq)
 150                                         (dosync (alter bkell/shell conj { :previous result_seq }))
 151                                 ))
 152              )
 153         )
 154
 155         (if (not= (. node getRbracket) nil)
 156             (.. node getRbracket (apply this)))
 157
 158         (proxy-super outACreateCommand3 node)
 159
 160     )
 161
 162
 163     ;; UPDATE command
 164     (caseAUpdateCommand1 [node] ;; AUpdateCommand1 node
 165
 166         (proxy-super inAUpdateCommand1 node)
 167
 168         (if (not= (. node getUpdate) nil)
 169             (.. node getUpdate (apply this)))
 170
 171         (if (not= (. node getLbdepth1) nil)
 172             (.. node getLbdepth1 (apply this)))
 173
 174         (if (not= (. node getLbdepth2) nil)
 175             (.. node getLbdepth2 (apply this)))
 176
 177         (if (not= (. node getC1) nil)
 178
 179             (do
 180                 (.. node getC1 (apply this))
 181                             (operate-dep-inputtype (. node getC1)
 182                                     (fn [result_seq]
 183
 184                                             (println "DEBUG > update CONTEXT result > " result_seq)
 185                                             (dosync (alter bkell/shell conj { :previous result_seq }))
 186                                     ))
 187             )
 188         )
 189
 190         (if (not= (. node getRbdepth2) nil)
 191             (.. node getRbdepth2 (apply this)))
 192
 193         (if (not= (. node getC2) nil)
 194
 195             (do
 196                 (.. node getC2 (apply this))
 197                             (operate-dep-inputtype (. node getC2)
 198                                     (fn [result_seq]
 199
 200                                             (println "DEBUG > update CLIENT input [ " (.. node getC1) " ] > result > " result_seq)
 201
 202                         (dosync (alter bkell/shell assoc :mode "update"))
 203                                             (dosync (alter bkell/shell conj { :previous result_seq }))
 204                                     ))
 205             )
 206         )
 207
 208         (if (not= (. node getRbdepth1) nil)
 209             (.. node getRbdepth1 (apply this)))
 210
 211         (proxy-super outAUpdateCommand1 node)
 212
 213     )
 214
 215      ;; COMMIT
 216     (caseACommitCommand7 [node]     ;; ACommitCommand7 node
 217
 218         (proxy-super inACommitCommand7 node)
 219
 220         (if (not= (. node getCommit ) nil)
 221             (.. node getCommit (applythis)))
 222
 223         (if (not= (. node getLbdepth1) nil)
 224             (.. node getLbdepth1 (apply this)))
 225
 226         (if (not= (. node getLbdepth2) nil)
 227             (.. node getLbdepth2 (apply this)))
 228
 229         (if (not= (. node getInput1 ) nil)
 230
 231             (.. node getInput1 (apply this))
 232
 233         )
 234
 235         (if (not= (. node getRbdepth2) nil)
 236             (.. node getRbdepth2 (apply this)))
 237
 238         (if (not= (. node getInput2) nil)
 239
 240             (.. node getInput2 (apply this))
 241
 242         )
 243
 244         (if (not= (. node getRbdepth1) nil)
 245             (.. node getRbdepth1 (apply this)))
 246
 247         (proxy-super outACommitCommand7 node)
 248
 249     )
 250
 251
 252
 253      ;; VARIABLE assignment
 254      (caseATwohandexpr [node]   ;; ATwohandexpr node
 255
 256
 257         (proxy-super inATwohandexpr node)
 258
 259         (if (not= (. node getVar ) nil)
 260             (.. node getVar (apply this)))
 261
 262         (if (not= (. node getWord) nil)
 263
 264             (do
 265                 (.. node getWord (apply this)))
 266         )
 267         (if (not= (. node getEquals) nil)
 268             (.. node getEquals (apply this)))
 269
 270         (if (not= (. node getCommand ) nil)
 271             (do
 272                 (.. node getCommand (apply this)) )
 273         )
 274
 275         ;; the 'previousCommandResult' has already been set
 276         ;; get variable name
 277         (let [variableName (.. node getWord getText trim)]
 278
 279             (println "putting variableName into memory[" variableName "] > previous > " (:previous @bkell/shell) )
 280
 281             ;; setting the variableName to the command result
 282                     (dosync (alter bkell/shell assoc
 283                                        (keyword variableName)
 284                        (:previous @bkell/shell)
 285                      ))
 286
 287         )
 288
 289         (proxy-super outATwohandexpr node)
 290
 291      )
 292
 293      ;; VARIABLE access
 294      (caseAVarCommandInput [node]   ;; AVarCommandInput node
 295
 296         (proxy-super inAVarCommandInput node)
 297
 298         (if (not= (. node getVarname ) nil)
 299
 300             (.. node getVarname (apply this))
 301
 302             ;; remove the '@' sign
 303             ;;** if this fails, then the user only put in the '@'
 304             (let [variableName (.. node getVarname toString (substring 1) trim) ]
 305
 306                         (dosync (alter bkell/shell assoc
 307                        :previous
 308                                        ((keyword variableName) @bkell/shell)
 309                      ))
 310
 311             )
 312         )
 313
 314         (proxy-super outAVarCommandInput node )
 315
 316      )
 317
 318      ;; LOAD command
 319          (caseALoadCommand3 [node]
 320             (println "DEBUG > caseALoadCommand3 [" (class (. node getCommandInput)) "]: " node)
 321
 322             (comment "replicating java calls in the 'DepthFirstAdapter.caseALoadCommand3'")
 323
 324
 325             (proxy-super inALoadCommand3 node)
 326
 327             (if (not= (. node getLoad ) nil)
 328                (.. node getLoad (apply this) ) )
 329
 330             (if (not= (. node getLbracket ) nil)
 331                (.. node getLbracket (apply this) ) )
 332
 333             (if (not= (. node getCommandInput ) nil)
 334
 335                     (do ;; execute 'if' block
 336                                   (.. node getCommandInput (apply this) )
 337
 338
 339                                         (if (not (contains? @bkell/shell :logged-in-user ))     ;; check if there is a 'logged-in-user'
 340
 341                                 ;;throw an error if no 'logged-in-user'
 342                                 (println "ERROR - NO logged-in-user")
 343
 344                                 ;; execute LOAD
 345                                 (operate-dep-inputtype node (fn [result_seq]
 346
 347                                                         (println "loading... " result_seq)
 348                                                         (dosync (alter bkell/shell conj
 349                                                                                 {       :previous result_seq }))
 350                                                 ))
 351
 352                                   )
 353
 354                     )
 355             )
 356
 357             (if (not= (. node getRbracket ) nil)
 358                (.. node getRbracket (apply this) ) )
 359
 360
 361             (proxy-super outALoadCommand3 node)
 362
 363          )
 364
 365         (caseStart [node]
 366
 367                         (println "DEBUG > caseStart CALLED > bkell/shell[" @bkell/shell "]")
 368
 369                         (proxy-super inStart node)
 370
 371       (.. node getPExpr (apply this) )
 372       (.. node getEOF (apply this) )
 373
 374       (proxy-super outStart node)
 375
 376         )
 377
 378         (caseAAddCommand1 [node]                ;; public void caseAAddCommand1(AAddCommand1 node)
 379
 380                                 (println "DEBUG > caseAAddCommand1 [" (class (. node getCommandInput)) "]: " node)
 381
 382
 383         (proxy-super inAAddCommand1 node)
 384
 385                     (if (not= (. node getAdd ) nil)
 386                        (.. node getAdd (apply this) ) )
 387
 388         (if (not= (. node getLbdepth1 ) nil)
 389                        (.. node getLbdepth1 (apply this) ) )
 390
 391                     (if (not= (. node getLbdepth2 ) nil)
 392                        (.. node getLbdepth2 (apply this) ) )
 393
 394         (if (not= (. node getCommandInput ) nil)
 395
 396                  (do
 397
 398                             ;; any i) 'load' ii) direct XML or iii) variable should be in the shell's :previous
 399                                 (.. node getCommandInput (apply this) )
 400
 401                                 ;; set the :previous result as the :command-context
 402                                 (operate-dep-inputtype node
 403                                         (fn [result_seq]
 404
 405                                                 (println "DEBUG > add CONTEXT result > " result_seq)
 406                                         (dosync (alter bkell/shell conj
 407                                                                 { :command-context result_seq } ))
 408                                         ))
 409                        )
 410                     )
 411
 412                     (if (not= (. node getRbdepth2 ) nil)
 413                        (.. node getRbdepth2 (apply this) ) )
 414
 415                     (println)
 416                     (println "shell > before arguments > [" @bkell/shell "]")
 417                                 (let [ copy (. node getIlist) ]
 418
 419                                                 (doseq [ each_copy copy ]
 420                                                         (do
 421
 422                                                                 ;; apply each element in the list
 423                                                                 (. each_copy apply this)
 424                                                                 (operate-dep-inputtype each_copy
 425                                                                         (fn [result_seq]
 426
 427                                         (let [  aclient
 428                                                 (conj   ( :command-context @bkell/shell )
 429                                                         { :content (assoc result_seq :mode "create")})
 430                                              ]
 431                                                                 (dosync (alter bkell/shell conj
 432                                                 { :previous aclient } ) )
 433                                         )
 434                                                 (println "shell > F3 > [" @bkell/shell "]")
 435                                                                         ))
 436                                                         )
 437                                                 )
 438
 439                                 )
 440         (if (not= (. node getRbdepth1 ) nil)
 441                        (.. node getRbdepth1 (apply this) ) )
 442
 443         (proxy-super outAAddCommand1 node)
 444
 445         )
 446
 447
 448         )
 449 )
 450
 451
 452