commit 122080c3cbb2b50ad04a8d1b75447ca7ffe9fe84
parent 6d7c4756690a788f2d1cbcf4c5eb1c9aff91c91e
Author: Tomas Hlavaty <tom@logand.com>
Date: Mon, 12 Aug 2013 00:36:40 +0200
curry the monstrosity
Diffstat:
| M | ipp.lisp | | | 726 | +++++++++++++++++++++++++++++-------------------------------------------------- |
1 file changed, 261 insertions(+), 465 deletions(-)
diff --git a/ipp.lisp b/ipp.lisp
@@ -22,13 +22,22 @@
(defpackage :ipp
(:use :cl)
- (:export :create-job
+ (:export :cancel-job
+ :create-job
+ :disable-printer
+ :enable-printer
+ :get-job-attributes
:get-jobs
:get-printer-attributes
+ :hold-job
:list-printers
+ :make-job
+ :make-printer
:pause-printer
:print-job
:purge-jobs
+ :release-job
+ :restart-job
:resume-printer
:validate-job))
@@ -92,12 +101,13 @@
(:copies . :integer)
(:sides . :keyword)
(:job-uri . :uri)
- (:job-id . nil)
+ (:job-id . :integer)
(:job-state . nil)
(:job-state-reasons . nil)
(:limit . :integer)
(:requested-attributes . :keyword)
- (:status-message . :nameWithoutLanguage) really?
+ (:status-message . :textWithoutLanguage)
+ (:message . :textWithoutLanguage) ;; TODO really?
(:marker-change-time . nil)
(:printer-current-time . nil)
(:printer-dns-sd-name . nil)
@@ -426,53 +436,78 @@
(defun user-name ()
(car (last (pathname-directory (user-homedir-pathname)))))
-(defun print-job (ipp-client
- printer-uri
- request-file
- response-file
- data-file
- request-id
- &key
- (attributes-charset "utf-8")
- (attributes-natural-language "en")
- (requesting-user-name (user-name))
- job-name
- (ipp-attribute-fidelity t)
- document-name
- document-format
- document-natural-language
- compression
- job-k-octets
- job-impressions
- job-media-sheets
- copies
- sides)
- (ipp ipp-client
- printer-uri
- request-file
- response-file
- data-file
- request-id
- :print-job
- `((,(tag :operation-attributes-tag)
- :attributes-charset ,attributes-charset
- :attributes-natural-language ,attributes-natural-language
- :printer-uri ,printer-uri)
- (,(tag :job-attributes-tag)
- :requesting-user-name ,requesting-user-name
- :job-name ,job-name
- :ipp-attribute-fidelity ,ipp-attribute-fidelity
- :document-name ,document-name
- :document-format ,document-format
- :document-natural-language ,document-natural-language
- :compression ,compression
- :job-k-octets ,job-k-octets
- :job-impressions ,job-impressions
- :job-media-sheets ,job-media-sheets
- :copies ,copies
- :sides ,sides))))
-
-(defun validate-job (ipp-client
+(defun get-printer-attributes (printer &key requested-attributes
+ document-format limit)
+ (funcall printer :get-printer-attributes
+ :requested-attributes requested-attributes
+ :document-format document-format
+ :limit limit))
+
+(defun pause-printer (printer)
+ (funcall printer :pause-printer))
+
+(defun resume-printer (printer)
+ (funcall printer :resume-printer))
+
+(defun enable-printer (printer)
+ (funcall printer :enable-printer))
+
+(defun disable-printer (printer)
+ (funcall printer :disable-printer))
+
+(defun create-job (printer)
+ (funcall printer :create-job))
+
+(defun purge-jobs (printer)
+ (funcall printer :purge-jobs))
+
+(defun get-jobs (printer &key requested-attributes which-jobs completed
+ not-completed my-jobs limit)
+ (funcall printer :get-jobs
+ :requested-attributes requested-attributes
+ :which-jobs which-jobs
+ :completed completed
+ :not-completed not-completed
+ :my-jobs my-jobs
+ :limit limit))
+
+(defun print-job (printer data-file &key job-name (ipp-attribute-fidelity t)
+ document-name document-format
+ document-natural-language compression
+ job-k-octets job-impressions
+ job-media-sheets copies sides)
+ (funcall printer :print-job data-file
+ :job-name job-name
+ :ipp-attribute-fidelity ipp-attribute-fidelity
+ :document-name document-name
+ :document-format document-format
+ :document-natural-language document-natural-language
+ :compression compression
+ :job-k-octets job-k-octets
+ :job-impressions job-impressions
+ :job-media-sheets job-media-sheets
+ :copies copies
+ :sides sides))
+
+(defun validate-job (printer &key job-name (ipp-attribute-fidelity t)
+ document-name document-format
+ document-natural-language compression
+ job-k-octets job-impressions
+ job-media-sheets copies sides)
+ (funcall printer :validate-job
+ :job-name job-name
+ :ipp-attribute-fidelity ipp-attribute-fidelity
+ :document-name document-name
+ :document-format document-format
+ :document-natural-language document-natural-language
+ :compression compression
+ :job-k-octets job-k-octets
+ :job-impressions job-impressions
+ :job-media-sheets job-media-sheets
+ :copies copies
+ :sides sides))
+
+(defun make-printer (ipp-client
printer-uri
request-file
response-file
@@ -480,180 +515,99 @@
&key
(attributes-charset "utf-8")
(attributes-natural-language "en")
- (requesting-user-name (user-name))
- job-name
- (ipp-attribute-fidelity t)
- document-name
- document-format
- document-natural-language
- compression
- job-k-octets
- job-impressions
- job-media-sheets
- copies
- sides)
- (ipp ipp-client
- printer-uri
- request-file
- response-file
- nil
- request-id
- :validate-job
- `((,(tag :operation-attributes-tag)
- :attributes-charset ,attributes-charset
- :attributes-natural-language ,attributes-natural-language
- :printer-uri ,printer-uri)
- (,(tag :job-attributes-tag)
- :requesting-user-name ,requesting-user-name
- :job-name ,job-name
- :ipp-attribute-fidelity ,ipp-attribute-fidelity
- :document-name ,document-name
- :document-format ,document-format
- :document-natural-language ,document-natural-language
- :compression ,compression
- :job-k-octets ,job-k-octets
- :job-impressions ,job-impressions
- :job-media-sheets ,job-media-sheets
- :copies ,copies
- :sides ,sides))))
-
-(defun create-job (ipp-client
- printer-uri
- request-file
- response-file
- request-id
- &key
- (attributes-charset "utf-8")
- (attributes-natural-language "en"))
- (ipp ipp-client
- printer-uri
- request-file
- response-file
- nil
- request-id
- :create-job
- `((,(tag :operation-attributes-tag)
- :attributes-charset ,attributes-charset
- :attributes-natural-language ,attributes-natural-language
- :printer-uri ,printer-uri))))
-
-;; TODO send-document
-
-(defun cancel-job (ipp-client
- printer-uri
- request-file
- response-file
- request-id
- job-id
- &key
- (attributes-charset "utf-8")
- (attributes-natural-language "en")
- (requesting-user-name (user-name))
- message)
- (ipp ipp-client
- printer-uri
- request-file
- response-file
- nil
- request-id
- :cancel-job
- `((,(tag :operation-attributes-tag)
- :attributes-charset ,attributes-charset
- :attributes-natural-language ,attributes-natural-language
- :printer-uri ,printer-uri
- :requesting-user-name ,requesting-user-name
- :job-id ,job-id
- :message ,message))))
-
-(defun get-job-attributes (ipp-client
- printer-uri
- request-file
- response-file
- request-id
- job-id
- &key
- (attributes-charset "utf-8")
- (attributes-natural-language "en")
- limit
- requested-attributes)
- (assert (let ((x '(:job-template :job-description :all)))
- (equal x (union x requested-attributes))))
- (ipp ipp-client
- printer-uri
- request-file
- response-file
- nil
- request-id
- :get-job-attributes
- `((,(tag :operation-attributes-tag)
- :attributes-charset ,attributes-charset
- :attributes-natural-language ,attributes-natural-language
- :printer-uri ,printer-uri
- :job-id ,job-id
- :limit ,limit
- :requested-attributes ,requested-attributes))))
-
-(defun get-jobs (ipp-client
- printer-uri
- request-file
- response-file
- request-id
- &key
- (attributes-charset "utf-8")
- (attributes-natural-language "en")
- (requesting-user-name (user-name))
- limit
- requested-attributes
- which-jobs
- completed
- not-completed
- my-jobs)
- (ipp ipp-client
- printer-uri
- request-file
- response-file
- nil
- request-id
- :get-jobs
- `((,(tag :operation-attributes-tag)
- :attributes-charset ,attributes-charset
- :attributes-natural-language ,attributes-natural-language
- :printer-uri ,printer-uri
- :requesting-user-name ,requesting-user-name
- :limit ,limit
- :requested-attributes ,requested-attributes
- :which-jobs ,which-jobs
- :completed ,completed
- :not-completed ,not-completed
- :my-jobs ,my-jobs))))
-
-(defun get-printer-attributes (ipp-client
- printer-uri
- request-file
- response-file
- request-id
- &key
- (attributes-charset "utf-8")
- (attributes-natural-language "en")
- limit
- requested-attributes)
- (assert (let ((x '(:job-template :printer-description :all)))
- (equal x (union x requested-attributes))))
- (ipp ipp-client
- printer-uri
- request-file
- response-file
- nil
- request-id
- :get-printer-attributes
- `((,(tag :operation-attributes-tag)
- :attributes-charset ,attributes-charset
- :attributes-natural-language ,attributes-natural-language
- :printer-uri ,printer-uri
- :limit ,limit
- :requested-attributes ,requested-attributes))))
-
-(defun hold-job (ipp-client
+ (requesting-user-name (user-name)))
+ (lambda (msg &rest args)
+ (flet ((%ipp (&optional oa ja data-file)
+ (ipp ipp-client printer-uri request-file response-file data-file
+ request-id msg
+ `((,(tag :operation-attributes-tag)
+ :attributes-charset ,attributes-charset
+ :attributes-natural-language ,attributes-natural-language
+ :requesting-user-name ,requesting-user-name
+ :printer-uri ,printer-uri
+ ,@oa)
+ (,(tag :job-attributes-tag) ,@ja)))))
+ (ecase msg
+ (:get-printer-attributes
+ (destructuring-bind (&key requested-attributes document-format
+ limit) args
+ #+nil ;; TODO sort
+ (assert (let ((x '(:job-template :printer-description :all)))
+ (equal x (union x requested-attributes))))
+ (%ipp (list :requested-attributes requested-attributes
+ :document-format document-format
+ :limit limit))))
+ ((:pause-printer :resume-printer :enable-printer :disable-printer
+ :create-job :purge-jobs)
+ ;; TODO check spec for :enable-printer and :disable-printer
+ (destructuring-bind () args
+ (%ipp)))
+ (:get-jobs
+ (destructuring-bind (&key requested-attributes which-jobs completed
+ not-completed my-jobs limit) args
+ (%ipp (list :requested-attributes requested-attributes
+ :which-jobs which-jobs
+ :completed completed
+ :not-completed not-completed
+ :my-jobs my-jobs
+ :limit limit))))
+ (:print-job
+ (destructuring-bind (data-file
+ &key job-name (ipp-attribute-fidelity t)
+ document-name document-format
+ document-natural-language compression
+ job-k-octets job-impressions
+ job-media-sheets copies sides) args
+ (%ipp nil
+ (list :job-name job-name
+ :ipp-attribute-fidelity ipp-attribute-fidelity
+ :document-name document-name
+ :document-format document-format
+ :document-natural-language document-natural-language
+ :compression compression
+ :job-k-octets job-k-octets
+ :job-impressions job-impressions
+ :job-media-sheets job-media-sheets
+ :copies copies
+ :sides sides)
+ data-file)))
+ (:validate-job
+ (destructuring-bind (&key job-name (ipp-attribute-fidelity t)
+ document-name document-format
+ document-natural-language compression
+ job-k-octets job-impressions
+ job-media-sheets copies sides) args
+ (%ipp nil
+ (list :job-name job-name
+ :ipp-attribute-fidelity ipp-attribute-fidelity
+ :document-name document-name
+ :document-format document-format
+ :document-natural-language document-natural-language
+ :compression compression
+ :job-k-octets job-k-octets
+ :job-impressions job-impressions
+ :job-media-sheets job-media-sheets
+ :copies copies
+ :sides sides))))))))
+
+(defun cancel-job (job &optional message)
+ (funcall job :cancel-job message))
+
+(defun get-job-attributes (job &key requested-attributes limit)
+ (funcall job :get-job-attributes
+ :requested-attributes requested-attributes
+ :limit limit))
+
+(defun hold-job (job &optional job-hold-until)
+ (funcall job :hold-job job-hold-until))
+
+(defun restart-job (job &optional job-hold-until)
+ (funcall job :restart-job job-hold-until))
+
+(defun release-job (job)
+ (funcall job :release-job))
+
+(defun make-job (ipp-client
printer-uri
request-file
response-file
@@ -662,149 +616,45 @@
&key
(attributes-charset "utf-8")
(attributes-natural-language "en")
- (requesting-user-name (user-name))
- job-hold-until)
- (ipp ipp-client
- printer-uri
- request-file
- response-file
- nil
- request-id
- :hold-job
- `((,(tag :operation-attributes-tag)
- :attributes-charset ,attributes-charset
- :attributes-natural-language ,attributes-natural-language
- :printer-uri ,printer-uri
- :requesting-user-name ,requesting-user-name
- :job-id ,job-id
- :job-hold-until ,job-hold-until))))
-
-(defun release-job (ipp-client
- printer-uri
- request-file
- response-file
- request-id
- job-id
- &key
- (attributes-charset "utf-8")
- (attributes-natural-language "en")
- (requesting-user-name (user-name)))
- (ipp ipp-client
- printer-uri
- request-file
- response-file
- nil
- request-id
- :release-job
- `((,(tag :operation-attributes-tag)
- :attributes-charset ,attributes-charset
- :attributes-natural-language ,attributes-natural-language
- :printer-uri ,printer-uri
- :requesting-user-name ,requesting-user-name
- :job-id ,job-id))))
-
-(defun restart-job (ipp-client
- printer-uri
- request-file
- response-file
- request-id
- job-id
- &key
- (attributes-charset "utf-8")
- (attributes-natural-language "en")
- (requesting-user-name (user-name))
- job-hold-until)
- (ipp ipp-client
- printer-uri
- request-file
- response-file
- nil
- request-id
- :restart-job
- `((,(tag :operation-attributes-tag)
- :attributes-charset ,attributes-charset
- :attributes-natural-language ,attributes-natural-language
- :printer-uri ,printer-uri
- :requesting-user-name ,requesting-user-name
- :job-id ,job-id
- :job-hold-until ,job-hold-until))))
-
-(defun pause-printer (ipp-client
- printer-uri
- request-file
- response-file
- request-id
- &key
- (attributes-charset "utf-8")
- (attributes-natural-language "en")
- (requesting-user-name (user-name)))
- (ipp ipp-client
- printer-uri
- request-file
- response-file
- nil
- request-id
- :pause-printer
- `((,(tag :operation-attributes-tag)
- :attributes-charset ,attributes-charset
- :attributes-natural-language ,attributes-natural-language
- :printer-uri ,printer-uri
- :requesting-user-name ,requesting-user-name))))
-
-(defun resume-printer (ipp-client
- printer-uri
- request-file
- response-file
- request-id
- &key
- (attributes-charset "utf-8")
- (attributes-natural-language "en")
- (requesting-user-name (user-name)))
- (ipp ipp-client
- printer-uri
- request-file
- response-file
- nil
- request-id
- :resume-printer
- `((,(tag :operation-attributes-tag)
- :attributes-charset ,attributes-charset
- :attributes-natural-language ,attributes-natural-language
- :printer-uri ,printer-uri
- :requesting-user-name ,requesting-user-name))))
-
-(defun purge-jobs (ipp-client
- printer-uri
- request-file
- response-file
- request-id
- &key
- (attributes-charset "utf-8")
- (attributes-natural-language "en")
- (requesting-user-name (user-name)))
- (ipp ipp-client
- printer-uri
- request-file
- response-file
- nil
- request-id
- :purge-jobs
- `((,(tag :operation-attributes-tag)
- :attributes-charset ,attributes-charset
- :attributes-natural-language ,attributes-natural-language
- :printer-uri ,printer-uri
- :requesting-user-name ,requesting-user-name))))
-
-;; TODO set-job-attributes
-;; TODO create-printer-subscription
-;; TODO create-job-subscription
-;; TODO get-subscription-attributes
-;; TODO get-subscriptions
-;; TODO renew-subscription
-;; TODO cancel-subscription
-;; TODO get-notifications
-;; TODO enable-printer
-;; TODO disable-printer
+ (requesting-user-name (user-name)))
+ (lambda (msg &rest args)
+ (flet ((%ipp (&optional attributes)
+ (ipp ipp-client printer-uri request-file response-file nil
+ request-id msg
+ `((,(tag :operation-attributes-tag)
+ :attributes-charset ,attributes-charset
+ :attributes-natural-language ,attributes-natural-language
+ :requesting-user-name ,requesting-user-name
+ :printer-uri ,printer-uri
+ :job-id ,job-id
+ ,@attributes)))))
+ (ecase msg
+ (:cancel-job
+ (destructuring-bind (&optional message) args
+ (%ipp (list :message message))))
+ (:get-job-attributes
+ (destructuring-bind (&key requested-attributes limit) args
+ #+nil ;; TODO sort
+ (assert (let ((x '(:job-template :job-description :all)))
+ (equal x (union x requested-attributes))))
+ (%ipp (list :requested-attributes requested-attributes
+ :limit limit))))
+ ((:hold-job :restart-job)
+ (destructuring-bind (&optional job-hold-until) args
+ (%ipp (list :job-hold-until job-hold-until))))
+ (:release-job
+ (destructuring-bind () args
+ (%ipp)))))))
+
+;; TODO send-document
+;; TODO ? set-job-attributes
+;; TODO ? create-printer-subscription
+;; TODO ? create-job-subscription
+;; TODO ? get-subscription-attributes
+;; TODO ? get-subscriptions
+;; TODO ? renew-subscription
+;; TODO ? cancel-subscription
+;; TODO ? get-notifications
;; TODO cups-get-default
(defun cups-get-default (ipp-client
@@ -927,18 +777,7 @@
:response-file response-file
:content-type content-type))
-#+nil
-(ipp:print-job 'ipp-client
- "http://localhost:631/printers/Virtual_PDF_Printer"
- "request2.dat"
- "response2.dat"
- "test.txt"
- 314)
-
-#+nil
-(ipp:list-printers 'ipp-client
- "http://localhost:631/printers/"
- "printers.html")
+;;(ipp:list-printers 'ipp-client "http://localhost:631/printers/" "printers.html")
(defpackage :ipp.curl
(:use :cl)
@@ -968,88 +807,6 @@
:content-type content-type))
#+nil
-(ipp:print-job 'ipp-client
- "http://localhost:631/printers/Virtual_PDF_Printer"
- "request2.dat"
- "response2.dat"
- "test.txt"
- 314
- :ipp-attribute-fidelity nil
- :copies 2
- :sides "two-sided-long-edge"
- )
-
-#+nil
-(ipp:validate-job 'ipp-client
- "http://localhost:631/printers/Virtual_PDF_Printer"
- "request2.dat"
- "response2.dat"
- 314
- :ipp-attribute-fidelity nil
- :copies 2
- :sides "two-sided-long-edge"
- )
-
-#+nil
-(ipp:create-job 'ipp-client
- "http://localhost:631/printers/Virtual_PDF_Printer"
- "create-jobs.in"
- "create-jobs.out"
- 314)
-
-#+nil
-(ipp:get-printer-attributes
- 'ipp-client
- "http://localhost:631/printers/Virtual_PDF_Printer"
- "request2.dat"
- "response2.dat"
- 314)
-
-#+nil
-(ipp:get-printer-attributes ;; TODO fix
- 'ipp-client
- "http://localhost:631/printers/Virtual_PDF_Printer"
- "request2.dat"
- "response2.dat"
- 314
- :limit 2
- :requested-attributes '(:job-template :printer-description))
-
-#+nil
-(ipp:get-printer-attributes
- 'ipp-client
- "http://localhost:631/printers/Virtual_PDF_Printer"
- "request2.dat"
- "response2.dat"
- 314
- :limit 2
- :requested-attributes '(:all))
-
-#+nil
-(ipp:get-jobs 'ipp-client
- "http://localhost:631/printers/Virtual_PDF_Printer"
- "request2.dat"
- "response2.dat"
- 314)
-
-#+nil
-(ipp:get-jobs 'ipp-client
- "http://localhost:631/printers/Virtual_PDF_Printer"
- "request2.dat"
- "response2.dat"
- 314
- :limit 2)
-
-#+nil
-(ipp:get-jobs 'ipp-client
- "http://localhost:631/printers/Virtual_PDF_Printer"
- "request2.dat"
- "response2.dat"
- 314
- :limit 2
- :requested-attributes '(:job-id))
-
-#+nil
(ipp::cups-get-default 'ipp-client
"http://localhost:631/printers/Virtual_PDF_Printer"
"request2.dat"
@@ -1063,7 +820,46 @@
"response2.dat"
314)
-#+nil
-(ipp:list-printers 'ipp-client
- "http://localhost:631/printers/"
- "printers.html")
+;;(ipp:list-printers 'ipp-client "http://localhost:631/printers/" "printers.html")
+
+(let ((p (ipp:make-printer
+ 'ipp-client
+ "http://localhost:631/printers/Virtual_PDF_Printer"
+ "request2.dat"
+ "response2.dat"
+ 314)))
+ (ipp:get-printer-attributes p)
+ ;;(ipp:get-printer-attributes p :limit 2)
+ ;;(ipp:get-printer-attributes p requested-attributes '(:all))
+ ;;TODO (ipp:get-printer-attributes p requested-attributes '(:printer-description))
+ ;;TODO (ipp:get-printer-attributes p requested-attributes '(:job-template))
+ ;;TODO (ipp:get-printer-attributes p requested-attributes '(:job-template :printer-description))
+ ;;TODO login (ipp:pause-printer p)
+ ;;TODO login (ipp:resume-printer p)
+ ;;TODO login (ipp:enable-printer p)
+ ;;TODO login (ipp:disable-printer p)
+ ;;(ipp:create-job p)
+ ;;TODO login (ipp:purge-jobs p)
+ ;;(ipp:get-jobs p)
+ ;;(ipp:get-jobs p :limit 2)
+ ;;(ipp:get-jobs p :requested-attributes '(:job-id))
+ ;;(ipp:get-jobs p :requested-attributes '(:job-description))
+ ;;(ipp:get-jobs p :requested-attributes '(:job-id :job-description))
+ ;;(ipp:get-jobs p :requested-attributes '(:all))
+ ;;(ipp:print-job p "test.txt" :ipp-attribute-fidelity nil :copies 2 :sides "two-sided-long-edge")
+ ;;(ipp:validate-job p :ipp-attribute-fidelity nil :copies 2 :sides "two-sided-long-edge")
+ )
+
+(let ((x (ipp:make-job
+ 'ipp-client
+ "http://localhost:631/printers/Virtual_PDF_Printer"
+ "request2.dat"
+ "response2.dat"
+ 314
+ 100 #+nil"http://localhost:631/jobs/100")))
+ (ipp:cancel-job x "cancelling from cl-ipp")
+ ;;(ipp:get-job-attributes x)
+ ;;(ipp:hold-job x)
+ ;;(ipp:restart-job x)
+ ;;(ipp:release-job x)
+ )
