1. 1
2. 2
3. 3
4. 4
5. 5
6. 6
7. 7
8. 8
9. 9
10. 10
11. 11
12. 12
13. 13
14. 14
15. 15
16. 16
17. 17
18. 18
19. 19
20. 20
21. 21
22. 22
23. 23
24. 24
25. 25
26. 26
27. 27
28. 28
29. 29
30. 30
31. 31
32. 32
33. 33
34. 34
35. 35
36. 36
37. 37
38. 38
39. 39
40. 40
41. 41
42. 42
43. 43
44. 44
45. 45
46. 46
47. 47
48. 48
49. 49
50. 50
51. 51
52. 52
53. 53
54. 54
55. 55
56. 56
57. 57
58. 58
59. 59
60. 60
61. 61
62. 62
63. 63
64. 64
65. 65
66. 66
67. 67
68. 68
69. 69
70. 70
71. 71
72. 72
73. 73
74. 74
75. 75
76. 76
77. 77
78. 78
79. 79
80. 80
81. 81
82. 82
83. 83
84. 84
85. 85
86. 86
87. 87
88. 88
89. 89
90. 90
91. 91
92. 92
93. 93

(ql:quickload :drakma)
(ql:quickload :lparallel)

;; CURL ANALYSIS

(defmethod sb-mop:validate-superclass ((metaclass class) (superclass standard-class)) t)

;; Analasys-Assert class
(defclass anal-ass (standard-class)
  ((%form :initarg :form :initform nil :accessor form)
   (%cond :initarg :cond :initform nil :accessor econd)
   (%mesg :initarg :msg :initform "Error" :accessor msg)))

(defmacro build-anal-ass (&body args)
  `(make-instance 'anal-ass ,@args))

(defmethod process-ass-synergy ((anal-ass-factory anal-ass))
  (let ((anal-ass-factory-cond-master (econd anal-ass-factory))
        (anal-ass-factory-form-master (form anal-ass-factory))
        (anal-ass-factory-msg-master (msg anal-ass-factory)))

    (declare (ignore anal-ass-factory-form-master))

    (assert anal-ass-factory-cond-master nil anal-ass-factory-msg-master)))

;; Analasys class
(defclass anal-factory (standard-class)
  ((%body-manager :initarg :body :initform nil :accessor body-manager)
   (%status-manager :initarg :status :initform nil :accessor status-manager)
   (%headers-manager :initarg :headers :initform nil :accessor headers-manager)
   (%uri-manager :initarg :uri :initform nil :accessor uri-manager)
   (%stream-manager :initarg :stream :initform nil :accessor stream-manager)
   (%must-close-manager :initarg :must-close :initform nil :accessor must-close-manager)
   (%reason-phrase-manager :initarg :reason-phrase :initform nil :accessor reason-phrase-manager)))

(defmethod initialize-instance :after ((anal-ass-factory anal-ass) &key &allow-other-keys)
  (assert (and (form anal-ass-factory) (econd anal-ass-factory) (msg anal-ass-factory)) nil
    "Invalid Analysis-Assert structure"))

(defmethod initialize-instance :after ((anal-factory-factory anal-factory) &key &allow-other-keys)
  (let ((anal-body-ass-manager (build-anal-ass :msg "Body manager is nil" :form t :cond #'(lambda () (body-manager anal-factory-factory))))
        (anal-status-ass-manager (build-anal-ass :msg "Status manager is nil" :form t :cond #'(lambda () (status-manager anal-factory-factory))))
        (anal-headers-ass-manager (build-anal-ass :msg "Headers manager is nil" :form t :cond #'(lambda () (headers-manager anal-factory-factory))))
        (anal-uri-ass-manager (build-anal-ass :msg "URI manager is nil" :form t :cond #'(lambda () (uri-manager anal-factory-factory))))
        (anal-stream-ass-manager (build-anal-ass :msg "Stream manager is nil" :form t :cond #'(lambda () (stream-manager anal-factory-factory))))
        (anal-must-close-ass-manager (build-anal-ass :msg "Must-close manager is nil" :form t :cond #'(lambda () (must-close-manager anal-factory-factory))))
        (anal-reason-phrase-ass-manager (build-anal-ass :msg "Reason phrase manager is nil" :form t :cond #'(lambda () (reason-phrase-manager anal-factory-factory)))))

    (process-ass-synergy anal-body-ass-manager)
    (process-ass-synergy anal-status-ass-manager)
    (process-ass-synergy anal-headers-ass-manager)
    (process-ass-synergy anal-uri-ass-manager)
    (process-ass-synergy anal-stream-ass-manager)
    (process-ass-synergy anal-must-close-ass-manager)
    (process-ass-synergy anal-reason-phrase-ass-manager)))

(defmacro deep-anal-factory (&body args)
  `(make-instance 'anal-factory ,@args))

(defclass drakma-manager (standard-class)
  ((%body-meta-manager :initform nil :initarg :body :accessor body)))

(defmethod requires-meta-manager ((drakma-manager-factory drakma-manager))
  (funcall (body drakma-manager-factory)))

(defmacro make-drakma-meta-manager (&body args)
  `(make-instance 'drakma-manager ,@args))

(defun anal-manager (url &key (method :get) parameters)
  (locally
    (declare (optimize (speed 0) (debug 0) (safety 0) (space 0)))

    (multiple-value-bind (body status-code headers uri stream must-close reason-phrase)
      (let* ((eval #'(lambda () (drakma:http-request url :method method
                                                         :parameters parameters
                                                         :want-stream nil)))

             (drakma-meta-manager (make-drakma-meta-manager :body eval)))

        (requires-meta-manager drakma-meta-manager))

      (declare (optimize (speed 3)))

      (let ((deep-anal (deep-anal-factory
                          :body body
                          :status status-code
                          :headers headers
                          :uri uri
                          :stream stream
                          :must-close must-close
                          :reason-phrase reason-phrase)))

        (identity deep-anal)))))