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

Add category pages 

Signed-off-by: Skylar "The Cobra" Widulski <cobra@vern.cc>
This commit is contained in:
Skylar "The Cobra" Widulski 2023-12-08 23:49:20 -05:00
parent 6507dff0a0
commit ab8cb2a09d
Signed by: cobra
GPG Key ID: 4FD8F812083FF6F9
6 changed files with 118 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
meme.scm
View File

@ -106,6 +106,7 @@
; (videos-page path))
((and (equal? (car path-components) "memes")
(or
(equal? (length path-components) 1)
(or (equal? (car (last-pair path-components)) "children")
(and
(equal? (list-ref path-components
@ -165,6 +166,12 @@
(meme-list-page path))
((equal? (car path-components) "memes")
(meme-page path))
((and (equal? (car path-components) "categories")
(equal? (length path-components) 1))
(category-list-page path))
((or (equal? (car path-components) "categories")
(equal? (car path-components) "types"))
(meme-list-page path))
(else (error-page 404)))))
(define sock (socket PF_INET SOCK_STREAM 0))

3
meme/libxml2.scm
View File

@ -36,6 +36,7 @@
props
name
doc
text
nodeset
nodeset-nodes
floatval
@ -154,6 +155,8 @@
(pointer->string (caddr (parse-c-struct ptr xml-node))))
(define (doc ptr)
(list-ref (parse-c-struct ptr xml-node) 8))
(define (text ptr)
(pointer->string (xml-node-list-get-string (doc ptr) (child ptr) 1)))
(define (nodeset ptr)
(cadr (parse-c-struct ptr xml-xpath-object)))

5
meme/pages.scm
View File

@ -28,6 +28,7 @@
newsfeed-page
meme-page
meme-list-page
category-list-page
photos-page
photo-page
videos-page
@ -85,6 +86,10 @@
(display ";\tHandler: meme-list-page")
(generic-page meme-list-template path))
(define (category-list-page path)
(display ";\tHandler: category-list-page")
(generic-page category-list-template path))
(define (photos-page path)
(display ";\tHandler: photos-page")
(generic-page photos-template path))

88
meme/scraping.scm
View File

@ -25,6 +25,7 @@
get-newsfeed
get-meme
get-meme-list
get-category-list
get-photos
get-photo
get-videos
@ -170,10 +171,7 @@
((equal? (name chld) "h2")
(cond
((equal?
(pointer->string
(xml-node-list-get-string
(doc chld)
(child chld) 1))
(text chld)
"Search Interest")
(set! skip #t)
(set! chld (next chld 0))
@ -215,12 +213,7 @@
(list
(string-append
"<img src=\""
(proxy
(pointer->string
(xml-node-list-get-string
(doc chld2)
(child chld2)
1)))
(proxy (text chld2))
"\" />")))
(break)))
(set! chld2 (next chld2 0)))))
@ -275,12 +268,7 @@
((equal? (name chld2) "href")
(append!
lst1
(list
(pointer->string
(xml-node-list-get-string
(doc chld2)
(child chld2)
1))))
(list (text chld2)))
(break)))
(set! chld2 (next chld2 0)))
(set! chld3 (props (child (child1 chld1 0))))
@ -289,22 +277,13 @@
((equal? (name chld3) "data-src")
(append!
lst1
(list
(pointer->string
(xml-node-list-get-string
(doc chld3)
(child chld3)
1))))
(list (text chld3)))
(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))))
(text (child1 (next (child1 chld1 0) 0) 0))))
(append! lst (list (cdr lst1)))))
(set! chld1 (next chld1 1)))))
(set! chld (next chld 0)))
@ -332,6 +311,61 @@
(dump-xpath-xml "/html/body/div[3]/div/div[3]/section/div/p" d)))
(cdr lst)))
(define (get-category-list d)
(define categories
(get-xpath-node
"//div[@id=\"categories-list\"]"
d))
(define lst (list ""))
(define lst1 (list ""))
(define lst2 (list ""))
(define lst3 (list ""))
(define cat #f)
(define skip #t)
(define chld (child categories))
(define chld1 %null-pointer)
(while (not (null-pointer? chld))
(cond
((and (equal? (name chld) "a")
(not (null-pointer? (child chld)))
(not (equal? (name (child chld)) "i")))
(set! chld1 (props chld))
(while (not (null-pointer? chld1))
(cond
((equal? (name chld1) "data-category")
(set! cat #t)
(break))
((equal? (name chld1) "data-type")
(set! cat #f)
(break)))
(set! chld1 (next chld1 0)))
(set! lst1 (list ""))
(set! chld1 (props chld))
(append! lst1 (list (text (child1 chld 0))))
(while (not (null-pointer? chld1))
(cond
((equal? (name chld1) "href")
(append! lst1 (list (text chld1))))
((equal? (name chld1) "data-category")
(append! lst1 (list (text chld1))))
((equal? (name chld1) "data-type")
(append! lst1 (list (text chld1)))))
(set! chld1 (next chld1 0)))
(cond
(cat
(if skip
(set! skip #f)
(append! lst (list (list (cdr lst3) (cdr lst2)))))
(set! lst3 (list-copy lst1))
(set! lst1 (list ""))
(set! lst2 (list "")))
(else (append! lst2 (list (cdr lst1)))))))
(set! chld (next chld 0)))
(append! lst (list (list (cdr lst3) (cdr lst2))))
(append
(list (dump-xpath-xml "/html/body/div[3]/div/div[1]/header/hgroup/h1" d))
(list (cdr lst))))
(define (get-photos d)
(define gallery
(get-xpath-node

32
meme/templates.scm
View File

@ -26,6 +26,7 @@
newsfeed-template
meme-template
meme-list-template
category-list-template
photos-template
photo-template
videos-template
@ -34,6 +35,7 @@
trending->sxml
meme->sxml
meme-list->sxml
category-list->sxml
photos->sxml
photo->sxml
videos->sxml))
@ -207,6 +209,26 @@
(p (@ (class "tooltip box")) ,(caddr l)))))
(cddddr meme-list))))))
(define (category-list->sxml category-list)
`(div (@ (class "box category-list"))
,(html->shtml (car category-list))
(ul
,(map (lambda (l)
`(li
(a (@ (href ,(cadar l)))
,(string-append
(caddar l) " ("
(caar l) ")"))
(ul
,(map (lambda (m)
`(li (a (@ (href ,(cadr m)))
,(string-append
(caddr m) " ("
(car m) ")"))))
(cadr l)))
(br)))
(cadr category-list)))))
(define (photos->sxml photos)
`(div
(div (@ (class "box photos"))
@ -387,6 +409,16 @@
`())
,footer))))
(define (category-list-template body)
(shtml->html
`(html ,(html-head "MeMe")
(body
,heading
,(leaderboard->sxml (get-leaderboard body))
,(trending->sxml (get-trending body))
,(category-list->sxml (get-category-list body))
,footer))))
(define (photos-template body)
(shtml->html
`(html ,(html-head "MeMe")

11
static/style.css
View File

@ -273,7 +273,8 @@ ul.meme-list-list a:hover p.tooltip {
.photos.box,
.videos.box,
.meme-list.box {
.meme-list.box,
.category-list.box {
width: 93%;
padding: 0 2%;
}
@ -285,6 +286,14 @@ ul.meme-list-list a:hover p.tooltip {
margin-right: 1em;
}
.category-list.box ul {
column-count: 3;
}
.category-list.box ul li ul {
column-count: 1;
}
.photos.box ul li ul,
.videos.box ul li ul,
.meme-list.box ul li ul {