DZone Snippets: Frontera000's Code Snippets

sha1

frontera000 (bob bae) — Sat, 14 Oct 2006 09:10:40 GMT

// description of your code here



(setq SHA1 (import "libssl.so.4" "SHA1"))



(join (map (lambda (x) (format "%02x" (& x 0xff))) (unpack (dup "c" 20) (get-string (SHA1 "abc" 3 0)))))



;; produces "a9993e364706816aba3e25717850c26c9cd0d89d"

int->hexstr and hexstr->int

frontera000 (bob bae) — Sat, 14 Oct 2006 09:07:04 GMT

// description of your code here



(set 'hextab "0123456789abcdef")



(define (int->hexstr num)

  (set 'hexstr "")

  (for (i 0 63 4)

       (push (hextab (& (>> num i) 0xf)) hexstr))

  (append "0x" hexstr))



(define (hexstr->int str)

  (set 'num 0)

  (set 'str (pop str 2))

  (for (i 0 15 1)

       (| (<< (find (str i) hextab) (* 4 i)) num)))

pairlis

frontera000 (bob bae) — Sat, 14 Oct 2006 08:30:48 GMT

// common LISP compatible pairlis for newLISP





;; 

;;(pairlis '(1 2 3) '("one" "two" "three") '((4 "four"))) 

;;



 

(define (pairlis keys data alist) 

  (setq data2 data) 

  (setq newlist '()) 

  (dolist (x keys) 

          (push (list x (pop data2)) newlist -1)) 

  (append newlist alist)) 



;; newLISPy way



(define (pairlis keys data alist) 

  (append (map (lambda (x y) (list x y)) keys data) alist))

Amazon REST API for newLISP

frontera000 (bob bae) — Fri, 13 Oct 2006 10:16:27 GMT



;; (amazon-op "Operation=ItemSearch&SearchIndex=Books&ItemPage=1&Keywords=Cloud+Atlas&Respon\

seGroup=Request,Small")

;;

;; (amazon-op "Operation=SimilarityLookup&ItemId=1400063795,0812966929&SimilarityType=Random\

&ResponseGroup=Request,Large")

;; (amazon-op "Operation=SimilarityLookup&ItemId=1400063795,061873516X,0812966929&Similarity\

Type=Random&ResponseGroup=Request,Small")



;;  (setq x (xml-digest (amazon-op "Operation=ItemLookup&ItemId=0375507256&ResponseGroup=Req\

uest,Similarities,ListmaniaLists")))

;; Using x get a list of listmanias for an item

;;  (map (lambda (x) (x 1 2 2)) (1 -1 (x (chop (ref 'ListmaniaLists  x)))))



;; (setq y (amazon-op "Operation=ListLookup&ListType=Listmania&ListId=R21LV6VJEZ794O&Respons\

eGroup=ListFull"))

;; Using y get a list of ISBNs from a listmania

;; (map (lambda(x) (x 4 1 2 )) (8 -1 ( (y (chop (ref 'Lists y)) ) 2))) ; gives list of ISBNs\

 from the listmania



;; get a list of listmania details from a list of listmanias.

;;  (setq z   (map (lambda (x) (xml-digest (amazon-op (append "Operation=ListLookup&ListType\

=Listmania&ListId=" x "&ResponseGroup=ListFull"))))  (map (lambda (x) (x 1 2 2)) (1 -1 (x (c\

hop (ref 'ListmaniaLists  x))))))  )

;;

;; get a list of ISBNs from all of the listmanias for the item

;; (setq z (flat (map (lambda(y) (map (lambda(x) (x 4 1 2 )) (8 -1 ( (y (chop (ref 'Lists y)\

) ) 2))) ) z)))

;;



;; get item info for all the ISBNs from all listmanias related to the original item

;; (setq w (map (lambda (x) (xml-digest (amazon-op (append "Operation=ItemLookup&ItemId=" x)\

)))  (unique z)))



;; get a list of pair (title,author) from w above.

;; (map (lambda (x) (list ((x (chop (ref 'Title x))) 1)  (if (ref 'Author x)((x (chop (ref '\

Author x)))1) "???"))) w)



(define (amazon-op params)

  (get-url (append 

"http://webservices.amazon.com/onca/xml?Service=AWSECommerceService&&AWSAccessKeyId=YOUROWNKEY&" params)))



(define (xml-digest result)

  (xml-type-tags nil nil nil nil)

  (setq xresult (xml-parse result (+ 1 2 4 8 16))))

infinite loop or stack overflow

frontera000 (bob bae) — Fri, 06 Oct 2006 00:42:19 GMT

// description of your code here



(define (x x) (x x))



(x x)



;; Or



((lambda (x) (x x)) (lambda (x) (x x)))

Build Logo using Flickr alphabet pictures in newLISP

frontera000 (bob bae) — Fri, 06 Oct 2006 00:39:41 GMT

// it uses my FLICKR context for newLISP
// demo available at http://terpri.com



(define (alphabet-flickr myletter, alph y myurl)

    (setq alph (xml-digest (FLICKR "flickr.groups.pools.getPhotos" nil

                  (append "group_id=27034531@N00&tags=" myletter))))

    (setq alph (clean nil? (map (lambda(x) (if (= myletter ((x (chop(ref 'title x))) 1)) x)) (\

2 -1 (alph 0 2)))))

    (setq y (first (randomize (sequence 0 (length alph)))))

    (setq y (alph y 1))

    (setq myurl (format "http://static.flickr.com/%s/%s_%s_s.jpg"

                       (lookup 'server y)(lookup 'id y)(lookup 'secret y)))

    (println ""))



    (if (= page-name "Home")

      (begin

            (println {})

            (map (lambda (x) (alphabet-flickr x)) '("T" "E" "R" "P" "R" "I"))

            (println "")))

Ping technorati using xml-rpc in newLISP

frontera000 (bob bae) — Fri, 06 Oct 2006 00:35:36 GMT

// description of your code here



(setq technorati-request [text] 

 

  weblogUpdates.ping 

   

     

      %s 

     

     

      %s 

     

   

 

[/text]) 







 (XMLRPC:execute  "http://rpc.technorati.com/rpc/ping" (format technorati-request "terpri.com" "http://terpri.com"))

library mashup

frontera000 (bob bae) — Sat, 30 Sep 2006 03:52:13 GMT

// description of your code here



;; combine APIs and other web available bibliographic data.

;; Use amazon, LibraryThing, and OCLC Worldcat.

;; Get ISBN numbers for a book by searching author and title.

;; Get the list of available ISBNs from different sources.

;; Get "tags" available for a book from LibraryThing for

;; a given book.

;; etc.

;;

;; N.B. A person from LibraryThing.com posted a comment

;; regarding this program, indicating that the tag cloud data

;; is copyrighted. 

;;

;; Here's the quoted message:

;;

;; Tim's message: "And it's fine here, as a test, and probably in other 

;; contexts where it could be considered "fair use" under copyright. 

;; But--unlike the thingISBN service and some other LibraryThing 

;; APIs--LibraryThing's tag clouds are not free for public use, 

;; outside of the RSS feeds and widgets we provide. 

;; We're not sure how and under what license to 

;; release them when we do."

;;

;; So, I wrote this for fun.  If I were you I wouldn't run it, just read

;; the code.  :-)

;;





(define (search-worldcat title author)

  (setq title (replace " " title "+"))

  (setq author (replace " " author "+"))

  (get-url (append "http://worldcatlibraries.org/search?q=ti:" title "+au:" author "&qt=advanced")))



(setq oclc-url-1-pattern {

(define (oclc-url-1 str)

  (setq loc (find oclc-url-1-pattern str))

  (setq loc (+ loc (length oclc-url-1-pattern)))

  (setq loc (+ 1 loc))

  (setq loc-end (find ">" (loc -1 str)))

  (setq loc-end (- loc-end 1))

  (setq loc-url (loc loc-end str))

  (println (append "http://worldcatlibraries.org" loc-url))

  (get-url (append "http://worldcatlibraries.org" loc-url)))



(setq oclc-isbn-pattern "ISBN: ")



(define (find-isbn str)

  (setq loc (find oclc-isbn-pattern str))

  (setq loc (+ loc (length oclc-isbn-pattern)))

  (setq loc-end (find "" (loc -1 str)))

  (loc loc-end str))



(define (thing-isbn isbn)

  (xml-type-tags nil nil nil nil)

  (setq isbn-data 

      (xml-parse (get-url  

          (append "http://www.librarything.com/api/thingISBN/" isbn)))))



(define (get-isbn-list isbn-data)

  (setq indexer (ref "isbn" isbn-data))

  (nth-set 2 indexer 2)

  (setq num-isbns (length  (isbn-data 0)))

  (setq isbn-list '())

  (for (idx (first (1 indexer))  (- num-isbns 1))

        (push (isbn-data (first (0 indexer)) idx (first (2 indexer))) isbn-list -1))

   isbn-list)



(define (add-explorer-path)

   (env "PATH" (append (env "PATH" ) ";c:\\program files\\internet explorer")))



(define (show-amazon-isbn isbn)

   (process (append "iexplore " "http://www.amazon.com/exec/obidos/ASIN/"

           isbn )))





(define (get-librarything-isbn isbn)

    (get-url (append "http://librarything.com/isbn/" isbn)))



(define (get-librarything-tagsection str)

    (setq loc (find "Tags used" str ))

    (setq mystr (loc -1 str))

    (setq loc-end (find "
" mystr))

     (0 loc-end mystr))



(define (get-librarything-taglist mystr)

    (setq tags-list '())

    (while (setq tag-loc (find "/tag/" mystr))

        (setq tag-loc-end (find "target=" (tag-loc -1 mystr)))

        (push ((+ tag-loc 5) (- tag-loc-end 7) mystr) tags-list -1)

        (setq mystr ((+ tag-loc tag-loc-end ) -1 mystr)))

    tags-list)



(define (show-librarything-tag tag)

   (process (append "iexplore " "http://www.librarything.com/tag/"

           tag )))

car cdr cons from little LISPer

frontera000 (bob bae) — Fri, 29 Sep 2006 19:32:58 GMT

// description of your code here



(define cons

 (lambda (u v)

   (lambda (b)

     (cond (b u)

     (#t v)))))

(define lunch (cons 'apple '()))

(define car (lambda (l) (l #t)))

(define cdr (lambda (l) (l #f)))

the applicative-order Y-combinator

frontera000 (bob bae) — Fri, 29 Sep 2006 19:32:05 GMT

// description of your code here



(define Y

  (lambda (f)

    (let ((future

            (lambda (future)

              (f (lambda (arg) 

                   ((future future) arg))))))

      (future future))))



((Y (lambda (factorial)

      (lambda (n)

        (if (= n 0)

            1

            (* n (factorial (- n 1)))))))

 42)