Googledocs

rebol [
	file: googledocs.r
	author: "Graham Chiu"
	rights: 'BSD
	date: 15-Aug-2009
	notes: { authenticates using clientauth against googledocs, and upload an acceptable document.  Returns an XML object with accessor functions }
	comment: {
		16-Aug-2009 - get list of folders and resourceids
	}
]

do %/c/rebol-sdk-276/source/prot-http.r ; enhanced http protocol
do http://www.ross-gill.com/r/altxml.r ; Chris' XML parser - see http://www.ross-gill.com/page/XML+and+REBOL

googledocs: make object! [
	auth: none ; the authentication token - can store in db and restore it.
	folders: copy [] ; holds the list of folders
	set-auth: func [ token [string!] ][ self/auth: token ]
	authenticate: func [ email [email!] password [string!] client [string!] service [string!]
		/insecure { use http and not https }
		/local token page
	][
		page: read/custom join either insecure [ http:// ][https://] "www.google.com/accounts/ClientLogin" compose 
		[ POST 
		(rejoin [ "Email=" email "&Passwd=" password "&source=" client "&service=" service] ) ]
		either parse page [ to "Auth=" copy token to end ][
			set-auth trim/tail token
			true
		][ false ]
	]
	
	create-doc+metadata: func [ docname [string!]
		/local template
	][
		rejoin [ {<?xml version='1.0' encoding='UTF-8'?>
<atom:entry xmlns:atom="http://www.w3.org/2005/Atom">
  <atom:category scheme="http://schemas.google.com/g/2005#kind"
      term="http://schemas.google.com/docs/2007#document" label="document"/>
  <atom:title>} docname {</atom:title>
</atom:entry>}] 
	]
	
	upload-document: func [ docname [string!] source [file! string!] content-type [string!]
		/raw
		/local boundary filedata result payload
	][
		if none? self/auth [ return false ] ; or throw an error
		boundary: rejoin ["__REBOL__" system/version "__" checksum form now/precise "__"]
		filedata: either file? source [ read/binary source ][ source ]
		payload: to-string rejoin [ #{} "--" boundary newline "Content-Type: application/atom+xml" newline newline create-doc+metadata docname newline newline "--" boundary newline "Content-Type: " content-type newline newline  
filedata newline newline "--" boundary "--" newline newline]
		result: read/custom http://docs.google.com/feeds/documents/private/full compose/deep [ 
			POST (payload)   
			[ content-type: (rejoin [ "multipart/related; boundary=" boundary ]) Authorization: (join "GoogleLogin " self/auth) ]
]
		either raw [ result ][
			load-xml/dom result
		]
	]
	
	read-resource: func [ resource [string!] /local url][
		url: switch/default resource [
			"folders" [ http://docs.google.com/feeds/documents/private/full/-/folder?showfolders=true ]
		
		][ none ]
		either url [
			read/custom url compose/deep [ GET "" [ content-type: "application/atom+xml" Authorization: (join "GoogleLogin " self/auth) ] ] 
		][
			false
		]
	]
	
	get-list-of-folders: func [ /raw /local page xmlobject result title resourceb][
		result: copy []
		page: read-resource "folders"
		either all [ not raw page ] [
			; process page to retrieve resourceids and folder names and return as a block of [ name resourceids pairs ]
			xmlobject: load-xml/dom page
			; gets a block of entries
			; entries: xmlobject/get-by-tag <entry>
			foreach entry xmlobject/get-by-tag <entry> [
				; get the title first
				title: entry/get-by-tag <title>
				; title is a block! but there should be only one member
				; if the folder name is not present, add it
				if not find result name: select title/1/value /text [
					repend result [ name copy [] ] 
				]
				; now get the resourceid with this folder
				resourceb: entry/get-by-tag <resourceid>
				; append the resourceid value to the block associated with this foldername - if we have duplicate folder names, we get a block of resourceids
				append select result name resourceb/1/value				
			]
			self/folders: copy/deep result
			result
		][
			page
		]
	]
	
	get-folder-resourceids: func [ foldername /local folders][
		if empty? self/folders [
			folders: get-list-of-folders
		]
		select self/folders foldername
	]
]

halt
; create an instance of the googledocs object
gdoc: make googledocs []

; authenticate against the documents service named "writely"
goggledocs/authenticate myname@gmail.com q@$$w0rb "rebolapp" "writely"

; upload a text document to root folder and return an xmlobject with accessor functions
xmlobject: googledocs/upload-document "my document" %test.rtf "application/msword" 

; upload a text document to root folder and return the raw XML
xml: gdoc/upload-document/raw "my document" %test.rtf "application/msword" 

; upload a binary document to root folder, and call it "my document"
xml: googledocs/upload-document/raw "my document" %test.rtf "application/msword" 

; get the resourceid for a folder
id: gdoc/get-folder-resourceids "my folder"
>>[{folder:0B6ELdnC15jkoOWRhNDJlMTgtYjhkOS00YTli............}]