cobra
/
MeMe
1
1
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Meme children page, slightly more verbose logging 

Signed-off-by: Skylar "The Cobra" Widulski <cobra@vern.cc>
This commit is contained in:
Skylar "The Cobra" Widulski 2023-12-08 01:26:27 -05:00
parent 0a575f1577
commit ff6aa93d3f
Signed by: cobra
GPG Key ID: 4FD8F812083FF6F9
5 changed files with 178 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
meme.scm
View File

@ -40,13 +40,13 @@
(display (string-append
(strftime "%c" (localtime (current-time)))
": " (uri->string uri)))
(newline)
(cond
((equal? path "/style.css")
(display ";\tHandler: internal") (newline)
(values '((content-type . (text/css)))
(call-with-input-file "static/style.css" get-string-all)))
((equal? path "/favicon.png")
(display ";\tHandler: internal") (newline)
(values '((content-type . (image/png)))
(call-with-input-file "static/logo.png" get-bytevector-all)))
((equal? path "/proxy")
@ -104,7 +104,18 @@
; char-set:digit 0 1)
; 0))))
; (videos-page path))
((equal? (car path-components) "memes")
((and (equal? (car path-components) "memes")
(or (equal? (car (last-pair path-components)) "children")
(and
(equal? (list-ref path-components
(- (length path-components) 2))
"page")
(equal? (list-ref path-components
(- (length path-components) 3))
"children"))))
(meme-children-page path))
((and (equal? (car path-components) "memes")
(not (equal? (car (last-pair path-components)) "children")))
(meme-page path))
(else (error-page 404)))))

14
meme/pages.scm
View File

@ -27,6 +27,7 @@
#:export (error-page
newsfeed-page
meme-page
meme-children-page
photos-page
photo-page
videos-page
@ -60,6 +61,9 @@
(receive (_resp _body) (http-request (string-append base-url path))
(set! resp _resp)
(set! body _body))
(display (string-append ";\tStatus: "
(number->string (response-code resp))))
(newline)
(cond ((equal? (response-code resp) 200)
(set! d (gumbo-libxml-parse (string->pointer body)))
(set! ret (procedure d))
@ -70,21 +74,31 @@
(else (error-page (response-code resp))))))
(define (newsfeed-page path)
(display ";\tHandler: newsfeed-page")
(generic-page newsfeed-template path))
(define (meme-page path)
(display ";\tHandler: meme-page")
(generic-page meme-template path))
(define (meme-children-page path)
(display ";\tHandler: meme-children-page")
(generic-page meme-children-template path))
(define (photos-page path)
(display ";\tHandler: photos-page")
(generic-page photos-template path))
(define (photo-page path)
(display ";\tHandler: photo-page")
(generic-page photo-template path))
(define (videos-page path)
(display ";\tHandler: videos-page")
(generic-page videos-template path))
(define (proxy-page query)
(display ";\tHandler: proxy-page") (newline)
(let ((resp "")
(body "")
(url ""))

81
meme/scraping.scm
View File

@ -24,6 +24,7 @@
get-trending
get-newsfeed
get-meme
get-meme-children
get-photos
get-photo
get-videos
@ -248,6 +249,82 @@
d))
(cdr lst)))
(define (get-meme-children d)
(define table
(get-xpath-node
"/html/body/div[3]/div/div[3]/section/div[2]/table/tbody"
d))
(define lst (list ""))
(define lst1 (list ""))
(define chld (child table))
(define chld1 %null-pointer)
(define chld2 %null-pointer)
(define chld3 %null-pointer)
(while (not (null-pointer? chld))
(cond
((equal? (name chld) "tr")
(set! chld1 (child1 chld 0))
(while (not (null-pointer? chld1))
(set! lst1 (list ""))
(cond ((and (equal? (name chld1) "td")
(not (null-pointer? (child1 chld1 0)))
(not (equal? (name (child1 chld1 0)) "div")))
(set! chld2 (props (child1 chld1 0)))
(while (not (null-pointer? chld2))
(cond
((equal? (name chld2) "href")
(append!
lst1
(list
(pointer->string
(xml-node-list-get-string
(doc chld2)
(child chld2)
1))))
(break)))
(set! chld2 (next chld2 0)))
(set! chld3 (props (child (child1 chld1 0))))
(while (not (null-pointer? chld3))
(cond
((equal? (name chld3) "data-src")
(append!
lst1
(list
(pointer->string
(xml-node-list-get-string
(doc chld3)
(child chld3)
1))))
(break)))
(set! chld3 (next chld3 0)))
(append!
lst1
(list
(pointer->string
(xml-node-list-get-string
(doc chld1)
(child (child1 (next (child1 chld1 0) 0) 0))
1))))
(append! lst (list (cdr lst1)))))
(set! chld1 (next chld1 1)))))
(set! chld (next chld 0)))
(append
(list
(dump-xpath-xml "/html/body/div[3]/div/div[1]/header/hgroup/h1" d)
(if (null-pointer?
(caddr (parse-c-struct
(get-xpath-nodeset
"/html/body/div[3]/div/div[1]/header/hgroup/p"
d)
xml-nodeset)))
""
(get-xpath-string
"/html/body/div[3]/div/div[1]/header/hgroup/p/text()"
d #f))
(dump-xpath-xml "/html/body/div[3]/div/nav/ul" d)
(dump-xpath-xml "/html/body/div[3]/div/div[3]/section/div/p" d))
(cdr lst)))
(define (get-photos d)
(define gallery
(get-xpath-node
@ -322,7 +399,7 @@
"/html/body/div[3]/div/div[1]/header/hgroup/p/text()"
d #f))
(dump-xpath-xml "/html/body/div[3]/div/nav/ul" d)
(dump-xpath-xml "/html/body/div[3]/div/div[3]" d))
(dump-xpath-xml "/html/body/div[3]/div/div[3]/section/div/p" d))
(cdr lst)))
(define (get-photo d)
@ -409,7 +486,7 @@
"/html/body/div[3]/div/div[1]/header/hgroup/p/text()"
d #f))
(dump-xpath-xml "/html/body/div[3]/div/nav/ul" d)
(dump-xpath-xml "/html/body/div[3]/div/div[3]" d))
(dump-xpath-xml "/html/body/div[3]/div/div[3]/section/div/p" d))
(cdr lst)))
(define (get-sidebar-gallery d)

52
meme/templates.scm
View File

@ -25,13 +25,15 @@
#:export (error-template
newsfeed-template
meme-template
meme-children-template
photos-template
photo-template
videos-template;))
videos-template
leaderboard->sxml
trending->sxml
meme->sxml
meme-children->sxml
photos->sxml
photo->sxml
videos->sxml))
@ -139,13 +141,11 @@
`(div (@ (class "leaderboard box"))
(ul (@ (class "leaderboard"))
,(map (lambda (l)
(if (equal? (length l) 4)
`(li (@ (id ,(car l)))
(a (@ (href ,(kym->local (cadr l))))
(img (@ (src ,(proxy (caddr l)))
(alt ,(cadddr l))))
(p (@ (class "tooltip box")) ,(cadddr l))))
`()))
`(li (@ (id ,(car l)))
(a (@ (href ,(kym->local (cadr l))))
(img (@ (src ,(proxy (caddr l)))
(alt ,(cadddr l))))
(p (@ (class "tooltip box")) ,(cadddr l)))))
leaderboard))))
(define (trending->sxml trending)
@ -185,6 +185,28 @@
s "https://knowyourmeme.com" "")))
(list-tail meme 5)))))
(define (meme-children->sxml meme-children)
`(div
(div (@ (class "box meme-children"))
,(html->shtml (car meme-children))
(p ,(cadr meme-children))
,(html->shtml (caddr meme-children))
,(html->shtml (string-replace-substring
(cadddr meme-children)
"https://knowyourmeme.com"
"")))
(div (@ (class "box meme-children-body"))
(ul (@ (class "meme-children-list"))
,(map (lambda (l)
`(li
(a (@ (href ,(string-replace-substring
(car l)
"https://knowyourmeme.com"
"")))
(img (@ (src ,(proxy (cadr l)))))
(p (@ (class "tooltip box")) ,(caddr l)))))
(cddddr meme-children))))))
(define (photos->sxml photos)
`(div
(div (@ (class "box photos"))
@ -351,6 +373,20 @@
,(meme->sxml (get-meme body))
,footer))))
(define (meme-children-template body)
(shtml->html
`(html ,(html-head "MeMe")
(body
,heading
,(leaderboard->sxml (get-leaderboard body))
,(trending->sxml (get-trending body))
,(meme-children->sxml (get-meme-children body))
,(if (not (equal? (get-pagination body) ""))
`(div (@ (class "wide-pagination"))
,(pagination->sxml (get-pagination body)))
`())
,footer))))
(define (photos-template body)
(shtml->html
`(html ,(html-head "MeMe")

35
static/style.css
View File

@ -181,8 +181,8 @@ table.trending-images tr td {
}
table.trending-images img {
width:10vw;
height:10vw;
width: 10vw;
height: 10vw;
}
.articles.box {
@ -256,21 +256,38 @@ div.references p {
float: left;
}
ul.meme-children-list {
display: flex;
flex-wrap: wrap;
list-style-type: none;
align-items: flex-start;
margin: 0%;
padding: 1% 0;
width: 100%;
}
ul.meme-children-list a:hover p.tooltip {
display: block;
margin-top: -5em;
}
.photos.box,
.videos.box {
.videos.box,
.meme-children.box {
width: 93%;
padding: 0 2%;
}
.photos.box ul li,
.videos.box ul li {
.videos.box ul li,
.meme-children.box ul li {
display: inline;
margin-right: 1em;
}
.photos.box ul li ul,
.photos.box div#photo_gallery,
.videos.box ul li ul {
.videos.box ul li ul,
.meme-children.box ul li ul {
display: none;
}
@ -279,13 +296,15 @@ div.references p {
}
.photos-gallery.box,
.videos-table {
.videos-table.box,
.meme-children-body.box {
width: 87%;
padding: 1% 5%;
}
.photos-gallery.box img,
.videos-table.box img {
.videos-table.box img,
.meme-children-body.box img {
margin: 0.5em;
max-height: 15em;
}