Amiga Times/AmigaTimes.iso/programme/Fiasco_2.2/Databases/Mailing List Archive/createhtml.frx

Text File | 1998-10-06 | 13.9 KB | 612 lines

/* createhtml.frx
 * Copyright © 1998 Nils Bandener
 * $VER: createhtml_frx 8.9 (31.7.98)
 */

/* Please specify here a name for the ARexx script:
 */

scriptname = "Create HTML"

/*
 * Script settings
 *
 * Edit the following lines to change the output
 *
 */

linesperpage = 30                /* Lines that should be written per page */
starttemplatefile = "tpl1.html"  /* HTML file that is used as format template */
endtemplatefile = "tpl2.html"    /* HTML file that is used as format template */

markercolor = "#000099"          /* Color for the markers in front of the lines */
bgcolor     = "#cccccc"          /* Background color */
titlebgcolor = "#aaaaaa"         /* Background color of table title */
titletxcolor = "#000000"         /* Text color of table title */

mlname = "Fiasco MLArchive Example"  /* Name of mailing list */


Options Results
Parse Arg dir

/*
 *  If not called from Fiasco, try to address the active
 *  Fiasco project
 */

if ~abbrev(address(), "FIASCO.") then
do
    /* Get list of all available ports */

    ports = show("Ports")

    /* Search for a port of Fiasco */

    do i = 1 to words(ports)

        if abbrev(word(ports, i), "FIASCO.") then
        do
            /* A port of Fiasco has been found.
             * Now query Fiasco to return the port
             * name of the active database.
             */

            Address Value word(ports, i)

            GetAttr Project Name Active ARexx

            Address Value Result

            break
        end
    end
end

fiasco_port = address()

Signal on Syntax
Signal on Halt
Signal on Break_C
Signal on Failure

LockGUI

/*
 *  Request the directory in which
 *  the output is written.
 *  It is recommended to reserve a whole
 *  directory for the output.
 *  The first page can be referred then
 *  by <directory>/index.html
 */

RequestFile 'drawersonly projectrelative savemode var dir'

if rc = 0 then
do
    if length(dir) ~= 0 & right(dir, 1) ~= ':' & right(dir, 1) ~= '/' then
    do
        dir = dir || "/"
    end

    /*
     *  Sort the database by date and time
     */

    sort 'date time index "mlahtml.fidx"'

    if rc = 0 then
    do
        countrecords 'var numrecs'

        /*
         *  Calculator the number of pages
         */

        numpages = trunc((numrecs / linesperpage) - 0.1) + 1

        rootcnt = 0

        /*
         *  Search for "root" messages
         *  which are not refered by other
         *  messages
         */

        do i = 1 to numrecs

            newsearchinfo 'name createhtmlsi'

            getfield 'reference record ' || i || ' var mid'

            setsearchfield 'searchinfo createhtmlsi fieldid messageid pattern ' || mid

            find 'searchinfo createhtmlsi record 0'


            if rc ~= 0 then
            do
                rootcnt = rootcnt + 1       /* Number of roots */
                root.rootcnt = i            /* Stem var with roots */
            end

        end


        linecount = 0
        activepage = 0
        depth = 0

        /*
         *  Create the first index file
         */

        call newlistfile

        /*
         *  Now create output for each root
         *  message. All other messages are
         *  handled by printmail()
         */

        do i = 1 to rootcnt

            depth = 0       /* for recursion with ARexx */

            call printmail(root.i)

        end

        call closelistfile

        options failat 20

        /*
         *  Activate previous active index
         */

        activeindex prev
    end
end


/*----------------------------------------------------*
 *                                                    *
 *  Clean up functions                                *
 *                                                    *
 *----------------------------------------------------*/


bail_out:

Address Value fiasco_port

UnlockGUI
ResetStatus

exit

syntax:
failure:

if show("Ports", fiasco_port) then
do
    Address Value fiasco_port

    RequestChoice '"Error ' || rc || ' in line ' || sigl || ':*n' || errortext(rc) || '" "Cancel" Title "' || scriptname || '"'
end
else
do
    say "Error" rc "in line" sigl ":" errortext(rc)
    say "Enter to continue"
    pull dummy
end

call bail_out

halt:
break_c:

if show("Ports", fiasco_port) then
do
    Address Value fiasco_port

    RequestChoice '"Script Abort Requested" "Abort Script" Title "' || scriptname || '"'
end
else
do
    say "*** Break"
    say "Enter to continue"
    pull dummy
end

call bail_out


/*----------------------------------------------------*
 *                                                    *
 *  Create output for one mail                        *
 *                                                    *
 *----------------------------------------------------*/

/*
 *  This function uses some tricks to do
 *  recursion with ARexx.  Stem variables are used
 *  as the "stack". depth, as index for these variables,
 *  is the "stack pointer".
 */

printmail:

parse arg num

depth = depth + 1       /* Get a new stack */

linecount = linecount + 1

/*
 *  If number of lines exceeds the maximum
 *  for an index page, start a new page
 */

if linecount > linesperpage then
do
    linecount = 0

    call newlistfile
end

/*
 *  Read the data
 */

getfield 'subject record ' || num || ' var subject'
getfield 'date record ' || num || ' extformat var dateval'
getfield 'realname record ' || num || ' var realname'
getfield 'messagekey record ' || num || ' var messagekey'
getfield 'mailbody record ' || num || ' var mailbody'
getfield 'email record ' || num || ' var emailval'

/*
 *  Write the mail file
 */

call writemailfile

/*
 *  Add a new line to the index page
 */

call writeln(f, "<tr>")

leftspan = depth - 1

if leftspan > 6 then leftspan = 6

if leftspan ~= 0 then
do
    call writeln(f, '<td colspan=' || leftspan || '></td>')
end

call writeln(f, '<td bgcolor="' || markercolor || '" width=10> </td>');

rightspan = 7 - leftspan

call writeln(f, '<td colspan=' || rightspan || '>' || '<a href="' || messagekey || '.html">' || subject || '</a></td>')

call writeln(f, '<td align=right>' || sizeval || '</td>')

call writeln(f, '<td align=right>' || dateval || '</td>')

call writeln(f, '<td>' || realname || '</td>')

call writeln(f, '</tr>')

/*
 *  Search for referring mails
 */

getfield 'messageid record ' || num || ' var mid.' || depth

if mid.depth ~= "" then
do
    siname = 'createhtmlsi.' || depth

    newsearchinfo 'name ' || siname

    setsearchfield 'searchinfo ' || siname || ' fieldid reference pattern ' || mid.depth

    find 'searchinfo ' || siname || ' stem st.' || depth

    if rc = 0 & st.depth.count ~= 0 then
    do

        do j.depth = 1 to st.depth.count

            tmp = j.depth

            /*
             *  Write the referring mail
             */

            call printmail(st.depth.tmp)

        end
    end
end

depth = depth - 1

return


/*----------------------------------------------------*
 *                                                    *
 *  Close an index page                               *
 *                                                    *
 *----------------------------------------------------*/


closelistfile:

/*
 *  Create the page navigation bar
 */

call writeln(f, '</table><table border=0 width="100%" cellspacing=0 bgcolor="' || titlebgcolor || '"><tr><td><font color="' || titletxcolor || '"> Pages: ')

if activepage > 1 then
do
    indexnum = activepage - 1

    if indexnum = 1 then indexnum = ""

    call writeln(f, '<a href="index' || indexnum || '.html">[<<]</a> ')

    do k = 1 to activepage - 1

        indexnum = k

        if indexnum = 1 then indexnum = ""

        call writeln(f, '<a href="index' || indexnum || '.html">' || k || '</a> ')

    end
end

call writeln(f, activepage || ' ')

if activepage < numpages then
do
    do k = activepage + 1 to numpages

        indexnum = k

        call writeln(f, '<a href="index' || indexnum || '.html">' || k || '</a> ')

    end

    indexnum = activepage + 1

    call writeln(f, '<a href="index' || indexnum || '.html">[>>]</a> ')

end

call writeln(f, '</font></td><td align=right><font color="' || titlebgcolor || '"><font color="' || titletxcolor || '">Created with the <a href="http://www.amigaworld.com/support/fiasco/">Mailing List Archive for Fiasco</a></font></td></tr></table><br>')

/*
 *  Add the template file to
 *  the end of the index page
 */

if open(t, endtemplatefile, "r") then
do
    do while ~eof(t)

        tln = readln(t)

        call writeln(f, tln)

    end

    call close(t)
end

call close(f)

return


/*----------------------------------------------------*
 *                                                    *
 *  Create a new index page                           *
 *                                                    *
 *----------------------------------------------------*/

newlistfile:

/*
 *  If there is still a index page open, finish it and close it
 */

if activepage ~= 0 then
do

    call closelistfile

end

activepage = activepage + 1

indexnum = activepage

if indexnum = "1" then indexnum = ""

if open(f, dir || "index" || indexnum || ".html", "w") then
do
    /*
     *  Write the template to the start of the
     *  index file
     */

    if open(t, starttemplatefile, "r") then
    do
        do while ~eof(t)

            tln = readln(t)

            call writeln(f, tln)

        end

        call close(t)
    end

    call writeln(f, '<!- Created with the Mailing List Archive Database for Fiasco by Nils Bandener ([e-mail]). More Information: http://www.amigaworld.com/support/fiasco  ->')
    call writeln(f, '<table width="100%" border=0 cellspacing=0 cellpadding=2 bgcolor="' ||  titlebgcolor || '"><tr><td><font color="' || titletxcolor || '" size="+1">' || mlname || ' · Page ' || activepage || ' / ' || numpages || '</font></td><td align=right><font color="' || titletxcolor || '">Last update: ' || date() || '</font></td></tr></table>')
    call writeln(f, '<table width="100%" border=0 cellspacing=0 cellpadding=2 bgcolor="' ||  bgcolor || '"><tr>')
    call writeln(f, '<td bgcolor="' || titlebgcolor || '" colspan=8><font color="' || titletxcolor || '"><b>Subject</b></font></td>')
    call writeln(f, '<td bgcolor="' || titlebgcolor || '"><font color="' || titletxcolor || '"><b>Size</b></font></td>')
    call writeln(f, '<td bgcolor="' || titlebgcolor || '"><font color="' || titletxcolor || '"><b>Date</b></font></td>')
    call writeln(f, '<td bgcolor="' || titlebgcolor || '"><font color="' || titletxcolor || '"><b>From</b></font></td></tr>')
end

return


/*----------------------------------------------------*
 *                                                    *
 *  Create a mail page                                *
 *                                                    *
 *----------------------------------------------------*/

writemailfile:

if open(m, dir || messagekey || ".html", "w") then
do
    /*
     *  Write the template file to the beginning
     */

    if open(t, starttemplatefile, "r") then
    do
        do while ~eof(t)

            tln = readln(t)

            call writeln(m, tln)

        end

        call close(t)
    end

    /*
     *  Write header
     */

    call writeln(m, '<!- Created with the Mailing List Archive Database for Fiasco by Nils Bandener ([e-mail]). More Information: http://www.amigaworld.com/support/fiasco  ->')
    call writeln(m, '<table border=0 cellspacing=0 cellpadding=2 bgcolor="' ||  bgcolor || '">')
    call writeln(m, '<tr><td bgcolor="' || titlebgcolor || '"></td><td bgcolor="' || titlebgcolor || '"><font color="' || titletxcolor || '" size="+1">' || mlname || '</font></td></tr>')
    call writeln(m, '<tr><td bgcolor="' || titlebgcolor || '" align=right><font color="' || titletxcolor || '" size="+1">Subject:</font></td><td><font size="+1">' || subject || '</font></td></tr>')
    call writeln(m, '<tr><td bgcolor="' || titlebgcolor || '" align=right><font color="' || titletxcolor || '" size="+1">From:</font></td><td><font size="+1"><a href="mailto:' || emailval || '">'|| realname || ' <' || emailval || '></a></font></td></tr>')
    call writeln(m, '<tr><td bgcolor="' || titlebgcolor || '" align=right><font color="' || titletxcolor || '" size="+1">Date:</font></td><td><font size="+1">' || dateval || '</font></td></tr>')
    call writeln(m, '</table><br><pre>')

    p = 1

    /*
     *  Convert newlines in the message body to <br>
     */

    do forever

        p = pos("0A"x, mailbody, p)

        if p ~= 0 then
        do
            mailbody = substr(mailbody, 1, p - 1) || "<br>" || substr(mailbody, p + 1)

            p = p + 4
        end
        else break

    end

    p = 1

    do forever

        p = pos("*n", mailbody, p)

        if p ~= 0 then
        do
            mailbody = substr(mailbody, 1, p - 1) || "<br>" || substr(mailbody, p + 2)

            p = p + 4
        end
        else break

    end

    p = 1

    do forever

        p = pos('*"', mailbody, p)

        if p ~= 0 then
        do
            mailbody = substr(mailbody, 1, p - 1) || '"' || substr(mailbody, p + 2)

            p = p + 1
        end
        else break

    end


    call writeln(m, mailbody || "<br></pre><br>")

    call writeln(m, '<table border=0 cellspacing=0 cellpadding=2 bgcolor="' ||  bgcolor || '">')
    call writeln(m, '<tr><td bgcolor="' || titlebgcolor || '"><font size="+1"><a href="index' || indexnum || '.html"><<</a></font></td><td><font size="+1"><a href="index' || indexnum || '.html">Back</a></font></td></tr></table>')

    /*
     *  Insert template at the end of the mail page
     */

    if open(t, endtemplatefile, "r") then
    do
        do while ~eof(t)

            tln = readln(t)

            call writeln(m, tln)

        end

        call close(t)
    end

    call close(m)

    /*
     *  Get size of mail page for
     *  index page
     */

    address command 'list >t:chtmp "' || dir || messagekey || '.html" lformat %l'

    sizeval = "?"

    if open(m, "t:chtmp", "read") then
    do
        sizeval = readln(m)

        call close(m)
    end
end

return