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

Singular photo page 

Signed-off-by: Skylar "The Cobra" Widulski <cobra@vern.cc>
This commit is contained in:
Skylar "The Cobra" Widulski 2023-12-07 10:42:05 -05:00
parent 133ccc7c4f
commit 11d77d435e
Signed by: cobra
GPG Key ID: 4FD8F812083FF6F9
6 changed files with 97 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
meme.scm
View File

@ -70,6 +70,16 @@
char-set:digit 0 1)
0))))
(photos-page path))
((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))
(photo-page path))
((equal? (car path-components) "memes")
(meme-page path))
(else (error-page 404)))))

4
meme/libxml2.scm
View File

@ -138,13 +138,13 @@
(dynamic-func "xmlChildElementCount" libxml2)
(list '* int)))
(define* (next ptr times)
(define (next ptr times)
(if (= times 0)
(list-ref (parse-c-struct ptr xml-node) 6)
(next (next ptr 0) (- times 1))))
(define (child ptr)
(cadddr (parse-c-struct ptr xml-node)))
(define* (child1 ptr times)
(define (child1 ptr times)
(if (= times 0)
(next (child ptr) 0)
(child1 (next (child ptr) 0) (- times 1))))

42
meme/pages.scm
View File

@ -26,6 +26,7 @@
newsfeed-page
meme-page
photos-page
photo-page
proxy-page))
(define base-url "https://knowyourmeme.com")
@ -48,42 +49,29 @@
#:code code
#:headers `((content-type . (text/html)))) (error-template code)))
(define (newsfeed-page path)
(define (generic-page procedure path)
(let ((resp "")
(body ""))
(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 (newsfeed-template body)))
((and (>= (response-code resp) 300) (<= (response-code resp) 399))
(redirect resp (response-code resp)))
(else (error-page (response-code resp))))))
(cond ((equal? (response-code resp) 200)
(values good-response (procedure body)))
((and (>= (response-code resp) 300) (<= (response-code resp) 399))
(redirect resp (response-code resp)))
(else (error-page (response-code resp))))))
(define (newsfeed-page path)
(generic-page newsfeed-template path))
(define (meme-page path)
(let ((resp "")
(body ""))
(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 (meme-template body)))
((and (>= (response-code resp) 300) (<= (response-code resp) 399))
(redirect resp (response-code resp)))
(else (error-page (response-code resp))))))
(generic-page meme-template path))
(define (photos-page path)
(let ((resp "")
(body ""))
(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 (photos-template body)))
((and (>= (response-code resp) 300) (<= (response-code resp) 399))
(redirect resp (response-code resp)))
(else (error-page (response-code resp))))))
(generic-page photos-template path))
(define (photo-page path)
(generic-page photo-template path))
(define (proxy-page query)
(let ((resp "")

23
meme/scraping.scm
View File

@ -25,6 +25,7 @@
get-newsfeed
get-meme
get-photos
get-photo
get-sidebar-gallery
get-sidebar-trending
get-pagination))
@ -338,6 +339,17 @@
(dump-xpath-xml "/html/body/div[3]/div/div[3]" body))
(cdr lst)))
(define (get-photo body)
(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)
(proxy
(get-xpath-string
"/html/body/div[3]/div/div[2]/div[2]/a/img/@src"
body #t))
(dump-xpath-xml
"/html/body/div[3]/aside/div[2]/div[@class=\"row\"][4]/p/a" body)))
(define (get-sidebar-gallery body)
(define gallery (list ""))
(do ((i 1 (+ i 2)))
@ -525,4 +537,13 @@
body #t)))
(define (get-pagination body)
(dump-xpath-xml "//div[@class=\"pagination\"]" body))
(if (null-pointer?
(dereference-pointer
(caddr
(parse-c-struct
(get-xpath-nodeset
"//div[@class=\"pagination\"]"
body)
xml-nodeset))))
""
(dump-xpath-xml "//div[@class=\"pagination\"]" body)))

35
meme/templates.scm
View File

@ -25,7 +25,8 @@
#:export (error-template
newsfeed-template
meme-template
photos-template))
photos-template
photo-template))
(define (kym->local url)
(if (>= (string-length url) 24)
@ -192,6 +193,18 @@
(img (@ (src ,(proxy (cdr p)))))))
(cddddr photos)))))
(define (photo-as-sxml photo)
`(div (@ (class "photo-container"))
(div (@ (class "box photo-header"))
,(html->shtml (car photo))
(p "Source: " ,(html->shtml (cadddr photo))))
(div (@ (class "box photo-body"))
(a (@ (href ,(string-replace-substring
(caddr photo) "newsfeed" "original"))
(target "_blank"))
(img (@ (alt ,(cadr photo))
(src ,(caddr photo))))))))
(define (sidebar-gallery-as-sxml sidebar-gallery)
(map (lambda (l)
`(div (@ (class "sidebar box"))
@ -273,8 +286,10 @@
19))))))))))))
(define (pagination-as-sxml pagination)
`(div (@ (class "pagination box"))
,(html->shtml pagination)))
(if (not (equal? pagination ""))
`(div (@ (class "pagination box"))
,(html->shtml pagination))
`()))
@ -316,6 +331,16 @@
(body
,heading
,(photos-as-sxml (get-photos body))
(div (@ (class "wide-pagination"))
,(pagination-as-sxml (get-pagination body)))
,(if (not (equal? (get-pagination body) ""))
`(div (@ (class "wide-pagination"))
,(pagination-as-sxml (get-pagination body)))
`())
,footer))))
(define (photo-template body)
(shtml->html
`(html ,(html-head "MeMe")
(body
,heading
,(photo-as-sxml (get-photo body))
,footer))))

18
static/style.css
View File

@ -261,6 +261,10 @@ div.references p {
display: none;
}
.photo-container {
display: flex;
}
.photos-gallery.box {
width: 87%;
padding: 1% 5%;
@ -270,3 +274,17 @@ div.references p {
margin: 0.5em;
max-height: 15em;
}
.photo-header.box {
padding: 0 2%;
width: 50%;
}
.photo-body.box {
padding: 2%;
width: 36%;
}
.photo-body.box img {
width: 100%;
}