From 63a8ebfa14d6a7de77595e737ff4430b1923f9d0 Mon Sep 17 00:00:00 2001
From: Peter Bex <peter@more-magic.net>
Date: Thu, 9 Jun 2011 22:00:44 +0200
Subject: Nasty modification to api-request to allow for multiple alist results
(the sending APIs return one record for each phone number in the list or
group)
---
smsmatrix.scm | 65 +++++++++++++++++++++++++++++++++++++++++++++++------------
1 file changed, 52 insertions(+), 13 deletions(-)
diff --git a/smsmatrix.scm b/smsmatrix.scm
index b0a3cce..2518fa6 100644
--- a/smsmatrix.scm
+++ b/smsmatrix.scm
@@ -6,7 +6,8 @@
(module smsmatrix
(smsmatrix-username smsmatrix-password
- get-credits get-rate carrier-name message-status call-with-csv-report)
+ get-credits get-rate carrier-name message-status call-with-csv-report
+ send-sms)
(import chicken scheme)
@@ -80,23 +81,38 @@
(define (schemify-string str)
(string->symbol (string-translate (string-downcase str) "_" "-")))
-(define (read-fields-as-alist port)
+(define (read-fields-as-alist port split-at)
;; next-line contains a workaround for #568
(let ((next-line (lambda ()
(let ((l (read-line port)))
(if (string? l) (string-chomp l "\r") l)))))
- (let lp ((alist '())
+ (let lp ((entry '())
+ (alist '())
(line (next-line)))
- (cond ((eof-object? line) (reverse! alist))
- ((string=? "" line) (lp alist (next-line)))
+ (cond ((eof-object? line)
+ (if (null? entry)
+ (reverse! alist)
+ (reverse! (cons entry alist))))
+ ((string=? "" line) (lp entry alist (next-line)))
(else (receive (key value)
(string-split-char line #\=)
(let ((keysym (schemify-string key)))
- (lp (cons (cons keysym value) alist) (next-line)))))))))
-
-(define (api-request loc uri params required-result-values)
+ (cond
+ ((not split-at)
+ (lp '() (cons (cons keysym value) alist) (next-line)))
+ ((eq? keysym split-at)
+ (lp (cons (cons keysym value) '())
+ (if (null? entry) alist (cons entry alist))
+ (next-line)))
+ (else ;; split-at, but split point not reached
+ (lp (cons (cons keysym value) entry)
+ alist (next-line)))))))))))
+
+(define (api-request loc uri params split-at required-result-values)
(let* ((request (make-request method: 'POST uri: (uri-reference uri)))
- (res (call-with-input-request request params read-fields-as-alist)))
+ (res (call-with-input-request
+ request params (lambda (port)
+ (read-fields-as-alist port split-at)))))
(for-each
(lambda (element)
(unless (alist-ref element res)
@@ -134,7 +150,7 @@
(let-auth 'get-credits username password
(let* ((res (api-request 'get-credits balance-uri `((username . ,username)
(password . ,password))
- '(balance)))
+ #f '(balance)))
(balance (alist-ref 'balance res)))
(maybe-extract-error-code 'get-credits balance)
(or (string->number balance)
@@ -146,7 +162,8 @@
(error 'get-rate "Unknown rate type" type)
(let* ((rate-type (string->symbol (conc type "-rate")))
(res (api-request 'get-rate rate-uri
- `((phone . ,phone-number)) `(,rate-type)))
+ `((phone . ,phone-number))
+ #f `(,rate-type)))
(rate (alist-ref rate-type res)))
(cond ((string-ci=? rate "NOT SUPPORTED")
(error 'get-rate "Phone number is not supported or invalid"
@@ -160,7 +177,7 @@
(let* ((res (api-request 'carrier-name carrier-uri `((username . ,username)
(password . ,password)
(phone . ,phone-number))
- '(carrier)))
+ #f '(carrier)))
(carrier (alist-ref 'carrier res)))
(maybe-extract-error-code 'carrier-name carrier)
carrier)))
@@ -170,7 +187,7 @@
(let* ((res (api-request 'message-status status-uri `((username . ,username)
(password . ,password)
(id . ,message-id))
- '(id status timezone statustxt timestamp)))
+ #f '(id status timezone statustxt timestamp)))
(status (alist-ref 'status res))
(status-text (alist-ref 'statustxt res)))
(error-on-bad-result-code 'message-status status status-text message-id res)
@@ -195,4 +212,26 @@
(in . ,(if incoming-only? 1 0)))))
(call-with-input-request request params proc))))
+(define (send-sms recipients message #!key
+ username password group tts-fallback (error-on-failure #t))
+ (let-auth 'send-sms username password
+ (let* ((recipient-type (if group 'group 'phone))
+ (res (api-request 'send-sms sms-uri `((username . ,username)
+ (password . ,password)
+ (,recipient-type . ,recipients)
+ (txt . ,message)
+ (tts . ,(if tts-fallback 1 0)))
+ 'pin '())))
+ (print res)
+ ;; Check for errors in phone number recipients if it was asked for
+ (when error-on-failure
+ (for-each (lambda (entry)
+ (let ((status (alist-ref 'statuscode entry))
+ (status-text (alist-ref 'statustxt entry))
+ (pin (alist-ref 'pin entry)))
+ (error-on-bad-result-code
+ 'send-sms status status-text pin)))
+ res))
+ res)))
+
)
\ No newline at end of file
--
cgit v1.2.3