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