Script Library: 1238 scripts
  • Home
  • Script library
  • AltME Archive
  • Mailing list
  • Articles Index
  • Site search
 

Archive version of: new-blog.r ... version: 1 ... tgd 7-Feb-2005

Amendment note: new script || Publicly available? Yes

REBOL  [
    Title: "REBOL Blogger"
    Author: "Carl Sassenrath"
    Version: 1.3.2
    File: %new-blog.r
    Date: 10-Jan-2005
    Orig: 6-Jan-2005
    Purpose: {
        The blog system written  and used by Carl Sassenrath,
        REBOL's creator. This script will let you post and
        update blogs on your website using just a web browser.
        Generates summary and index pages, blog searches, etc.
        Extensible with Makedoc2 for more formatting options.
        Modified by Dirk Weyand to work smoothly with Serve-It!,
        the smart server-engine based on REBOL/View.
    }
    Library: [
        level: 'intermediate
        platform: 'all
        type: [tool]
        domain: [cgi html http]
        tested-under: [core 2.5.6 on "Linux x86"]
        support: none
        license: 'BSD
        see-also: none
    ]
]

; Licensed under new BSD License. To summarize it:
; NO WARRANTY OF ANY KIND. USE ENTIRELY AT YOUR OWN RISK.
; Keep all the above information intact.

; Blog.r Feature Summary:
;  1. Allows remote blogging via html forms.
;  2. Automatically builds main blog page.
;  3. Creates a dated index to all blogs.
;  4. Creates links to and between blogs.
;  5. Use your website's standard page template.
;  6. Supports ranked seaches on blogs.
;  7. Provides a handy blog-content backup method.
;  8. Provides a form for feedback (but feedback system
;     is not a standard part of this blog.r script).
;  9. No database engine is needed.
; 10. Optionally generates static blog pages. [V1.3.0]
; 11. Supports multiple blogs on same site. [V1.3.0]
; 12. Works now smoothly with Serve-It! v2.3.2! 
;     All modifications of Carlīs Blogger script are marked with ; (TGD) ;
;     Download Serve-It! @ http://www.TGD-Consulting.de/Download.html#reblets 

; Installation: (only step 1 is still necassary for the usage with Serve-It!)
;  1. Upload this script to your CGI script directory.
;  2. Verify that you have a copy of REBOL/Core on your server.
;  3. Add a top line to point to REBOL/Core. Something like:
;     #!/usr/bin/rebol -cs
;  4. Change permissions (chmod 755) for blog.r to let it run.
;  5. Test it from a browser. If it has errors, you may need to
;     create the blog-dir dir and blog-reads file manually then
;     give them proper permissions (chmod 777 or 666). Be careful.
;  Read http://www.rebol.com/docs/cgi2.html for details.

; (TGD) ; print "content-type: text/html^/" ; activate web server content output

;-- Configuration ------------------------------------------------------------

; Automatically detect when running on client in test mode.
; (Causes the tested page to be displayed in the browser.)
test-mode: not system/options/cgi/request-method

; The website URL where your blog is located:
; Example: blog-site: http://www.example.com
blog-site: http://10.50.40.200

; Absolute path to the blog CGI script on your server. You can change this
; if you want more than one REBOL blog on your web site.
; Example: blog-cgi: %/cgi-bin/blog.r
blog-cgi: %/cgi-bin/blog.r

; Full blog URL (you don't normally need to change this):
blog-url: blog-site/:blog-cgi

; Where raw blog text files are stored relative to this script:
; Example: blog-dir: %blogs/
blog-dir: %blogs/

; Where blog HTML pages are cached after they are generated.
; This should be under the root directory of your website.
; Make sure it has permissions to allow CGI file writing.
; Set this to NONE if you always want dynamic (CGI) pages.
; Example: blog-root: %../html/blogs/
blog-root: %../blogs/

; The URL path to the above directory:
blog-path: %/blogs/

; How many blogs are printed on the main page:
max-blogs: 5

; How many blogs are indexed at the bottom of the main page:
max-links: 10

; The blog author/admin IP address. Only this address gets to post.
; If your client uses dynamic IP, then this will not work and you
; will need to use a username/pass with cookies to protect your blog.
; (That might be added to the next version of this blog script.)
admin-ip: 10.50.40.200

; The name of the blogger:
author: "Your Name Here"

; IMG source link to author's photo location:
author-photo: %/photos/you.jpg

; The name of the organization:
organization: "Your Company Here"

; The titles of generated pages:
title: context [
    main-page:   "Your Name's Blog"
    index-page:  "Complete Index of Your Name Blogs:"
    search-page: "Results of Searching Blog:"
    feedback-page: "Send Feedback to Your Name"
]

; The meta decscription needed for search engines:
meta-description: trim/lines {
    Comments and ideas provided by Your Name via the
    REBOL Blogger.
}

; Blog page contents can be formatted with makedoc2 allowing nicer
; formatting of examples, etc. If the file below is not found, the
; default formatter will be used (just paragraph separation).
makedoc-script: %makedoc2.r

; Automatically detect when running on client in test mode.
; (Causes the tested page to be displayed in the browser.)
test-mode: not system/options/cgi/request-method

;-- HTML Templates -----------------------------------------------------------
;
; If you want to, you can cut and paste these into most HTML page editors to
; help revise them to get what you want. Just be sure to keep the {} braces.

; The name of the HTML template used for the look & feel. Fields within this
; template use the standard $variable format. See show-page function below.
template-file: %blog-template.html

; The default HTML template if the above file cannot be found. This also shows
; the variable format needed to create your own blog-template.html file:
html-template: {
    <html>
    <!--page generated by rebol-->
    <head><title>$title</title><style>
    body, p, td {font-family: arial, sans-serif, helvetica; font-size: 10pt;}
    h1 {font-size: 14pt;}
    h2 {font-size: 12pt; color: #2030a0; width: 100%; border-bottom: 1px solid #c09060;}
    h3 {font-size: 10pt; color: #2030a0;}
	tt {font-family: "courier new", monospace, courier; font-size: 9pt;}
	pre {font: bold 10pt "courier new", monospace, console;
		background-color: #f0f0f0; padding: 16px; border: solid #a0a0a0 1px;}
	.output {color: #803020}
	.note {background-color: #f0f0a0; width: 100%; padding: 16px; border: solid #a0a0a0 1px;}
    .title {font-size: 16 pt; font-weight: bold;}
    .label {margin-top: 3px; margin-bottom: 10px; width: 65px; text-align: right;
    font-weight: bold; vertical-align: top}
    </style></head>
    <body bgcolor="white">
    <center>
    <table width="660" cellpadding="4" cellspacing="0" border="0">
    <tr><td>
    <hr>
    <h1>$title</h1>
    <p>$content</p>
    <hr>
    </td></tr>
    <tr><td align=center>$date - $edit - 
    <a href=http://www.rebol.com>Blogger by REBOL</a> , <a href=http://www.TGD-Consulting.DE/Download.html#reblets>Serve-It! by TGD-Consulting</a></td></tr>
    </table></center></body></html>
}

; The HTML boilerplate used at the top of the first page:
html-main-boiler: [{
    <form action="} blog-cgi {" method="get">
    <table border=0 cellspacing=1 cellpadding=3>
    <tr><td width=32></td>
    <td width=119><img src="} author-photo {"></td><td>
    <b>} author {
    <br>} organization {
    <br>} date/date " " to-GMT date {</b>
    <br>} blog-count { readers since 4-Jan-2005</b>
    <br>[<a href="} blog-url {?index=0">Index of Prior Blogs</a>]
    <p>Search blogs: <input type=text size=25 name=find>
    </td></tr></table></form><p>
}]

; The HTML boilerplate used at the top of each separate blog page:
html-blog-boiler: [{
    <form action="} blog-cgi {" method="get">
    <table border=0 cellspacing=1 cellpadding=3>
    <tr><td width=32></td><td>
    <b>} author {
    <br>} organization {
    <br>} date/date " " to-GMT date {</b>
    <br>Blog #} file {</b>
    <br><span style="color: #808080">
    <a href="} blog-url {"><b>Main page</b></a>
    || <a href="} blog-url {?index=0">Blog index</a>} make-blog-links file
    { || <a href="} blog-url {?reply=} file {">Send feedback</a>
    </span>
    </td>
    </tr></table></form><p>
}]

; The HTML form used for inputing new blogs:
html-edit-form: [{
    <form action="} blog-cgi {" method="post">
    <span class=label>Date:</span>
    <input type=text size=40 name=date value="} date {">
    <br><span class=label>Title:</span>
    <input type=text size=72 name=title value="} title {">
    <br><span class=label>Text:</span>
    <textarea name=text rows=25 cols=72>} text {</textarea>
    <br><input type=hidden name=save value=} file {>
    <br><span class=label>&nbsp;</span>
    <input type=submit name=submit value=submit>
    </form>
}]

; The HTML form used for feedback replies:
html-reply-form: [{
    <form action="http://www.example.com/cgi-bin/feedback/post.r" method="post">
    <input type="hidden" name="type" size="-1" value="Blog">
    <br><span class=label>Subject:</span>
    <input type=text size=50 name=summary value="} subject {">
    <br><span class=label>Message:</span>
    <textarea name=textarea rows=10 cols=50></textarea>
    <br><span class=label>Email:</span>
    <input type=text size=40 name=email value=""> (Optional &amp; Private)
    <br><span class=label>&nbsp;</span>
    <input type=submit name=submit value=submit>
    </form>
}]

; (TGD) 
;-- Mezz Functions -----------------------------------------------------------

if not value? 'attempt [
  attempt: func [
    blk [block!]
    /local rc
  ][
    if error? rc: try blk [rc: none]
    return rc
  ]
]

;-- Utility Functions --------------------------------------------------------

abort: false   ; (TGD) ; quit shutdowns REBOL based Servers
html: ""
emit: func [data] [repend html data]

safe-html: func [text] [
    ; Generate a "safe" html page:
    foreach [str code] [
        "&" "&amp;"
        "<" "&lt;"
        ">" "&gt;"
    ][replace/all text str code]
    text
]

to-GMT: func [date] [
    ; Extract a GMT time from DATE
    either date/time [
        date: fourth date - date/zone
        date/3: 0 ; remove seconds
        reform [date "GMT"]
    ][""]
]

file-num: func [n] [
    ; Output 000n file name format:
    n: form n
    insert/dup n "0" 4 - length? n
    to-file n
]

validate-user: does [
    ; Validate user has permission to post:
    if test-mode [return true]
    if system/options/cgi/remote-addr <> admin-ip [
        show-error "Permission denied."
    ]
]

;-- HTML Page Output ---------------------------------------------------------

show-page: func [title /edit link /main /build file /local template tag] [
    ; Show page thru CGI or locally in browser (for testing)
    template: attempt [read template-file]
    if not template [template: trim/auto html-template] ; use default
    if main [
        tag: build-tag [meta name "description" content (meta-description)]
        attempt [insert insert find/tail template <head> newline tag]
    ]
    title: to-string reduce title
    replace/all template "$title" title
    if build [edit: true link: file]
    if not link [link: 'new]
    tag: rejoin [{<a href="} blog-url {?edit=} link {">Edit</a>}]
    replace template "$edit" tag
    replace template "$date" now/date
    replace template "$content" html
    if edit [write join blog-root/:link ".html" template]
    if build [exit] ; just an update
    either not test-mode [
        print template
    ][
        write %temp-page.html template
        browse %temp-page.html
    ]
    abort: true
; (TGD) ;    quit
]

show-error: func [msg] [
    ; Output an error page:
    emit <b>
    emit msg ; (do not combine)
    emit </b>
    show-page "Blogger Error:"
]

;-- Blog File Handling -------------------------------------------------------

blog-obj: context [file: date: title: text: none]

load-blog: func [file /local blog] [
    attempt [
        blog: load/all join blog-dir file
; (TGD) ;       blog: construct/with blog blog-obj
        blog: make blog-obj blog
        blog/file: file
        blog
    ]
]

save-blog: func [file date title text /local blog files] [
    validate-user
    if not abort [ ; (TGD) ;
    date: to-date date
    blog: load-blog file
    if not blog [
        files: sort/reverse load blog-dir
        file: files/1
        file: either file [1 + to-integer file] [1]
        file: file-num file
    ]
    save join blog-dir file compose [
        date: (date)
        title: (title)
        text: (text)
    ]
    file
    ] ; (TGD) ;
]

find-blog: func [blog strs /local rank text ][
    ; Ranks blog contents during a search:
    rank: 0
    foreach str strs [
        if find/any blog/title str [rank: rank + 4]
        text: blog/text
        while [text: find/any/tail text str] [text: copy text rank: rank + 1] ; (TGD) ; avoid infinte loop
    ]
    rank
]

backup-blogs: func [start /local files] [
    ; This backs up the blog on a remote site so you don't lose them.
    ; The remote site should CGI with blog.r?back=n where n the start.
    ; This can easily be done with a few lines of REBOL for backup.
    validate-user
    if not abort [ ; (TGD) ;
    system/options/binary-base: 64
    start: to-integer start
    out: copy []
    foreach file load blog-dir [
        if (to-integer file) >= start [
            repend out [mold file compress read join blog-dir file]
        ]
    ]
    print out
    abort: true
; (TGD) ;    quit
    ]
]

rebuild-blogs: does [
    ; Rebuild all cached HTML blog pages. To run this, browse
    ; with a URL like: http://.../cgi-bin/blog.r?rebuild=0
    validate-user
    if all [not abort blog-root] [ ; (TGD) ;
        foreach file load blog-dir [
            clear html
            print ["Building:" file <br>]
            show-blog/build file
        ]
        print "Done"
        abort: true
; (TGD) ;       quit
    ]
]

;-- Blog Page Formatters -----------------------------------------------------

title-blog: func [blog] [
    ; Generates a blog title line:
    reform [blog/date/date "-" blog/title]
]

link-blog: func [value text] [
    ; Generates an HTML hyper link:
    rejoin [
        {<a href="}
        either blog-path [
            join blog-path/:value ".html"
        ][
            join blog-url ["?view=" value]
        ]
        {">} to-string reduce text </a>
    ]
]

blog-line: func [blog] [
    ; Generates a full blog summary line:
    rejoin [
        "" <span style="text-align: right; width: 1in"> blog/date/date </span>
        " - " <b> link-blog blog/file blog/title </b> " [" blog/file "]" newline
    ]
]

format-text: func [text] [
    ; Formats text for output:
    either exists? makedoc-script [
        ; Use the Makedoc2 text-to-html formatter:
        if not find text "^/^/###" [append text "^/^/###"]
	do/args makedoc-script 'load-only
	text: scan-doc/options text [no-title]
	second gen-html/options text [no-title no-toc no-nums no-indent no-template]
    ][
        replace/all text "^/^/" "^/<p>"
    ]
]

show-blog: func [file /build /local blog date] [
    ; Show a single blog page:
    blog: load-blog file
    if not blog [show-error ["Blog " file " was not found"]]
    date: blog/date
    emit bind html-blog-boiler 'blog
    emit format-text blog/text
    either build [
        show-page/build blog/title file
    ][
        show-page/edit blog/title file
    ]
]

show-main: has [n blog date] [
    ; Show the main blog page:
    date: now
    emit bind html-main-boiler 'date
    n: 1
    foreach file sort/reverse load blog-dir [
        if blog: load-blog file [
            either n > max-blogs [
                emit [blog-line blog <br>]
            ][
                emit [<h2> title-blog blog " [" link-blog file file "]" </h2>]
                emit format-text blog/text
            ]
            if n = max-blogs [emit [<h2> "Other Recent Blogs:" </h2><blockquote>]]
            n: n + 1
            if (n - max-blogs) > max-links [break]
        ]
    ]
    emit </blockquote>
    emit [{<b><a href="} blog-cgi {?index=0">Click here for list of all prior blogs.</a></b><p>}]
    show-page/main title/main-page
]

show-index: has [blog] [
    ; Show the blog index page:
    emit <blockquote>
    foreach file sort/reverse load blog-dir [
        if blog: load-blog file [emit [blog-line blog <br>]]
    ]
    emit </blockquote>
    show-page title/index-page
]

show-search: func [text /local rank list blog] [
    ; Show the results of a blog search, listed by search-hit rank:
    text: parse text none
    list: copy []
    foreach file load blog-dir [
        if blog: load-blog file [
            rank: find-blog blog text
            if rank > 0 [repend list [rank blog]]
        ]
    ]
    sort/reverse/skip list 2
    emit ["The search found " (length? list) / 2 " blogs:<p><blockquote>"]
    foreach [rank blog] list [emit [blog-line blog <br>]]
    emit </blockquote>
    show-page title/search-page
]

show-edit: func [file /blog] [
    ; Show the blog edit form:
    validate-user
    if not abort [ ; (TGD) ;
        either blog: load-blog file [
           emit-edit file blog/date blog/title safe-html blog/text
           show-page ["Edit blog " file ":"]
        ][
           emit-edit 0 now "" ""
           show-page "Submit a new blog:"
        ]
    ] ; (TGD) ;
]

show-reply: func [blog] [
    ; Show the reply form. Note that the reply processing
    ; script is not part of this blog system.
    emit-reply reform ["Reply to Blog" blog]
    show-page title/feedback-page
]

make-blog-links: func [file /locals spot out] [
    ; Link to prior and next blogs in sequence:
    out: make string! 30
    spot: find load blog-dir to-file file
    if not spot [return ""]
    if not head? spot [
        file: spot/-1
        repend out [" || " link-blog file ["Prior Blog [" file "]"]]
    ] 
    if file: spot/2 [
        repend out [" || " link-blog file ["Next Blog [" file "]"]]
    ] 
    out
]

emit-edit: func [file date title text] [
    emit bind html-edit-form 'file
]

emit-reply: func [subject] [
    emit bind html-reply-form 'subject
]

;-- CGI Command Handler ------------------------------------------------------

read-cgi: func [
    "Read CGI data. Return data as string or NONE."
    /limit size "Limit to this number of bytes"
    /local data buffer
][
    if none? limit [size: 300000]
    switch system/options/cgi/request-method [
        "POST" [data: system/script/args] ;  (TGD) ; Serve-It! liefert POST-Data per system/script/args an das CGI-script
; (TGD) ;            data: make string! 1020
; (TGD) ;           buffer: make string! 16380
; (TGD) ;           while [positive? read-io system/ports/input buffer 16380][
; (TGD) ;               append data buffer
; (TGD) ;               clear buffer
; (TGD) ;               if (length? data) > size [
; (TGD) ;                   print ["aborted - posting is too long:" length? data "limit:" size]
; (TGD) ;                   quit
; (TGD) ;                    abort: true
; (TGD) ;               ]
; (TGD) ;           ]
; (TGD) ;       ]
        "GET" [data: system/options/cgi/query-string]
    ]
    any [data ""]
]

; Possible fields returned by CGI:
cgi-obj: context [
    view: find: edit: save: back: logon: date: title: text: reply: index: rebuild: none
]

if not blog-root [blog-path: none]
blog-count: 0 ; general blog page hit counter

do-cgi: has [cgi] [
    blog-count: 1 + any [attempt [load %blog-reads] 0]
    save %blog-reads blog-count
; (TGD) ;    cgi: construct/with decode-cgi read-cgi cgi-obj
    cgi: make cgi-obj decode-cgi read-cgi 
    if all [not abort found? cgi/view] [show-blog cgi/view]      ; (TGD) ;
    if all [not abort found? cgi/index] [show-index]             ; (TGD) ;
    if all [not abort found? cgi/reply] [show-reply cgi/reply]   ; (TGD) ;
    if all [not abort found? cgi/edit] [show-edit cgi/edit]      ; (TGD) ;
    if all [not abort found? cgi/find] [show-search cgi/find]    ; (TGD) ;
    if all [not abort found? cgi/save] [                         ; (TGD) ;
        show-blog save-blog cgi/save cgi/date cgi/title cgi/text ; (TGD) ;
    ]                                                            ; (TGD) ;
    if all [not abort  found? cgi/back][backup-blogs cgi/back]   ; (TGD) ;
    if all [not abort found? cgi/rebuild] [rebuild-blogs]        ; (TGD) ;
    if not abort [show-main ]                                    ; (TGD) ;
]

if not exists? blog-dir [make-dir/deep blog-dir]                   ; (TGD) ;
if all [blog-root not exists? blog-root] [make-dir/deep blog-root] ; (TGD) ;

;-- Tests
;   Uncomment any of the lines below. But, dont' forget to comment it
;   back when you upload it back to your server.

;save-blog 0 now/date "Test" "This is a test"
;show-index
;show-main
;backup-blogs 0
;show-blog %0001
;show-edit %0001
;show-search "draw"

do-cgi ; start it (if no tests are uncommented)
; (TGD) ;halt