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

Fix memory leak 

Signed-off-by: Skylar "The Cobra" Widulski <cobra@vern.cc>
This commit is contained in:
Skylar "The Cobra" Widulski 2023-12-07 20:26:01 -05:00
parent 7695fc9622
commit f4b17a8bf4
Signed by: cobra
GPG Key ID: 4FD8F812083FF6F9
7 changed files with 354 additions and 232 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
README.md
View File

@ -20,6 +20,3 @@ This program is written in Guile Scheme. As such, you need `guile` and `guile-gn
# Known issues
1. It's slow
2. It could be faster
3. It probably leaks memory
All three of these are likely caused by the same design choice that I'm too lazy to fix right now.

73
meme.scm
View File

@ -54,35 +54,56 @@
((or (equal? path "/")
(equal? (car path-components) "page"))
(newsfeed-page path))
((or (equal? (car (last-pair path-components)) "photos")
(and (>= (length path-components) 3)
(equal? (list-ref
path-components
(- (length path-components) 3))
"photos")
(equal? (list-ref
path-components
(- (length path-components) 2))))
(and (>= (length path-components) 2)
(equal? (list-ref
path-components
(- (length path-components) 2))
"photos")
(not (> (string-count
(car (last-pair path-components))
char-set:digit 0 1)
0))))
((or
(equal? (car (last-pair path-components)) "photos")
(and (>= (length path-components) 3)
(equal? (list-ref
path-components
(- (length path-components) 3))
"photos")
(equal? (list-ref
path-components
(- (length path-components) 2))))
(and (>= (length path-components) 2)
(equal? (list-ref
path-components
(- (length path-components) 2))
"photos")
(not (> (string-count
(car (last-pair path-components))
char-set:digit 0 1)
0))))
(photos-page path))
((and (>= (length path-components) 2)
(equal? (list-ref
path-components
((and (>= (length path-components) 2)
(equal? (list-ref
path-components
(- (length path-components) 2))
"photos")
(> (string-count
(car (last-pair path-components))
char-set:digit 0 1)
0))
"photos")
(> (string-count
(car (last-pair path-components))
char-set:digit 0 1)
0))
(photo-page path))
; ((or
; (equal? (car (last-pair path-components)) "videos")
; (and (>= (length path-components) 3)
; (equal? (list-ref
; path-components
; (- (length path-components) 3))
; "videos")
; (equal? (list-ref
; path-components
; (- (length path-components) 2))))
; (and (>= (length path-components) 2)
; (equal? (list-ref
; path-components
; (- (length path-components) 2))
; "videos")
; (not (> (string-count
; (car (last-pair path-components))
; char-set:digit 0 1)
; 0))))
; (videos-page path))
((equal? (car path-components) "memes")
(meme-page path))
(else (error-page 404)))))

41
meme/libxml2.scm
View File

@ -164,40 +164,37 @@
(define (strval ptr)
(list-ref (parse-c-struct ptr xml-xpath-object) 4))
(define (dump-xml node body)
(define doc (gumbo-libxml-parse
(string->pointer body)))
(define (dump-xml node)
(define buffer (xml-buffer-create))
(define size (xml-node-dump buffer doc node 0 1))
(define size (xml-node-dump buffer (doc node) node 0 1))
(define content (pointer->string (car (parse-c-struct buffer xml-buffer))))
(xml-free-doc doc)
content)
(define (get-xpath xpath body)
(define doc (gumbo-libxml-parse
(string->pointer body)))
(define context (xml-xpath-new-context doc))
(xml-xpath-eval-expression
(string->pointer xpath)
context))
(define (get-xpath xpath d)
(define context (xml-xpath-new-context d))
(define result (xml-xpath-eval-expression
(string->pointer xpath)
context))
(xml-xpath-free-context context)
result)
(define (dump-xpath-xml xpath body)
(define (dump-xpath-xml xpath d)
(define buffer (xml-buffer-create))
(define nodes (get-xpath-node xpath body))
(define nodes (get-xpath-node xpath d))
(define size (xml-node-dump buffer (doc nodes) nodes 0 1))
(pointer->string (car (parse-c-struct buffer xml-buffer))))
(define (get-xpath-string xpath body attr?)
(define (get-xpath-string xpath d attr?)
(pointer->string
(xml-node-list-get-string
(doc (get-xpath-node xpath body))
(doc (get-xpath-node xpath d))
(if attr?
(child (get-xpath-node xpath body))
(get-xpath-node xpath body))
(child (get-xpath-node xpath d))
(get-xpath-node xpath d))
1)))
(define (get-xpath-nodeset xpath body)
(nodeset (get-xpath xpath body)))
(define (get-xpath-nodeset xpath d)
(nodeset (get-xpath xpath d)))
(define (get-xpath-node xpath body)
(nodeset-nodes (get-xpath-nodeset xpath body)))
(define (get-xpath-node xpath d)
(nodeset-nodes (get-xpath-nodeset xpath d)))

16
meme/pages.scm
View File

@ -17,16 +17,19 @@
(define-module (meme pages)
#:use-module (meme templates)
#:use-module (meme libxml2)
#:use-module (web response)
#:use-module (web client)
#:use-module (web http)
#:use-module (web uri)
#:use-module (ice-9 receive)
#:use-module (system foreign)
#:export (error-page
newsfeed-page
meme-page
photos-page
photo-page
videos-page
proxy-page))
(define base-url "https://knowyourmeme.com")
@ -51,12 +54,17 @@
(define (generic-page procedure path)
(let ((resp "")
(body ""))
(body "")
(d %null-pointer)
(ret ""))
(receive (_resp _body) (http-request (string-append base-url path))
(set! resp _resp)
(set! body _body))
(cond ((equal? (response-code resp) 200)
(values good-response (procedure body)))
(set! d (gumbo-libxml-parse (string->pointer body)))
(set! ret (procedure d))
(xml-free-doc d)
(values good-response ret))
((and (>= (response-code resp) 300) (<= (response-code resp) 399))
(redirect resp (response-code resp)))
(else (error-page (response-code resp))))))
@ -73,6 +81,9 @@
(define (photo-page path)
(generic-page photo-template path))
(define (videos-page path)
(generic-page videos-template path))
(define (proxy-page query)
(let ((resp "")
(body "")
@ -84,6 +95,7 @@
(string-split s #\=))
(string-split (substring query 0) #\&)))
(if (or (equal? (substring url 0 22) "https://i.kym-cdn.com/")
(equal? (substring url 0 20) "https://i.ytimg.com/")
(equal? (substring url 0 22) "https://a.kym-cdn.com/"))
(begin
(receive (_resp _body) (http-request url)

341
meme/scraping.scm
View File

@ -26,6 +26,7 @@
get-meme
get-photos
get-photo
get-videos
get-sidebar-gallery
get-sidebar-trending
get-pagination))
@ -33,76 +34,47 @@
(define (proxy url)
(string-append "/proxy?url=" url))
(define (get-leaderboard body)
(list
(list
(get-xpath-string
"/html/body/div[1]/div/div[2]/section[1]/ul/li[1]/article/@id"
body #t)
(get-xpath-string
"/html/body/div[1]/div/div[2]/section[1]/ul/li[1]/article/a/@href"
body #t)
(get-xpath-string
"/html/body/div[1]/div/div[2]/section[1]/ul/li[1]/article/a/img/@src"
body #t)
(get-xpath-string
(string-append
"/html/body/div[1]/div/div[2]/section[1]/"
"ul/li[1]/article/a/div/div/text()")
body #f))
(list
(get-xpath-string
"/html/body/div[1]/div/div[2]/section[1]/ul/li[2]/article/@id"
body #t)
(get-xpath-string
"/html/body/div[1]/div/div[2]/section[1]/ul/li[2]/article/a/@href"
body #t)
(get-xpath-string
"/html/body/div[1]/div/div[2]/section[1]/ul/li[2]/article/a/img/@src"
body #t)
(get-xpath-string
(string-append
"/html/body/div[1]/div/div[2]/section[1]"
"/ul/li[2]/article/a/div/div/text()")
body #f))
(list
(get-xpath-string
"/html/body/div[1]/div/div[2]/section[1]/ul/li[3]/article/@id"
body #t)
(get-xpath-string
"/html/body/div[1]/div/div[2]/section[1]/ul/li[3]/article/a/@href"
body #t)
(get-xpath-string
"/html/body/div[1]/div/div[2]/section[1]/ul/li[3]/article/a/img/@src"
body #t)
(get-xpath-string
(string-append
"/html/body/div[1]/div/div[2]/section[1]"
"/ul/li[3]/article/a/div/div/text()")
body #f))
(list
(get-xpath-string
"/html/body/div[1]/div/div[2]/section[1]/ul/li[4]/article/@id"
body #t)
(get-xpath-string
"/html/body/div[1]/div/div[2]/section[1]/ul/li[4]/article/a/@href"
body #t)
(get-xpath-string
"/html/body/div[1]/div/div[2]/section[1]/ul/li[4]/article/a/img/@src"
body #t)
(get-xpath-string
(string-append
"/html/body/div[1]/div/div[2]/section[1]"
"/ul/li[4]/article/a/div/div/text()")
body #f))))
(define (get-leaderboard d)
(define lst (list ""))
(do ((i 1 (1+ i)))
((> i 5))
(append!
lst
(list
(list
(get-xpath-string
(string-append
"/html/body/div[1]/div/div[2]/section[1]/ul/li["
(number->string i)
"]/article/@id")
d #t)
(get-xpath-string
(string-append
"/html/body/div[1]/div/div[2]/section[1]/ul/li["
(number->string i)
"]/article/a/@href")
d #t)
(get-xpath-string
(string-append
"/html/body/div[1]/div/div[2]/section[1]/ul/li["
(number->string i)
"]/article/a/img/@src")
d #t)
(get-xpath-string
(string-append
"/html/body/div[1]/div/div[2]/section[1]/ul/li["
(number->string i)
"]/article/a/div/div/text()")
d #f)))))
(cdr lst))
(define (get-trending body)
(define (get-trending d)
(define trending (list ""))
(do ((i 1 (1+ i)))
((=
i
(xml-child-element-count
(get-xpath-node "/html/body/div[1]/div/div[2]/section[2]" body) 0))
(get-xpath-node "//*[@id=\"trending-bar\"]" d) 0))
trending)
(append!
trending
@ -110,18 +82,18 @@
(list
(get-xpath-string
(string-append
"/html/body/div[1]/div/div[2]/section[2]/a["
"//*[@id=\"trending-bar\"]/a["
(number->string i)
"]/@href")
body #t)
d #t)
(get-xpath-string
(string-append
"/html/body/div[1]/div/div[2]/section[2]/a["
"//*[@id=\"trending-bar\"]/a["
(number->string i)
"]/text()")
body #f))))))
d #f))))))
(define (get-newsfeed body)
(define (get-newsfeed d)
(define newsfeed (list ""))
(do ((i 1 (1+ i)))
((= i 6) newsfeed)
@ -134,25 +106,25 @@
"/html/body/div[3]/div/div[3]/article["
(number->string i)
"]/@id")
body #t)
d #t)
(get-xpath-string
(string-append
"/html/body/div[3]/div/div[3]/article["
(number->string i)
"]/div/section/h1/a/@href")
body #t)
d #t)
(get-xpath-string
(string-append
"/html/body/div[3]/div/div[3]/article["
(number->string i)
"]/div/section/h1/a/text()")
body #f)
d #f)
(get-xpath-string
(string-append
"/html/body/div[3]/div/div[3]/article["
(number->string i)
"]//img/@data-src")
body #t)
d #t)
(if
(equal?
(xml-child-element-count
@ -161,7 +133,7 @@
"/html/body/div[3]/div/div[3]/article["
(number->string i)
"]/div/section/div[2]")
body)
d)
0)
0)
""
@ -170,19 +142,19 @@
"/html/body/div[3]/div/div[3]/article["
(number->string i)
"]/div/section/div[2]/p/text()")
body #f))
d #f))
(get-xpath-string
(string-append
"/html/body/div[3]/div/div[3]/article["
(number->string i)
"]/div/section/p[1]/em/text()")
body #f))))))
d #f))))))
(define (get-meme body)
(define (get-meme d)
(define bodycopy
(get-xpath-node
"/html/body/div[3]/div/article//section[@class=\"bodycopy\"]"
body))
d))
(define chld (child1 bodycopy 0))
(define chld1 %null-pointer)
(define chld2 %null-pointer)
@ -200,7 +172,7 @@
((equal?
(pointer->string
(xml-node-list-get-string
(gumbo-libxml-parse (string->pointer body))
(doc chld)
(child chld) 1))
"Search Interest")
(set! skip #t)
@ -208,25 +180,25 @@
(continue)))
(append!
lst
(list (dump-xml chld body))))
(list (dump-xml chld))))
((equal? (name chld) "blockquote")
(append!
lst
(list (dump-xml chld body))))
(list (dump-xml chld))))
((equal? (name chld) "p")
(if (and
(not (equal? (dump-xml (child chld) body) "<br/>"))
(not (equal? (dump-xml chld body)
(not (equal? (dump-xml (child chld)) "<br/>"))
(not (equal? (dump-xml chld)
"<p><em>Unavailable</em>.</p>")))
(append!
lst
(list (dump-xml chld body)))))
(list (dump-xml chld)))))
((equal? (name chld) "div")
(if (and (not (null-pointer? (child chld)))
(equal? (name (child1 chld 0)) "p"))
(append!
lst
(list (dump-xml chld body)))))
(list (dump-xml chld)))))
((equal? (name chld) "center")
(set! chld1 (child1 chld 0))
(set! lst1 (list ""))
@ -258,29 +230,30 @@
(append
(list
(get-xpath-string
"/html/body/div[3]/div/article/header/section/h1/text()" body #f)
"/html/body/div[3]/div/article/header/section/h1/text()" d #f)
(get-xpath-string
"/html/body/div[3]/div/article/header/a/img/@src" body #t)
"/html/body/div[3]/div/article/header/a/img/@src" d #t)
(if (null-pointer?
(caddr (parse-c-struct
(get-xpath-nodeset
"/html/body/div[3]/div/article/header/section/div/h5"
body)
d)
xml-nodeset)))
""
(dump-xpath-xml
"/html/body/div[3]/div/article/header/section/div/h5" body))
"/html/body/div[3]/div/article/header/section/div/h5" d))
(dump-xpath-xml
"/html/body/div[3]/div/article/header/section/div/footer/p[1]" body)
"/html/body/div[3]/div/article/header/section/div/footer/p[1]" d)
(dump-xpath-xml
"/html/body/div[3]/div/article/header/section/div/footer/p[2]" body))
"/html/body/div[3]/div/article/header/section/div/footer/p[2]"
d))
(cdr lst)))
(define (get-photos body)
(define (get-photos d)
(define gallery
(get-xpath-node
"//*[@id=\"photo_gallery\"]"
body))
d))
(define lst (list ""))
(define pair '(() . ()))
(define chld (child1 gallery 0))
@ -338,39 +311,115 @@
(set! chld (next chld 0)))
(append
(list
(dump-xpath-xml "/html/body/div[3]/div/div[1]/header/hgroup/h1" body)
(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"
body)
d)
xml-nodeset)))
""
(get-xpath-string
"/html/body/div[3]/div/div[1]/header/hgroup/p/text()"
body #f))
(dump-xpath-xml "/html/body/div[3]/div/nav/ul" body)
(dump-xpath-xml "/html/body/div[3]/div/div[3]" body))
d #f))
(dump-xpath-xml "/html/body/div[3]/div/nav/ul" d)
(dump-xpath-xml "/html/body/div[3]/div/div[3]" d))
(cdr lst)))
(define (get-photo body)
(define (get-photo d)
(list
(dump-xpath-xml "/html/body/div[3]/div/div[2]/header/h1" body)
(get-xpath-string "/html/body/div[3]/div/div[2]/div[2]/a/img/@alt" body #t)
(dump-xpath-xml "/html/body/div[3]/div/div[2]/header/h1" d)
(get-xpath-string "/html/body/div[3]/div/div[2]/div[2]/a/img/@alt" d #t)
(proxy
(get-xpath-string
"/html/body/div[3]/div/div[2]/div[2]/a/img/@src"
body #t))
d #t))
(dump-xpath-xml
"/html/body/div[3]/aside/div[2]/div[@class=\"row\"][4]/p/a" body)))
"/html/body/div[3]/aside/div[2]/div[@class=\"row\"][4]/p/a" d)))
(define (get-sidebar-gallery body)
(define (get-videos d)
(define table
(get-xpath-node
"/html/body/div[3]/div/section/div/table/tbody"
d))
(define lst (list ""))
(define pair '(() . ()))
(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 (child chld))
(while (not (null-pointer? chld1))
(cond ((equal? (name chld1) "td")
(set! chld2 (props (child1 chld1 1)))
(while (not (null-pointer? chld2))
(cond
((equal? (name chld2) "href")
(set-car!
pair
(pointer->string
(xml-node-list-get-string
(doc chld2)
(child chld2)
1)))
(break)))
(set! chld2 (next chld2 0)))
(set! chld3 (props (child1 chld1 2)))
(while (not (null-pointer? chld3))
(cond
((equal? (name chld3) "data-tiktok-url")
(set-cdr!
pair
(get-tiktok-thumbnail
(pointer->string
(xml-node-list-get-string
(doc chld3)
(child chld3)
1))))
(append! lst (list (cons (car pair)
(cdr pair))))
(break))
((equal? (name chld3) "data-src")
(set-cdr!
pair
(pointer->string
(xml-node-list-get-string
(doc chld3)
(child chld3)
1)))
(append! lst (list (cons (car pair)
(cdr pair))))
(break)))
(set! chld3 (next chld3 0)))))
(set! chld1 (next chld1 0)))))
(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]" d))
(cdr lst)))
(define (get-sidebar-gallery d)
(define gallery (list ""))
(do ((i 1 (+ i 2)))
((>=
i
(- (xml-child-element-count
(get-xpath-node "/html/body/div[3]/aside" body) 0)
(get-xpath-node "/html/body/div[3]/aside" d) 0)
1))
gallery)
(append!
@ -382,7 +431,7 @@
"/html/body/div[3]/aside/div["
(number->string i)
"]/h3/text()")
body #f)
d #f)
(get-xpath-string
@ -390,25 +439,25 @@
"/html/body/div[3]/aside/div["
(number->string i)
"]/table/tbody/tr[1]/td[1]/a/@href")
body #t)
d #t)
(get-xpath-string
(string-append
"/html/body/div[3]/aside/div["
(number->string i)
"]/table/tbody/tr[1]/td[1]/a/img/@alt")
body #t)
d #t)
(get-xpath-string
(string-append
"/html/body/div[3]/aside/div["
(number->string i)
"]/table/tbody/tr[1]/td[1]/a/img/@data-src")
body #t)
d #t)
(get-xpath-string
(string-append
"/html/body/div[3]/aside/div["
(number->string i)
"]/table/tbody/tr[1]/td[1]/h4/a/text()")
body #f)
d #f)
(get-xpath-string
@ -416,25 +465,25 @@
"/html/body/div[3]/aside/div["
(number->string i)
"]/table/tbody/tr[1]/td[2]/a/@href")
body #t)
d #t)
(get-xpath-string
(string-append
"/html/body/div[3]/aside/div["
(number->string i)
"]/table/tbody/tr[1]/td[2]/a/img/@alt")
body #t)
d #t)
(get-xpath-string
(string-append
"/html/body/div[3]/aside/div["
(number->string i)
"]/table/tbody/tr[1]/td[2]/a/img/@data-src")
body #t)
d #t)
(get-xpath-string
(string-append
"/html/body/div[3]/aside/div["
(number->string i)
"]/table/tbody/tr[1]/td[2]/h4/a/text()")
body #f)
d #f)
(get-xpath-string
@ -442,25 +491,25 @@
"/html/body/div[3]/aside/div["
(number->string i)
"]/table/tbody/tr[2]/td[1]/a/@href")
body #t)
d #t)
(get-xpath-string
(string-append
"/html/body/div[3]/aside/div["
(number->string i)
"]/table/tbody/tr[2]/td[1]/a/img/@alt")
body #t)
d #t)
(get-xpath-string
(string-append
"/html/body/div[3]/aside/div["
(number->string i)
"]/table/tbody/tr[2]/td[1]/a/img/@data-src")
body #t)
d #t)
(get-xpath-string
(string-append
"/html/body/div[3]/aside/div["
(number->string i)
"]/table/tbody/tr[2]/td[1]/h4/a/text()")
body #f)
d #f)
(get-xpath-string
@ -468,96 +517,96 @@
"/html/body/div[3]/aside/div["
(number->string i)
"]/table/tbody/tr[2]/td[2]/a/@href")
body #t)
d #t)
(get-xpath-string
(string-append
"/html/body/div[3]/aside/div["
(number->string i)
"]/table/tbody/tr[2]/td[2]/a/img/@alt")
body #t)
d #t)
(get-xpath-string
(string-append
"/html/body/div[3]/aside/div["
(number->string i)
"]/table/tbody/tr[2]/td[2]/a/img/@data-src")
body #t)
d #t)
(get-xpath-string
(string-append
"/html/body/div[3]/aside/div["
(number->string i)
"]/table/tbody/tr[2]/td[2]/h4/a/text()")
body #f))))))
d #f))))))
(define (get-sidebar-trending body)
(define (get-sidebar-trending d)
(list
(get-xpath-string "/html/body/div[3]/aside/div[4]/h3/a/@href" body #t)
(get-xpath-string "/html/body/div[3]/aside/div[4]/h3/a/text()" body #f)
(get-xpath-string "/html/body/div[3]/aside/div[4]/h3/a/@href" d #t)
(get-xpath-string "/html/body/div[3]/aside/div[4]/h3/a/text()" d #f)
(get-xpath-string
"/html/body/div[3]/aside/div[4]/table/tbody/tr[1]/td[1]/a/@href"
body #t)
d #t)
(get-xpath-string
"/html/body/div[3]/aside/div[4]/table/tbody/tr[1]/td[1]/a/img/@data-src"
body #t)
d #t)
(get-xpath-string
"/html/body/div[3]/aside/div[4]/table/tbody/tr[1]/td[2]/a/@href"
body #t)
d #t)
(get-xpath-string
"/html/body/div[3]/aside/div[4]/table/tbody/tr[1]/td[2]/a/img/@data-src"
body #t)
d #t)
(get-xpath-string
"/html/body/div[3]/aside/div[4]/table/tbody/tr[1]/td[3]/a/@href"
body #t)
d #t)
(get-xpath-string
"/html/body/div[3]/aside/div[4]/table/tbody/tr[1]/td[3]/a/img/@data-src"
body #t)
d #t)
(get-xpath-string
"/html/body/div[3]/aside/div[4]/table/tbody/tr[2]/td[1]/a/@href"
body #t)
d #t)
(get-xpath-string
"/html/body/div[3]/aside/div[4]/table/tbody/tr[2]/td[1]/a/img/@data-src"
body #t)
d #t)
(get-xpath-string
"/html/body/div[3]/aside/div[4]/table/tbody/tr[2]/td[2]/a/@href"
body #t)
d #t)
(get-xpath-string
"/html/body/div[3]/aside/div[4]/table/tbody/tr[2]/td[2]/a/img/@data-src"
body #t)
d #t)
(get-xpath-string
"/html/body/div[3]/aside/div[4]/table/tbody/tr[2]/td[3]/a/@href"
body #t)
d #t)
(get-xpath-string
"/html/body/div[3]/aside/div[4]/table/tbody/tr[2]/td[3]/a/img/@data-src"
body #t)
d #t)
(get-xpath-string
"/html/body/div[3]/aside/div[4]/table/tbody/tr[3]/td[1]/a/@href"
body #t)
d #t)
(get-xpath-string
"/html/body/div[3]/aside/div[4]/table/tbody/tr[3]/td[1]/a/img/@data-src"
body #t)
d #t)
(get-xpath-string
"/html/body/div[3]/aside/div[4]/table/tbody/tr[3]/td[2]/a/@href"
body #t)
d #t)
(get-xpath-string
"/html/body/div[3]/aside/div[4]/table/tbody/tr[3]/td[2]/a/img/@data-src"
body #t)
d #t)
(get-xpath-string
"/html/body/div[3]/aside/div[4]/table/tbody/tr[3]/td[3]/a/@href"
body #t)
d #t)
(get-xpath-string
"/html/body/div[3]/aside/div[4]/table/tbody/tr[3]/td[3]/a/img/@data-src"
body #t)))
d #t)))
(define (get-pagination body)
(define (get-pagination d)
(if (null-pointer?
(dereference-pointer
(caddr
(parse-c-struct
(get-xpath-nodeset
"//div[@class=\"pagination\"]"
body)
d)
xml-nodeset))))
""
(dump-xpath-xml "//div[@class=\"pagination\"]" body)))
(dump-xpath-xml "//div[@class=\"pagination\"]" d)))

90
meme/templates.scm
View File

@ -26,7 +26,15 @@
newsfeed-template
meme-template
photos-template
photo-template))
photo-template
videos-template;))
leaderboard->sxml
trending->sxml
meme->sxml
photos->sxml
photo->sxml
videos->sxml))
(define (kym->local url)
(if (>= (string-length url) 24)
@ -127,7 +135,7 @@
(p (a (@ (href "http://git.vern.cc/cobra/MeMe"))
"Source Code")))))
(define (leaderboard-as-sxml leaderboard)
(define (leaderboard->sxml leaderboard)
`(div (@ (class "leaderboard box"))
(ul (@ (class "leaderboard"))
,(map (lambda (l)
@ -140,7 +148,7 @@
`()))
leaderboard))))
(define (trending-as-sxml trending)
(define (trending->sxml trending)
`(div (@ (class "trending box"))
(p "trending:")
,(map (lambda (l)
@ -150,7 +158,7 @@
`()))
(cdr trending))))
(define (newsfeed-as-sxml newsfeed)
(define (newsfeed->sxml newsfeed)
`(,(map (lambda (l)
`(div (@ (class "articles box"))
(a (@ (href ,(kym->local (cadr l))))
@ -161,7 +169,7 @@
(i ,(list-ref l 5)))))
(cdr newsfeed))))
(define (meme-as-sxml meme)
(define (meme->sxml meme)
`(div
(div (@ (class "box meme"))
(img (@ (src ,(proxy (cadr meme)))))
@ -177,7 +185,7 @@
s "https://knowyourmeme.com" "")))
(list-tail meme 5)))))
(define (photos-as-sxml photos)
(define (photos->sxml photos)
`(div
(div (@ (class "box photos"))
,(html->shtml (car photos))
@ -193,7 +201,7 @@
(img (@ (src ,(proxy (cdr p)))))))
(cddddr photos)))))
(define (photo-as-sxml photo)
(define (photo->sxml photo)
`(div (@ (class "photo-container"))
(div (@ (class "box photo-header"))
,(html->shtml (car photo))
@ -205,7 +213,23 @@
(img (@ (alt ,(cadr photo))
(src ,(caddr photo))))))))
(define (sidebar-gallery-as-sxml sidebar-gallery)
(define (videos->sxml videos)
`(div
(div (@ (class "box videos"))
,(html->shtml (car videos))
(p ,(cadr videos))
,(html->shtml (caddr videos))
,(html->shtml (string-replace-substring
(cadddr videos)
"https://knowyourmeme.com"
"")))
(div (@ (class "box videos-table"))
,(map (lambda (p)
`(a (@ (href ,(car p)))
(img (@ (src ,(proxy (cdr p)))))))
(cddddr videos)))))
(define (sidebar-gallery->sxml sidebar-gallery)
(map (lambda (l)
`(div (@ (class "sidebar box"))
(h3 ,(car l))
@ -234,7 +258,7 @@
(p (b ,(list-ref l 16)))))))))
(cdr sidebar-gallery)))
(define (sidebar-trending-as-sxml sidebar-trending)
(define (sidebar-trending->sxml sidebar-trending)
`(div (@ (class "sidebar box"))
(h3 (a (@ (href ,(kym->local (car sidebar-trending))))
,(cadr sidebar-trending)))
@ -285,7 +309,7 @@
(list-tail sidebar-trending
19))))))))))))
(define (pagination-as-sxml pagination)
(define (pagination->sxml pagination)
(if (not (equal? pagination ""))
`(div (@ (class "pagination box"))
,(html->shtml pagination))
@ -307,14 +331,14 @@
`(html ,(html-head "MeMe")
(body
,heading
,(leaderboard-as-sxml (get-leaderboard body))
,(trending-as-sxml (get-trending body))
,(leaderboard->sxml (get-leaderboard body))
,(trending->sxml (get-trending body))
(div (@ (class "left"))
,(newsfeed-as-sxml (get-newsfeed body))
,(pagination-as-sxml (get-pagination body)))
,(newsfeed->sxml (get-newsfeed body))
,(pagination->sxml (get-pagination body)))
(div (@ (class "right"))
,(sidebar-gallery-as-sxml (get-sidebar-gallery body))
,(sidebar-trending-as-sxml (get-sidebar-trending body)))
,(sidebar-gallery->sxml (get-sidebar-gallery body))
,(sidebar-trending->sxml (get-sidebar-trending body)))
,footer))))
(define (meme-template body)
@ -322,9 +346,9 @@
`(html ,(html-head "MeMe")
(body
,heading
,(leaderboard-as-sxml (get-leaderboard body))
,(trending-as-sxml (get-trending body))
,(meme-as-sxml (get-meme body))
,(leaderboard->sxml (get-leaderboard body))
,(trending->sxml (get-trending body))
,(meme->sxml (get-meme body))
,footer))))
(define (photos-template body)
@ -332,12 +356,12 @@
`(html ,(html-head "MeMe")
(body
,heading
,(leaderboard-as-sxml (get-leaderboard body))
,(trending-as-sxml (get-trending body))
,(photos-as-sxml (get-photos body))
,(leaderboard->sxml (get-leaderboard body))
,(trending->sxml (get-trending body))
,(photos->sxml (get-photos body))
,(if (not (equal? (get-pagination body) ""))
`(div (@ (class "wide-pagination"))
,(pagination-as-sxml (get-pagination body)))
,(pagination->sxml (get-pagination body)))
`())
,footer))))
@ -346,7 +370,21 @@
`(html ,(html-head "MeMe")
(body
,heading
,(leaderboard-as-sxml (get-leaderboard body))
,(trending-as-sxml (get-trending body))
,(photo-as-sxml (get-photo body))
,(leaderboard->sxml (get-leaderboard body))
,(trending->sxml (get-trending body))
,(photo->sxml (get-photo body))
,footer))))
(define (videos-template body)
(shtml->html
`(html ,(html-head "MeMe")
(body
,heading
,(leaderboard->sxml (get-leaderboard body))
,(trending->sxml (get-trending body))
,(videos->sxml (get-videos body))
,(if (not (equal? (get-pagination body) ""))
`(div (@ (class "wide-pagination"))
,(pagination->sxml (get-pagination body)))
`())
,footer))))

22
static/style.css
View File

@ -5,7 +5,6 @@ body {
color: #ffc8dd;
background-color: #2e2016;
hyphens: auto;
max-width: 1280px;
margin: 0 auto;
}
@ -129,7 +128,7 @@ ul.leaderboard li:hover p {
ul.leaderboard {
display: flex;
flex-wrap: wrap;
flex-wrap: none;
justify-content: space-between;
list-style-type: none;
align-items: center;
@ -138,6 +137,10 @@ ul.leaderboard {
width: 95%;
}
ul.leaderboard li a img {
width: 95%;
}
div.trending p {
display: inline-block;
padding: 0 1%;
@ -253,18 +256,21 @@ div.references p {
float: left;
}
.photos.box {
.photos.box,
.videos.box {
width: 93%;
padding: 0 2%;
}
.photos.box ul li {
.photos.box ul li,
.videos.box ul li {
display: inline;
margin-right: 1em;
}
.photos.box ul li ul,
.photos.box div#photo_gallery {
.photos.box div#photo_gallery,
.videos.box ul li ul {
display: none;
}
@ -272,12 +278,14 @@ div.references p {
display: flex;
}
.photos-gallery.box {
.photos-gallery.box,
.videos-table {
width: 87%;
padding: 1% 5%;
}
.photos-gallery.box img {
.photos-gallery.box img,
.videos-table.box img {
margin: 0.5em;
max-height: 15em;
}