picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

commit 77cbd0d9452b2ac1107e078e5ae1895d79a4662a
parent b352b2979b55d3ec9148657b2bdf4a9f53c4e607
Author: Commit-Bot <unknown>
Date:   Sun, 16 May 2010 16:03:37 +0000

Automatic commit from picoLisp.tgz, From: Sun, 16 May 2010 13:03:37 GMT
Diffstat:
Mlib/scrape.l | 38++++++++++++++++++++++++++++----------
Msrc64/version.l | 4++--
2 files changed, 30 insertions(+), 12 deletions(-)

diff --git a/lib/scrape.l b/lib/scrape.l @@ -1,15 +1,16 @@ -# 30apr10abu +# 16may10abu # (c) Software Lab. Alexander Burger -# *ScrHost *ScrPort *Title *Expect *Found +# *ScrHost *ScrPort *ScrGate *Title *Expect *Found # *Links *Forms *Buttons *Fields *Errors # Scrape HTML form(s) (de scrape (Host Port How) (client (setq *ScrHost Host) (setq *ScrPort Port) How - (off *Links *Forms *Buttons *Fields *Errors) + (off *ScrGate *Links *Forms *Buttons *Fields *Errors) (while (from + "303 See Other" "<title>" "<base href=\"http://" "<a href=\"" @@ -25,15 +26,30 @@ "<div class=\"err\">" *Expect ) (case @ + ("303 See Other" + (when (from "Location: http://") + (let L (split (line) ':) + (if (cdr L) + (scrape + (pack (pop 'L)) + (ifn (format (car (setq L (split (car L) '/)))) + 80 + (pop 'L) + @ ) + (glue '/ L) ) + (setq L (split (car L) '/)) + (scrape (pack (pop 'L)) 80 (glue '/ L)) ) ) ) ) ("<title>" (setq *Title (ht:Pack (till "<"))) ) ("<base href=\"http://" - (setq - *ScrHost (rot (cdr (rot (split (till "\"") '/ ':)))) - *ScrPort (format (pop '*ScrHost)) - *ScrHost (pack *ScrHost) ) ) + (let L (split (till "\"") ':) + (if (cdr L) + (setq + *ScrHost (pack (pop 'L)) + *ScrPort (format (cdr (rot (car L)))) ) + (setq *ScrGate (pack (cdr (member '/ (car L))))) ) ) ) ("<a href=\"" - (let Url (till "\"" T) + (let Url (pack *ScrGate (till "\"" T)) (from ">") (cond ((till "<") @@ -42,7 +58,8 @@ (from "alt=\"") (queue '*Links (cons (ht:Pack (till "\"")) Url)) ) ) ) ) (" action=\"" - (queue '*Forms (list (till "\"" T))) ) # (action . fields) + (queue '*Forms # (action . fields) + (list (pack *ScrGate (till "\"" T))) ) ) ("<input type=\"submit\" name=\"" (let Nm (till "\"" T) (from "value=\"") @@ -120,7 +137,7 @@ (de enter (Fld Str Cnt) (con (field Fld Cnt) Str) ) -### Utilities ### +# Inspect current page (de display () (prinl "###############") (apply println (mapcar car *Links) 'click) @@ -131,6 +148,7 @@ (prinl) *Title ) +### Utility functions ### (de target (Lst Lbl Cnt) (cond ((num? Lbl) diff --git a/src64/version.l b/src64/version.l @@ -1,6 +1,6 @@ -# 14may10abu +# 16may10abu # (c) Software Lab. Alexander Burger -(de *Version 3 0 2 20) +(de *Version 3 0 2 21) # vi:et:ts=3:sw=3