Return Styles: Pseud0ch, Terminal, Valhalla, NES, Geocities, Blue Moon. Entire thread

Practical /Prog/ Challenge

Name: Anonymous 2007-09-08 17:17 ID:P8+/2q3A

The challenge is to make a PROGWATCH program

What it does is, scans this file:
http://dis.4chan.org/prog/subject.txt
every 1 min, 10 mins or 30 seconds or so..

When a change occurs (e.g. someone makes a new post or whatever) then it should exec some program set by the user, with the given args

so for example, you could set it up to open your webbrowser for  the page, or get growl to display "New thread on /prog/, title: Ive read SICP!" etc etc

I will post mine afterwards.. anyway good luck and GO FOR IT!

Name: Anonymous 2007-09-10 6:44 ID:2vgkCCNf

>>108
Below. It took a bit of time, because I'm hired as a Rails programmer right now, so I had to fight the confusion. Also, I misinterpreted the format, and then couldn't be bothered to change the code to match the actual format, and only did it today (it actually took surprisingly little time and code, something like 5 lines).

It's designed to be run as a single file, like that:
sbcl --noinform --noprint --disable-debugger --load progwatch.lisp

Tested and known to run in SBCL, should in others but I can't say for sure. Also, SBCL is a whiny bitch and I can't get it to STFU with all compilation warnings.

(in-package :cl-user)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (setf *compile-verbose* nil)
  (setf *compile-print* nil)

#+sbcl (setf *invoke-debugger-hook*
             (lambda (condition hook)
               (declare (ignore hook))
               ;; Uncomment to get backtraces on errors
               ;; (sb-debug:backtrace 20)
               (format *error-output* "Error: ~A~%" condition)
               (quit)))

  (require :asdf)
  (asdf:oos 'asdf:load-op :asdf-install :verbose nil)
  (asdf:oos 'asdf:load-op :cl-ppcre :verbose nil)
  (asdf:oos 'asdf:load-op :trivial-http :verbose nil)
  (asdf:oos 'asdf:load-op :iterate :verbose nil))

(defpackage :progwatch
  (:use :cl :cl-user :ppcre :iterate :trivial-http))

(in-package :progwatch)

(defvar *last-post* 0)
(defvar *known-posts* (make-hash-table :size 3000))
(defparameter *url* "http://dis.4chan.org/prog/subject.txt";)
(defparameter *update-interval* 60)

(defun group-threads (posts)
  (let (threads)
    (iter (for (post-id thread-id subject) in posts)
          (let ((thread (getf threads thread-id)))
            (setf (getf threads thread-id)
                  (cons (list post-id subject)
                        thread))))
    threads))

(defun extract-new-posts (status known last)
  (let ((last-seen last))
    (values
     (iter (for post in status)
           (unless (or (<= (car post) last)
                       (<= (car post) (gethash (nth 1 post) known 0)))
             (setf last-seen (max last-seen (car post)))
             (setf (gethash (nth 1 post) known) (car post))
             (collect post)))
     last-seen)))

(defun new-posts (status known last out)
  (multiple-value-bind (new last-seen) (extract-new-posts status known last)
    (setf new (group-threads new))
    (values
     (when new
       (format out "~%New posts:  ~{~&  Thread ~a: ~{~&    ~{Post ~a: ~a~}~}~}" new))
     last-seen)))

(defun success (response)
  (= response 200))

(defun unescape (post)
  (destructuring-bind (topic x y thread-id z d post-id) post
      (declare (ignore x y z d))
      (flet ((convert (target-string start end match-start match-end reg-starts reg-ends)
               (declare (ignore start end reg-starts reg-ends))
               (format nil "~a"
                       (code-char (parse-integer
                                   (subseq target-string
                                           (+ 2 match-start)
                                           (1- match-end)))))))
        (list
         (parse-integer post-id)
         (parse-integer thread-id)
         (cl-ppcre:regex-replace-all "&#[0-9]+;" topic #'convert)))))

(defun get-status (url)
  (destructuring-bind (response headers text) (http-get url)
    (declare (ignore headers))
    (when (success response)
      (iter (for line in-stream text using #'read-line)
            (collect (unescape (split "<>" line)))))))

(defun run ()
  (loop
     (multiple-value-bind (new last-post)
         (new-posts (get-status *url*) *known-posts* *last-post* t)
       (declare (ignore new))
       (setf *last-post* last-post))
     (finish-output)
     (sleep *update-interval*)))

(handler-case (run)
  (t () nil))

Newer Posts
Don't change these.
Name: Email:
Entire Thread Thread List