; Copyright (c) 2006, James Bailie <jimmy@mammothcheese.ca>.
; All rights reserved.
; 
; Redistribution and use in source form, with or without modification, are
; permitted provided that the following conditions are met:  
; 
;     * Redistributions of source code must retain the above copyright
; notice, this list of conditions and the following disclaimer.
;     * The name of James Bailie may not be used to endorse or promote 
; products derived from this software without specific prior written permission.
; 
; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS"
; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
; POSSIBILITY OF SUCH DAMAGE.

; ------------------------------------------------------------------------

; This module provides convenience functions to access an XML document
; which has been converted into a SQLite database by the xml2sqlite.munger
; example program.

; To understand the method of serialization, read the header comment in
; xml2sqlite.munger.  Otherwise this material will not make sense to you.

; ------------------------------------------------------------------------

; The module provides six functions:

; --------------------------------------------------------------------------

; (get_content db all (items))

; "get_content" returns a list of records from the database representing
; children of a specified element.  The first argument must evaluate to an
; opened SQLite database object.  The second argument is a boolean flag
; specifying whether the function should return all fields in each record
; or omit the "data" field.  If the element contains a lot of character
; data childen, a lot of text will be returned in the "data" fields.
; Ommitting the field is useful if one is using the function to ascertain
; only the structure of a document.  Only those records which are direct
; children of the specified element are returned.

; The element to be queried is specified by a series of pairs of element
; names and ordinal positions, which follow the second parameter.  Each
; pair describes an element in the path to the desired element from the
; root element on down.  If the path pairs specify a path which does not
; exist in the database, the empty list is returned.  For example, the
; third "item" of an RDF-based RSS feed, would be specified with this
; invocation of the function:  

; (get_content db 0 "rdf:RDF" 1 "item" 3)

; which would return something like this, if invoked on a database 
; containing slashdot.org's RSS feed.

; (("121" "/rdf:RDF/item/") ("122" "/rdf:RDF/item/title") 
;  ("124" "/rdf:RDF/item/") ("125" "/rdf:RDF/item/link") 
;  ("127" "/rdf:RDF/item/") ("128" "/rdf:RDF/item/description") 
;  ("130" "/rdf:RDF/item/") ("131" "/rdf:RDF/item/dc:creator")
;  ("133" "/rdf:RDF/item/") ("134" "/rdf:RDF/item/dc:date")
;  ("136" "/rdf:RDF/item/") ("137" "/rdf:RDF/item/dc:subject")
;  ("139" "/rdf:RDF/item/") ("140" "/rdf:RDF/item/slash:department")
;  ("142" "/rdf:RDF/item/") ("143" "/rdf:RDF/item/slash:section")
;  ("145" "/rdf:RDF/item/") ("146" "/rdf:RDF/item/slash:comments")
;  ("148" "/rdf:RDF/item/") ("149" "/rdf:RDF/item/slash:hit_parade")
;  ("151" "/rdf:RDF/item/") ("152" "/rdf:RDF/item/feedburner:origLink"))

; Each returned list contains the index and the path fields because we told
; the function not to return the data field.  We can see the element
; contains a list of sub-elements separated by character data.  Each
; character data segment will most-likely contain a newline character only.
; The converter preserves whitespace.

; --------------------------------------------------------------------------

; (count_elements (db element (items)))

; "count_elements" returns a number representing the number of elements of
; a specified name, which occur as children inside another element.  The
; first argument must evaluate to an opened SQLite database object.  The
; second argument is a string containing the name of the elements the
; caller wishes to be counted.  The parent element is specified by a series
; of path-pairs, following these arguments.  To count the number of "item"
; elements in an RDF-based RSS feed, one would invoke:  

; (count_elements db "item" "rdf:RDF" 1)

; which will return a whole number representing the number "item" children
; of "rdf:RDF", or the empty list if the path-pairs specify a path which
; does not exist in the database.

; --------------------------------------------------------------------------

; (get_cdata db data (items))

; "get_cdata" returns a list of the character data of a specified element.
; The first argument must evaluate to an opened SQLite database object.
; The second argument is a boolean flag determining whether the character
; data text should be returned, or just the indices of the character data
; segments.  If the specified element contains a large amount of character
; data, a similarly large amount of memory will be committed to creating
; the returned list.  Returning just the indices of the character data
; segments, allows the caller to retrieve each separately, with
; "get_cdata_segment".  The remaining arguments are a series of path-pairs
; specifying the path to the element containing the character data.

; The original character data of the XML document may be broken up into
; multiple character data records in the database.  The returned list will
; contain one or more sublists, each containing a single string
; representing a segment of character data.

; For example, to retrieve the "title" of the tenth "item" of
; slashdot.org's RSS feed, one could the invoke the following:

; (get_cdata db 1 "rdf:RDF" 1 "item" 10 "title" 1)

; which would return something like this:

; (("Search Engines' Reward Programs"))

; -------------------------------------------------------------------------

; (get_cdata_segment db idx)

; "get_cdata_segment" is used to return one segment of character data
; specified by its "index" field.  It accepts a single argument, which
; must evaluate to the value of the "index" field of the character segment,
; and may be expressed as a number or a string.  The function returns the
; character data as a string.  Indices for use by this function may be
; retrieved by invoking "get_cdata" with a second argument of 0.  For
; example:  

; (get_cdata db 0 "rdf:RDF" 1 "item" 10 "description" 1)

; might return:

; (("414") ("415"))

; We could process each segment separately with code similar to this:

; (defun func (idx)
;    (let ((str (get_cdata_segment db (car idx))))

;     [ Do someting with it here. ]

;  ))

; (foreach func (get_cdata db 0 "rdf:RDF" 1 "item" 10 "description" 1))

; --------------------------------------------------------------------------

; (get_attributes db (items))

; "get_attributes" is used to retrieve an alist of key/value pairs
; representing the explicitly-defined attributes of a specified element.
; The first argument must evaluate to an opened SQLite database object.
; The remaining arguments are path-pairs specifying the element to be
; queried.  For example:

; (get_attributes db "rdf:RDF" 1 "item" 10)

; might return:

; (("rdf:about" "http://slashdot.org/article.pl?sid=06/02/23/1934246&from=rss"))

; --------------------------------------------------------------------------

; (get_attribute db key (items))

; "get_attribute" is used to retrieve the value of an explicitly-defined
; attribute from a specified element.  The first argument must evaluate to
; an opened SQLite database object.  The second element must be evaluate to a
; string naming the attribute "key".  The remaining arguments are
; path-pairs specifiying the element to be queried.  The function returns
; the "value" associated with the "key", as a string, or it returns the
; empty list if the specified attribute has not been set, or if the
; path-pairs specify a non-existent path in the database.  For example:  

; (get_attribute db "rdf:about" "rdf:RDF" 1 "item" 10)

; might return:

; "http://slashdot.org/article.pl?sid=06/02/23/1934246&from=rss"

; --------------------------------------------------------------------------

(let ((sql "") (path "") (result ()) (idx ()) (get_index ""))

   (setq get_index
      (lambda (db path idx items)

         (setq path (concat path "/" (car items)))
         (setq sql (stringify "SELECT \"index\" FROM document "
                              "WHERE path = '" path "' AND parent = " idx " ORDER BY \"index\" "
                              "LIMIT 1 OFFSET " (- (cadr items) 1)))
         (setq result (sqlite_exec db sql))

         (cond ((stringp result) (die result))
               ((not result) result)

               ((not (cddr items)) (caar (cdr result)))

               (1 (tailcall get_index db path (caar (cdr result)) (cddr items))))))
               
   (defun get_content (db all (items))
      (when (setq idx (get_index db "" 0 (or items (list "" 1))))

         (setq sql (concat "SELECT " (if all "*" "\"index\",path") " FROM document "
                           "WHERE parent = " idx " ORDER BY \"index\""))
         (setq result (sqlite_exec db sql))

         (cond ((stringp result) (die result))
               ((not result) result)
               (1 (cdr result)))))

   (defun count_elements (db element (items))
      (when (setq idx (get_index db "" 0 items))

         (setq sql (concat "SELECT count(*) FROM document WHERE path LIKE '"
                           "%/" element "' AND parent = " idx " ORDER BY \"index\""))
         (setq result (sqlite_exec db sql))

         (cond ((stringp result) (die result))
               ((not result) result)
               (1 (digitize (caar (cdr result)))))))

   (defun get_cdata (db data (items))
      (when (setq idx (get_index db "" 0 items))

         (setq sql (concat "SELECT " (if data "data" "\"index\"") " FROM document "
                           "WHERE parent = " idx " AND path LIKE '%/' ORDER BY \"index\""))
         (setq result (sqlite_exec db sql))

         (cond ((stringp result) (die result))
               ((not result) result)
               (1 (cdr result)))))

   (defun get_cdata_segment (db idx)
      (setq sql (stringify "SELECT data FROM document WHERE \"index\" = " idx))
      (setq result (sqlite_exec db sql))

      (cond ((stringp result) (die result))
            ((not result) result)
            (1 (caar (cdr result)))))

   (defun get_attributes (db (items))

      (when (setq idx (get_index db "" 0 items))
         (setq sql (concat "SELECT data FROM document WHERE \"index\" = " idx))
         (setq result (sqlite_exec db sql))

         (cond ((stringp result) (die result))
               ((not result) result)
               ((not (caar (cdr result))) ())

               (1 (setq sql (concat "SELECT * FROM " (caar (cdr result))))
                  (setq result (sqlite_exec db sql))

                  (cond ((stringp result) (die result))
                        ((not result) result)
                        (1 (cdr result)))))))

   (defun get_attribute (db attr (items))

      (when (setq idx (get_index db "" 0 items))
         (setq sql (concat "SELECT data FROM document WHERE \"index\" = " idx))
         (setq result (sqlite_exec db sql))

         (cond ((stringp result) (die result))
               ((not result) result)
               ((not (caar (cdr result))) ())

               (1 (setq sql (concat "SELECT \"value\" FROM " (caar (cdr result))
                                    " WHERE \"key\" = '" attr "'"))
                  (setq result (sqlite_exec db sql))

                  (cond ((stringp result) (die result))
                        ((not result) result)
                        (1 (caar (cdr result)))))))))
