Version 7 of Comic Server

Updated 2007-06-20 20:25:53 by kbk

Michael Jacobson 8/9/02 ~ In NewzPoint there is a comic page generator that gets the current comics from uComics.com and displays them in a single page. I have updated some of this code for my current release and this is a standalone version. To use just run this code in Wish and then point your browser at http://localhost:9108/Comic .

The server behind this code just takes the arguments (+ seperated) and executes them in a safe interp. So you can also do commands like http://localhost:9108/info+command or http://localhost:9108/set+a+23 . Have fun with this...

MPJ 10/29/02 ~ fixed generated title of History page


 if {0} {
         Comic Server by Michael Jacobson
         Usage: Launch the server in Wish and then point your
                browser to http://localhost:9108/Comic
                        this will dynamiclly generate a current comic 
                        page.  I have tested this in Mozilla and IE and
                        it seems to work (based on NewzPoint comic page
                        code)
 }

 proc Comic {} {
        global topdir
        set comic_delay {Doodles 3 \
                        {Calvin and Hobbes} 4018 \
                        {Captain RibMan} 1 \
                        {Reynolds Unwrapped} 4}
        set comic_info {tmann {Annie} \
                tmbre {Brenda Starr} \
                tmbro {Broom Hilda} \
                tmdic {Dick Tracy} \
                tmfba {Fred Basset} \
                tmgas {Gasoline Alley} \
                tmgil {Gil Thorp} \
                ad {Adam@Home} \
                ba {Baldo} \
                bo {Boondocks} \
                ch {Calvin and Hobbes} \
                cs {Crankshaft} \
                ft {FoxTrot} \
                fu {The Fusco Brothers} \
                ga {Garfield} \
                hc {Heart of the City} \
                jm {James} \
                tmlol {Lola} \
                tmmid {The Middletons} \
                mb {Mister Boffo} \
                tmmon {Monkey House} \
                pr {Preteena} \
                ss {Stone Soup} \
                wes {Willy 'N Ethel} \
                bi {The Big Picture} \
                ca {Cathy} \
                cr {Crabby Road} \
                dp {The Duplex} \
                tmdun {Dunigan's People} \
                tmkud {Kudzu} \
                tmmee {Meehan Streak} \
                tmplu {Pluggers} \
                rl {Real Life Adventures} \
                tmsho {Shoe} \
                tmtja {That's Jake} \
                tmcap {Captain RibMan} \
                bz {Bizarro} \
                cl {Close to Home} \
                tmloo {Loose Parts} \
                oe {Oddly Enough} \
                ob {Overboard} \
                tmqui {The Quigmans} \
                rw {Reynolds Unwrapped} \
                tmsyl {Sylvia} \
                tmntf {9 to 5} \
                tmbot {Bottomliners} \
                co {Cornered} \
                tmhel {Helen, Sweetheart of the Internet} \
                psm {P.S. Mueller} \
                tmddu {Dear Dudley} \
                db {Doonesbury} \
                nq {Non Sequitur} \
                bl {In the Bleachers} \
                tm {Tank McNamara} \
                tmani {Animal Crackers} \
                tmbou {Bound and Gagged} \
                tmcat {Cats with Hands} \
                tmmix {Mixed Media} \
                zi {Ziggy} }
        set ComicOutput {}
        append ComicOutput {<HTM-+L>} "\n"
        append ComicOutput {<HEAD>} "\n"
        append ComicOutput {<TITLE>Daily Comic Page from ucomics.com</TITLE>} "\n"
        append ComicOutput {</HEAD>} "\n"
        append ComicOutput {<BODY>} "\n"
        append ComicOutput "<center><B><H1>Daily Comic Page</B></H1>\n"
        append ComicOutput "Page Generated on [clock format [clock second] -format %c]</center>\n"
        set src {<img src="http://images.ucomics.com/comics/}
        foreach {one name} $comic_info {
                #http://www.ucomics.com/patoliphant/viewoa.htm
                regsub -all {@} $name {at} newname
                regsub -all {'} $newname {} newname
                regsub -all { } $newname {} newname
                regsub -all {,} $newname {} newname
                regsub -all {\.} $newname {} newname
                append ComicOutput "<H2><a href=http://www.ucomics.com/[string tolower $newname]/view$one.htm>$name</a> ~ "
                set offset 0
                if {[lsearch $comic_delay $name] > -1} {set offset [lindex $comic_delay [expr [lsearch $comic_delay $name] + 1]]}
                append ComicOutput "<a href=ComicHist+$one+7+$offset>Past Week</a> ~ "
                append ComicOutput "<a href=ComicHist+$one+30+$offset>Past Month</a></H2>\n"
                set outt $src
                if {[lsearch $comic_delay $name] == -1} {
                        set year [clock format [clock second] -format %Y]
                        set date [clock format [clock second] -format %y%m%d]
                } else {
                        set day [lindex $comic_delay [expr [lsearch $comic_delay $name] + 1]]
                        set sec [expr $day * 24 * 60 * 60]
                        set year [clock format [expr [clock second] - $sec] -format %Y]
                        set date [clock format [expr [clock second] - $sec] -format %y%m%d]
                }                
                append outt $one/$year/$one$date
                append outt {.gif">}
                append ComicOutput "$outt\n"
                #�������������� �������������� puts $outt
        }
        append ComicOutput {</BODY>} "\n"
        append ComicOutput {</HTML>} "\n"
 }

 proc ComicHist {page freq {offset 0}} {
        set comic_info {tmann {Annie} \
                tmbre {Brenda Starr} \
                tmbro {Broom Hilda} \
                tmdic {Dick Tracy} \
                tmfba {Fred Basset} \
                tmgas {Gasoline Alley} \
                tmgil {Gil Thorp} \
                ad {Adam@Home} \
                ba {Baldo} \
                bo {Boondocks} \
                ch {Calvin and Hobbes} \
                cs {Crankshaft} \
                ft {FoxTrot} \
                fu {The Fusco Brothers} \
                ga {Garfield} \
                hc {Heart of the City} \
                jm {James} \
                tmlol {Lola} \
                tmmid {The Middletons} \
                mb {Mister Boffo} \
                tmmon {Monkey House} \
                pr {Preteena} \
                ss {Stone Soup} \
                wes {Willy 'N Ethel} \
                bi {The Big Picture} \
                ca {Cathy} \
                cr {Crabby Road} \
                dp {The Duplex} \
                tmdun {Dunigan's People} \
                tmkud {Kudzu} \
                tmmee {Meehan Streak} \
                tmplu {Pluggers} \
                rl {Real Life Adventures} \
                tmsho {Shoe} \
                tmtja {That's Jake} \
                tmcap {Captain RibMan} \
                bz {Bizarro} \
                cl {Close to Home} \
                tmloo {Loose Parts} \
                oe {Oddly Enough} \
                ob {Overboard} \
                tmqui {The Quigmans} \
                rw {Reynolds Unwrapped} \
                tmsyl {Sylvia} \
                tmntf {9 to 5} \
                tmbot {Bottomliners} \
                co {Cornered} \
                tmhel {Helen, Sweetheart of the Internet} \
                psm {P.S. Mueller} \
                tmddu {Dear Dudley} \
                db {Doonesbury} \
                nq {Non Sequitur} \
                bl {In the Bleachers} \
                tm {Tank McNamara} \
                tmani {Animal Crackers} \
                tmbou {Bound and Gagged} \
                tmcat {Cats with Hands} \
                tmmix {Mixed Media} \
                zi {Ziggy} }
        foreach {one name} $comic_info {
                if {[string equal $one $page]} {
                        regsub -all {@} $name {at} newname
                        regsub -all {'} $newname {} newname
                        regsub -all { } $newname {} newname
                        regsub -all {,} $newname {} newname
                        regsub -all {\.} $newname {} newname
                        break
                }
        }
        set ComicOutput {}
        append ComicOutput {<HTM-+L>} "\n"
        append ComicOutput {<HEAD>} "\n"
        append ComicOutput "<TITLE>History Comic Page for $name</TITLE>" "\n"
        append ComicOutput {</HEAD>} "\n"
        append ComicOutput {<BODY>} "\n"
        append ComicOutput "<center><B><H1>History Comic Page for $name</B></H1>\n"
        append ComicOutput "Page Generated on [clock format [clock second] -format %c]</center>\n"
        set src {<img src="http://images.ucomics.com/comics/}
        for {set i 0} {$i < $freq} {incr i} {
                set adjclksec [expr [clock second] - (($i + $offset) * 24 * 60 *60)]
                set linkpage [clock format $adjclksec -format %Y/%m/%d]
                append ComicOutput "<H2><a href=http://picayune.uclick.com/[string tolower $newname]/$linkpage>$linkpage</a></H2>\n"
                set outt $src
                set year [clock format $adjclksec -format %Y]
                set date [clock format $adjclksec -format %y%m%d]
                append outt $one/$year/$one$date
                append outt {.gif">}
                append ComicOutput "$outt\n"
        }
        return $ComicOutput
 }

 # run all the requested commands in the safe interp
 interp create -safe foo

 # link in the two above procs to the safe interp
 interp alias foo ComicHist {} ComicHist
 interp alias foo Comic {} Comic

 #   http server modified from JCW's hpeek.tcl
 proc http_start {port} {
        global http_fd
        if {$port} {
                set http_fd [socket -server http_accept $port]
        }
 }

 # accept a new incoming tcp/ip connection
 proc http_accept {sock h p} {
        fconfigure $sock -blocking 0
        fileevent $sock readable [list http_request $sock]
 }

# process an http request

 proc http_request {sock} {
        set line [gets $sock]
        if {[fblocked $sock]} return
        fileevent $sock readable ""
        fconfigure $sock -buffering full
        set p /
        regexp {/[^ ]*} $line p
        regsub -all / $p :: p
        puts $sock "HTTP/1.0 200 OK\n"
        set p [string trimleft $p :]
        regsub -all "::" $p "/" p
        fconfigure $sock -encoding binary -translation binary
        set cmd [lindex [split $p +] 0]
        if {[lsearch [foo eval info command] $cmd] != -1} {
                catch {foo eval [split $p +]} genout
                puts -nonewline $sock $genout
        } else {
                puts -nonewline $sock "Not a valid User Script"
        }
        catch {flush $sock}
        catch {close $sock}
 }

 if {$argv == ""} {
        set port 9108
 } else {
        set port [lindex $argv 0]
 }

 catch {http_start $port}