Patch title: Release 87 bulk changes
Abstract:
File: /pliant/appli/forum.pli
Key:
    Removed line
    Added line
module "/pliant/protocol/http/server.pli"
module "/pliant/protocol/http/style/default.style"
module "/pliant/protocol/common/mime.pli"
module "/pliant/language/unsafe.pli"
module "/pliant/language/stream.pli"
module "/pliant/admin/file.pli"
module "/pliant/fullpliant/user.pli"

module "forum/database.pli"
module "forum/difference.pli"
module "forum/patch.pli"
module "forum/display.pli"
module "forum/sync.remote"

module "/pliant/language/context.pli"
module "/pliant/protocol/smtp/meta.pli"
module "/pliant/util/crypto/random.pli"
module "/pliant/util/encoding/html.pli"
module "/pliant/util/encoding/date.pli"
module "/pliant/protocol/smtp/forward.pli"
module "/pliant/language/schedule/daemon.pli"
module "/pliant/language/schedule/resourcesem.pli"


#----------------------------------------------------------------------
#  build mails


function post_debate f d count s
  arg Data:Forum f ; arg Data:ForumDebate d ; arg Int count ; arg_rw Stream s
  s writeline "<tr><td bgcolor=[dq]#B8B885[dq]>"
  s writeline "<p>"
  if (exists f:subject:(d:subject))
    s writeline "<i>"+(html_encode f:subject:(d:subject):label)+": </i>"
  s writeline "<a href=[dq]"+f:url+keyof:d+"/[dq]>"+html_encode:(shunt d:title<>"" d:title "no title")+"</a>"
  s writeline "</p>"
  s writeline (html_encode d:abstract)
  var Int total := d:message:size
  s writeline "</td></tr>"
  s writeline "<tr><td>"
  s writeline "<i>"+string:count+" out of "+string:total+" message"+(shunt total>1 "s" "")+" in debate<tt> "+keyof:d+"</tt></i>"
  s writeline "</td></tr>"

function post_message m s
  arg Data:ForumMessage m ; arg_rw Stream s
  s writeline "<tr><td bgcolor=[dq]#BEBE98[dq]>"
  s writeline "Message posted by<tt> <b>"+(html_encode m:user)+"</b> </tt>on "+(string m:datetime)
  s writeline "</td></tr>"
  s writeline "<tr><td bgcolor=[dq]#D1D1B8[dq]>"
  if m:encoding=""
    if false
      s writeline "<tt>"
      s writeline (replace (html_encode m:message true) " " "&nbsp;")
      s writeline "</tt>"
    else
      s writeline "<pre>"
      s writechars (replace (replace (replace m:message  "&" "&#38;") "<" "&#60;") ">" "&#62;")
      s writeline "</pre>"
  else
    s writeline m:message
  s writeline "</td></tr>"

function post_message f d m freq
  arg_rw Data:Forum f ; arg_rw Data:ForumDebate d ; arg Data:ForumMessage m ; arg Str freq
  var Str base := f:path+"out/"+freq+generate_id
  var Str subject
  if freq="i"
    if (exists f:subject:(d:subject))
      subject := f:subject:(d:subject):label+": "+d:title
    else
      subject := d title
  eif freq="h"
    subject := f:title+" - hourly report"
  eif freq="d"
    subject := f:title+" - daily report"
  eif freq="w"
    subject := f:title+" - weekly report"
  var Str boundary := (repeat 8 "-")
  for (var Int i) 1 (max 128\8\uInt:size 1)
    var uInt rnd ; memory_strong_random addressof:rnd Int:size
    boundary += string rnd "radix 36"
  if freq<>"i"
    var List:Str keys
    each dd f:debate
      var CBool some := false
      each mm dd:message
        if (mm:report search freq -1)=(-1)
          some := true
      if some
        keys += keyof dd
    if not (exists keys:first)
      return
  var DateTime now := datetime
  (var Stream s) open base+".tmp" out+mkdir+safe
  s writeline "From: "+f:from
  s writeline "Subject: "+subject
  s writeline "Date: "+rfc1123_date:now
  s writeline "X-Mailer: Pliant forum "+string:pliant_release_number
  s writeline "MIME-Version: 1.0"
  s writeline "Content-Type: multipart/mixed; boundary=[dq]"+(boundary 2 boundary:len)+"[dq]"
  s writeline ""
  s writeline "This is a multi-part message in MIME format."
  s writeline boundary
  s writeline "Content-Type: text/html; charset=iso-8859-1"
  s writeline ""
  s writeline "<!DOCTYPE HTML PUBLIC [dq]-//W3C//DTD HTML 3.2 Final//EN[dq]>"
  s writeline "<html>"
  s writeline "<head>"
  s writeline "<title>"+html_encode:subject+"</title>"
  s writeline "</head>"
  s writeline "<body>"
  if freq="i"
    s writeline "<table>"
    post_debate f d 1 s
    post_message m s
    s writeline "</table>"
  else
    var Pointer:Str k :> keys first
    s writeline "<p>"
    while exists:k
      var Data:ForumDebate dd :> f:debate k
      if (exists f:subject:(dd:subject))
        s writeline "<i>"+(html_encode f:subject:(dd:subject):label+": ")+"</i>"
      s writeline "<a href=[dq]#"+k+"[dq]>"+html_encode:(shunt dd:title<>"" dd:title "no title")+"</a><br>"
      k :> keys next k
    s writeline "</p>"
    var Pointer:Str k :> keys first
    while exists:k
      s writeline "<p>"
      s writeline "<a name=[dq]"+k+"[dq]></a>"
      s writeline "<table>"
      var Int count := 0
      each mm f:debate:k:message
        if (mm:report search freq -1)=(-1)
          count += 1
      post_debate f f:debate:k count s
      each mm f:debate:k:message
        if (mm:report search freq -1)=(-1)
          post_message mm s
          mm report := mm:report+freq
      s writeline "</table>"
      s writeline "</p>"
      k :> keys next k
  s writeline "</body>"
  s writeline "</html>"
  s writeline boundary+"--"
  s writeline ""
  s close
  var (Link Database:MailMeta) db :> new Database:MailMeta
  db load base+".pdb"
  var Data:MailMeta meta :> db data
  meta push
  meta queued_on := now
  meta from := f from
  each su f:subscriber
    if su:frequency=freq
      meta:target create keyof:su
      meta:target:(keyof:su) box := su mailbox
  db store
  file_move base+".tmp" base+".mail"
  if freq="i"
    forward_mail base+".mail" true "forward a just posted forum message"

function forward_forum
  daemon "forum mailer daemon"
    while not daemon_emergency
      daemon_sleep 3600
      if not daemon_emergency
        var DateTime now := datetime
        each f forum_database:data:forum
          if now:seconds-f:last_hourly_report:seconds>=3600
            post_message f (var Data:ForumDebate no_debate) (var Data:ForumMessage no_message) "h"
            f last_hourly_report := now
          if now:seconds-f:last_daily_report:seconds>=86400
            post_message f (var Data:ForumDebate no_debate) (var Data:ForumMessage no_message) "d"
            f last_daily_report := now
          if now:seconds-f:last_weekly_report:seconds>=7*86400
            post_message f (var Data:ForumDebate no_debate) (var Data:ForumMessage no_message) "w"
            f last_weekly_report := now
          var Array:FileInfo files := file_list f:path+"out/" standard  
          for (var Int i) 0 files:size-1
            if files:i:extension=".mail"
              if not daemon_emergency
                forward_mail files:i:name
forward_forum


#----------------------------------------------------------------------
#  display patches


method page browse_directory f d patch path options
  arg_rw HtmlPage page ; arg_rw Data:Forum f ; arg_rw Data:ForumDebate d ; arg CBool patch ; arg Str path options
  implicit page
    title "Browse patch '"+d:title+"'"
    if options="delete" and patch
      [Are you sure that you want to delete directory] ; fixed:(text " "+path) ; eol
      button "yes" noeol
        file_tree_delete (forum_path f d "/patch"+path)
        goto_backward
      button "no"
        goto_backward
    eif options="list"
      var Array:FileInfo files := file_list (forum_path f d "/patch"+path) standard+relative+directories
      for (var Int i) 0 files:size-1
        file_header path+files:i:name (var FileInfo old_info) (var FileInfo new_info) (var CBool binary) (var Int lines)
        html "<pfile name=[dq]"+(html_encode files:i:name)+"[dq] size=[dq]"+(string new_info:size)+"[dq] date=[dq]"+(string new_info:datetime)+"[dq] options=[dq][dq] />[lf]"
    else
      table columns 2 border 0
        cell [Path:]
        cell fixed:(text path)
      var Array:FileInfo patches := file_list (forum_path f d "/patch"+path) standard+relative+directories
      if patches:size=0
        head "<meta name=[dq]robots[dq] content=[dq]noindex,nofollow[dq]>[lf]"
      var (Index Str FileInfo) sorted
      for (var Int i) 0 patches:size-1
        if not patches:i:is_directory
          file_header (forum_path f d "/patch"+path)+patches:i:name (var FileInfo old_info) (var FileInfo new_info) (var CBool binary) (var Int lines)
          html "<pfile name=[dq]"+(html_encode patches:i:name)+"[dq] size=[dq]"+(string new_info:size)+"[dq] date=[dq]"+(string new_info:datetime)+"[dq] options=[dq][dq] />[lf]"
          patches:i:size := new_info size
          patches:i:datetime := new_info datetime
          patches:i:options += " changed_lines "+string:lines
        else
          html "<pfile name=[dq]"+(html_encode patches:i:name)+"[dq] size=[dq]?[dq] date=[dq]?[dq] options=[dq][dq] />[lf]"
          patches:i:options += " patched_directory"
        sorted insert patches:i:name patches:i 
      var Array:FileInfo files := file_list f:reference_path+(path 1 path:len) standard+relative+directories
      for (var Int i) 0 files:size-1
        if not exists:(sorted first files:i:name)
          sorted insert files:i:name files:i   
      table columns 4
        cell header
          bold [name]
        cell header
          bold [size]
        cell header
          bold [date ]
          note "*"
            title "Pliant date format"
            [The date is displayed using] ; fixed [ ] ; italic [year] ; [/] ; italic [month] ; [/] ; italic [day] ; [ ] ; italic [hour] ; [:] ; italic [minute] ; [:] ; italic [second] ; fixed [ ] ; [format.]
        cell header
          void
        var Pointer:FileInfo file :> sorted first
        while exists:file
          if file:is_directory
            if (file:options option "patched_directory")
              cell color (color hsl 60 30 80)
                bold
                  link file:name file:name options "browse"
            else
              cell
                bold
                  link file:name file:name options "browse"
            cell void ; cell void
            cell
              small
                if (file_list path+file:name standard+directories):size=0 and patch
                  link "delete" file:name options "delete"
          else
            if (file:options option "changed_lines")
              cell color (color hsl 60 30 80)
                text file:name
            else
              cell
                text file:name
            cell
              text (string file:size)
            cell
              text (string file:datetime)
            cell
              small
                var Str mime := query_mime_type file:extension
                if not (mime parse "binary/" any) and not (mime parse "image/" any)
                  link "view" file:name no_extension options "view" ; fixed [ ]
                  if patch
                    link "edit" file:name no_extension options "edit" ; fixed [ ]
                link "download" file:name no_extension options "download" ; fixed [ ] 
                if patch
                  link "delete" file:name no_extension options "delete"
          file :> sorted next file
      if patch
        file_upload "" (var Str filename) noeol
        button "Upload"
          if (file_query filename standard)=defined
            var Str remote := filename option "remote_name" Str
            if remote<>""
              file_difference f:reference_path+(path 1 path:len)+remote filename (forum_path f d "/patch"+path)+remote
              file_hook (forum_path f d "/patch"+path)+remote
              d status := " "
              d update (forum_path f d "/")
              reload_page
            else
              [I have not received the file name !]
          else
            [I have not received the file !]
            para
              [The explaination might be that your browser does not support uploading because it cannot send multipart forms.] ; eol
              [If you wonder what browsers supports uploading, then all I can tel you is that Nestcape 4 and Mozilla do.]
        input "" (var Str filename2) noeol
        button "Create file" noeol
          (var Stream s) open (forum_path f d "/patch"+path)+filename2 out+safe+mkdir ; s close
          reload_page
        button "Create directory"
          file_tree_create (forum_path f d "/patch"+path)+filename2+"/"
          reload_page
      para
        link "Browse the main tree" "/pliant/browse/file"+path
      para
        [Yellow cells indicate that the file is modifyed in this patch, or the directory contains files modifyed in this patch.]


method page browse_file f d patch path options
  arg_rw HtmlPage page ; arg_rw Data:Forum f ; arg CBool patch ; arg_rw Data:ForumDebate d ; arg Str path options
  var CBool patched := (file_query (forum_path f d "/patch"+path) standard)=defined
  if patched
    file_header (forum_path f d "/patch"+path) (var FileInfo old_info) (var FileInfo new_info) (var CBool binary) (var Int lines)
  implicit page
    if (options option "view") or (options option "review") and not binary
      var Str section := (shunt (options option "rejected") "/rejected" "/patch")
      patched := (file_query (forum_path f d section+path) standard)=defined
      table columns 1 border 0
        cell color (color hsl 0 0 90)
          table columns 2 border 0
            cell [Patch title:]
            cell
              text d:title
            cell [Abstract:]
            cell
              table columns 1
                cell color (color hsl 60 10 80)
                  text d:abstract
            cell [File:]
            cell
              bold
                fixed text:path
            cell [Key:]
            cell
              table columns 2 border 0
                cell color (color hsl 0 25 80)
                  fixed [   ]
                cell
                  [Removed line]
                cell color (color hsl 120 25 80)
                  fixed [   ]
                cell
                  [Added line]
      if patched
        display_difference (forum_path f d section+path) (shunt f:live_path<>"" f:live_path f:reference_path)+path f d patch section path options
      else
        head "<meta name=[dq]robots[dq] content=[dq]noindex,nofollow[dq]>[lf]"
        fixed
          (var Stream s0) open f:reference_path+(path 1 path:len) in+safe
          while not s0:atend
            text s0:readline+"[lf]"
    eif options="edit" and patch
      if (patched and not binary) or file_is_ascii:path
        small
          bold text:path
          fixed [     ]
          if not patched
            new_info := file_query path standard
            text (string new_info:size)+" bytes last modifyed on "+(string new_info:datetime)
          eol
        var Stream s1
        if patched
          var Str temp := file_temporary
          file_extract_new (forum_path f d "/patch"+path) temp
          s1 open temp in+safe
        else
          s1 open f:reference_path+(path 1 path:len) in+safe
        var Str all := ""
        while not s1:atend
          all += s1:readline+"[lf]"
        if patched
          file_delete temp
        text_input "" all columns 80 rows 35
        button "Update "+(path (path search_last "/" -1)+1 path:len)
          var Str final := file_temporary
          (var Stream s2) open final out+safe+mkdir
          s2 writechars all
          s2 close
          if (file_query (forum_path f d "/patch"+path) standard)=defined
            var Str temp := file_temporary
            file_extract_old (forum_path f d "/patch"+path) temp
            file_difference temp final (forum_path f d "/patch"+path)
            file_delete temp
          else
            file_difference f:reference_path+(path 1 path:len) final (forum_path f d "/patch"+path)
          file_hook (forum_path f d "/patch"+path) 
          file_delete final
          d status := " "
          d update (forum_path f d "/")
          goto_backward
      else
        [This is a binary file !]
    eif options="download"
      if patched
        var Str temp := file_temporary
        file_extract_new (forum_path f d "/patch"+path) temp
      reset_http_answer
      http_request send_static_file (shunt patched temp f:reference_path+(path 1 path:len)) "filter_binary"
      http_request send_static_file (shunt patched temp f:reference_path+(path 1 path:len)) "mime [dq]binary/*[dq]"
      if patched
        file_delete temp
    eif options="delete" and patch
      [Are you sure that you want to delete file] ; fixed:(text " "+path+" " ) ; [in patch '] ; text d:title ; ['] ; eol
      button "yes" noeol
        file_delete (forum_path f d "/patch"+path)
        file_hook (forum_path f d "/patch"+path)
        goto_backward
      button "no"
        goto_backward
    else
      if patched
        var Str temp := file_temporary
        file_extract_new (forum_path f d "/patch"+path) temp
      var Str ext := forum_path f d "/patch"+path
      ext := ext (ext search_last "." ext:len) ext:len
      var Str ext := forum_path f d "/patch"+path ; ext := ext (ext search_last "." ext:len) ext:len
      var Str mime := query_mime_type ext
      reset_http_answer
      http_request send_static_file (shunt patched temp f:reference_path+(path 1 path:len)) options+" mime "+string:mime
      http_request send_static_file (shunt patched temp f:reference_path+(path 1 path:len)) "mime "+string:mime
      if patched
        file_delete temp




#----------------------------------------------------------------------
#  display forum


method page display f d post maintainer patch options
  arg_rw HtmlPage page ; arg_rw Data:Forum f ; arg_rw Data:ForumDebate d ; arg Bool post maintainer patch ; arg Str options
  implicit page
    html "<title>"+(html_encode f:title)+"</title>[lf]"
    table columns 1 border 0
      cell color (color hsl 60 25 80)
        para
          center (bold (text f:title))
        if maintainer or (user_name<>"" and user_name=d:maintainer:"creator")
          para
            select "" d:subject noeol
              option "" ""
              each su f:subject sort su:order
                option su:label keyof:su
            input "" d:title length 60
          text_input "" d:abstract columns 60 rows 8
        else
          para
            if (exists f:subject:(d:subject))
              italic (text f:subject:(d:subject):label+": ")
            bold (text d:title)
          text d:abstract
      if f:reference_path<>"" and (maintainer or (user_name<>"" and user_name=d:maintainer:"creator"))
        cell color (color hsl 60 20 65)
          each m d:maintainer
            text m ; eol
          if patch and (user_name=d:maintainer:"creator" or allowed:"administrator")
            input "Maintainer name: " (var Str name) noeol
            button "Add new maintainer" noeol
              if (exists user:name)
                var Str key := "m"+(string datetime:seconds)
                d:maintainer create key
                d:maintainer key := name
                reload_page
              else
                [There is no ] ; fixed text:name ; [ user defined on this site.]
            button "Remove maintainer"
              part remove
                each m d:maintainer
                  if m=name and (keyof:m<>"creator" or allowed:"administrator")
                    d:maintainer delete keyof:m
                    leave remove
              reload_page
      if maintainer
        cell color (color hsl 60 20 65)
          read_only not maintainer
            select "" d:status noeol
              option "" ""
              each st f:status sort st:order
                option st:label keyof:st
          button "Record changes"
            goto_backward
      if f:reference_path<>""
        var Array:FileInfo patches := file_list (forum_path f d "/patch/") standard+recursive+relative
        cell void
        cell
          table columns 2 border 0
            cell
              [Patch] ; fixed { [ ] ; bold (text keyof:d) ; [ ] } ; eol
              if maintainer
                button "Apply all"
                  title "Apply all the patch"
                  study_patch f:reference_path (forum_path f d "/patch/") ""
                  button "Apply the patch"
                    apply_patch f:reference_path f:live_path (forum_path f d "/patch/") "" (forum_path f d "/rejected/")
                    each s d:patch_section
                      if s:release=""
                        s release := string pliant_release_number
                    goto_backward
                button "Reverse all"
                  title "Reverse all the patch"
                  study_reverse f:reference_path (forum_path f d "/patch/") ""
                  button "Reverse the patch"
                    reverse_patch f:reference_path f:live_path (forum_path f d "/patch/") "" (forum_path f d "/rejected/")
                    goto_backward
            cell
              table columns 3
               cell header [Patch section]
               cell header
                 [Release ]
                 note "*"
                   [The Pliant release in which the patch has been included.]
               cell void
               each s d:patch_section
                 cell 
                   text keyof:s
                 cell
                   read_only not maintainer
                     input "" s:release length 5
                 cell
                   if maintainer
                     button "Apply" noeol
                       title "Apply patch"
                       study_patch f:reference_path (forum_path f d "/patch/") keyof:s
                       button "Apply the patch"
                         apply_patch f:reference_path f:live_path (forum_path f d "/patch/") keyof:s (forum_path f d "/rejected/")
                         if s:release=""
                           s release := string pliant_release_number
                         goto_backward
                     button "Reverse" noeol
                       title "Reverse patch"
                       study_reverse f:reference_path (forum_path f d "/patch/") keyof:s
                       button "Reverse the patch"
                         reverse_patch f:reference_path f:live_path (forum_path f d "/patch/") keyof:s (forum_path f d "/rejected/")
                         goto_backward
               if maintainer
                 cell
                   input "" (var Str section_id) length 12
                 cell void
                 cell
                   button "Create" noeol
                     d:patch_section create section_id
                     reload_page
                   button "Delete" noeol
                     d:patch_section delete section_id
                     reload_page
        cell
          if f:live_path<>"" and maintainer
            button "Include live changes" noeol
              title "Include live changes"
              study_live_changes f:reference_path f:live_path (forum_path f d "/patch/")
              input "Include only the changes in: " (var Str filter)
              button "Include the changes"
                catch_live_changes f:reference_path f:live_path filter (forum_path f d "/patch/") (forum_path f d "/rejected/")
                d update (forum_path f d "/")
                goto_backward
            fixed [  ]
          if (file_query (forum_path f d "/rejected/") standard)=defined and maintainer
            button "Drop rejected changes" noeol
              title "Drop rejected changes"
              var Array:FileInfo rejected := file_list (forum_path f d "/rejected/") standard+recursive+relative
              table border 0 columns 3
                for (var Int i) 0 rejected:size-1
                  file_header (forum_path f d "/rejected/"+rejected:i:name) (var FileInfo old_info2) (var FileInfo new_info2) (var CBool binary2) (var Int lines2)
                  cell
                    link rejected:i:name rejected:i:name no_extension options "view rejected"
                  cell
                    if binary2
                      text (string new_info2:size)+" byte"+(shunt new_info2:size>1 "s" "")
                    eif lines2=defined
                      text string:lines2+" modified line"+(shunt lines2>1 "s" "")
                  cell
                    link "review" rejected:i:name no_extension options "review rejected"
              button "Drop rejected changes"
                file_tree_delete (forum_path f d "/rejected/")
                goto_backward
            fixed [  ]
          if maintainer
            button "Upload to another server" noeol
              title "Upload patch"
              input "Server to upload the patch to: " (var Str server) noeol
              button "Upload"
                var ExtendedStatus st2 := patch_upload keyof:f keyof:d server
                if st2=success
                  goto_backward
                else
                  [Failed to upload the patch.] ; eol
                  fixed (text st2:message)
        cell
          table border 0 columns 5
            for (var Int i) 0 patches:size-1
              file_header (forum_path f d "/patch/"+patches:i:name) (var FileInfo old_info) (var FileInfo new_info) (var CBool binary) (var Int lines) (var List:Str sections)
              cell
                link patches:i:name patches:i:name no_extension options "view"
              cell
                if (exists sections:first)
                  small
                    var Pointer:Str section :> sections first
                    while exists:section
                      text " "+section
                      section :> sections next section
              cell
                text (string patches:i:datetime)
              cell
                if binary
                  text (string new_info:size)+" byte"+(shunt new_info:size>1 "s" "")
                eif lines=defined
                  text string:lines+" modified line"+(shunt lines>1 "s" "")
              cell
                var Str dir := patches:i:name ; dir := dir 0 (dir search_last "/" -1)+1
                link "browse" dir options "browse" no_extension
                fixed [ ]
                link "review" patches:i:name no_extension options "review"
                if (file_query (forum_path f d "/rejected/"+patches:i:name) standard)=defined
                  fixed [ ]
                  link "review rejected changes" patches:i:name no_extension options "review rejected"
        cell
          link "Browse patch files tree" "" options "browse" ; eol
          link "Download the patch" keyof:d+".patch" options "patch_download"
          if patch
            fixed [  ] ; link "Upload the patch" "" options "patch_upload"
          fixed [  ] ; link "Download as a ready to extract .tgz tarball" keyof:d+".tgz" options "tgz_download"
        cell void
      each msg d:message
        cell color (color hsl 60 15 70)
          [Message posted by] ; fixed (text " "+msg:user+" ") ; [on] ; fixed [ ] ; text (string msg:datetime)
        cell color (color hsl 60 10 80)
          if msg:encoding=""
            fixed
              text msg:message
          else
            html msg:message
    if post
      button "Post a new message"
        title "New message"
        if user_name=""
          input "Your name: " (var Str name)
        text_input "" (var Str message) columns 80 rows 20
        select "Message format:" (var Str encoding)
          option "Simple text" ""
          option "HTML" "html"
        button "Preview the message"
          var Str user := shunt user_name<>"" user_name "maybe "+name
          title "Message preview"
          table columns 1
            cell color (color hsl 60 20 65)
              para
                center (bold (text f:title))
              para
                if (exists f:subject:(d:subject))
                  italic (text f:subject:(d:subject):label+": ")
                bold (text d:title)
              text d:abstract
            cell color (color hsl 60 15 70)
              [Message posted by] ; fixed (text " "+user+" ") ; [on] ; fixed [ ] ; text string:datetime
            cell color (color hsl 60 10 80)
              if encoding=""
                fixed
                  text message
              else
                html message
          button "Post the message" noeol
            var DateTime now := datetime
            var Str id := generate_id
            d:message create id
            var Data:ForumMessage msg2 :> d:message id
            msg2 user := user
            msg2 datetime := now
            msg2 encoding := encoding
            msg2 message := message
            d last_author := user
            d last_message := now
            post_message f d msg2 "i"
            goto_backward 2
          button "Edit again"
            page html "<script language=[dq]JavaScript[dq]>[lf]"
            page html "history.go(-2)[lf]"
            page html "</script>[lf]"
   

method page how_long_ago dt now
  arg_rw HtmlPage page ; arg DateTime dt now
  implicit page
    var Float ago := now:seconds-dt:seconds
    if ago<3600
      var Int u := cast ago/60 Int
      text string:u+" mn"
    eif ago<86400
      var Int u := cast ago/3600 Int
      text string:u+" hour"+(shunt u>1 "s" "")
    else
      var Int u := cast ago/86400 Int
      text string:u+" day"+(shunt u>1 "s" "")

function archive f d -> dt
  arg Data:Forum f ; arg Data:ForumDebate d ; arg DateTime dt
  var Str status := d status
  var Data:ForumStatus st :> f:status status
  dt := d timestamp
  dt seconds += st archive_delay

method page display f post maintainer options
  arg_rw HtmlPage page ; arg_rw Data:Forum f ; arg CBool post maintainer ; arg Str options
  implicit page
    title f:title
    box border 1
      text f:abstract
    var DateTime now := datetime
    var Str status := options option "status" Str
    var CBool all := options option "all"
    var CBool patches := f:reference_path<>""
    var Float hue := http_request:style_options option "hue" Float
    if hue=undefined
      hue := 120
    var CBool upgrade := false
    if (options option "detailed")
      table columns 2+(shunt patches 1 0)+(shunt maintainer 1 0) border 0
        cell color (color hsl hue 8 70) [Subject]
        cell color (color hsl hue 8 70) [Messages]
        if patches
          cell color (color hsl hue 8 70) [Files]
        if maintainer
          cell void
        each d f:debate filter (status="" or d:status=status) and (all or (archive f d)=undefined or (archive f d)>now) sort d:timestamp reversed
          cell header
            para
              if (exists f:subject:(d:subject))
                italic (text f:subject:(d:subject):label+": ")
              link (shunt d:title<>"" d:title "no title") keyof:d+"/"
            text d:abstract
          cell header
            para
              italic (text (shunt  (exists f:status:(d:status)) f:status:(d:status):label ""))
            var Int n := d:message:size
            if n>0
              text string:n+" message"+(shunt n>1 "s" "") ; eol
              how_long_ago d:last_message now ; eol
              text d:last_author
          if patches
            cell header
              if false # para
                italic
                  text (shunt d:patch_status="A" "applied" d:patch_status="R" "reversed" "")
                  if d:patch_release<>""
                    text " in release "+d:patch_release
              var Int n := d patch_count
              if n>0
                text string:n+" file"+(shunt n>1 "s" "") ; eol
                how_long_ago d:last_patch now
                each m d:maintainer
                  eol ; text m
          if maintainer
            cell
              button "Delete"
                title "Delete a patch"
                [Patch title: ] ; fixed (text d:title) ; eol
                [Patch maintainers:]
                each m d:maintainer
                  fixed (text " "+m)
                eol
                button "Do delete it"
                  file_tree_delete (forum_path f d "/")
                  f:debate delete keyof:d
                  goto_backward
    else
      table columns 5 border 0
        cell header [Subject]
        cell header small:[Messages[lf]count]
        cell header small:[Last post]
        cell header [By]
        cell header small:[Status]
        each d f:debate filter (status="" or d:status=status) and (all or (archive f d)>now) sort d:timestamp reversed
          cell
            if (exists f:subject:(d:subject))
              italic (text f:subject:(d:subject):label+": ")
            link (shunt d:title<>"" d:title "no title") keyof:d+"/"
          cell
            text (string d:message:size)
          cell
            if d:last_message=defined
              how_long_ago d:last_message now
          cell
            text d:last_author
          cell
            if (exists f:status:(d:status))
              small (italic (text f:status:(d:status):label))
            if d:path<>""
              upgrade := true
            if false #  d:patch_status<>""
              eol
              small
                italic
                  text (shunt d:patch_status="A" "applied" d:patch_status="R" "reversed" "")
                  if d:patch_release<>""
                    text " "+d:patch_release
    if post
      para
        button "Open a new debate" noeol
          title f:title+": create a new debate"
          if user_name=""
            input "Your name: " (var Str name)
          if f:subject:size>0
            select "Subject: " (var Str subject)
              option "" ""
              each su f:subject sort su:order
                option su:label keyof:su
          input "Title: " (var Str title) length 60
          para
            text_input "Abstract: " (var Str abstract) columns 60 rows 8
            italic [The abstract is always in simple text format (ASCII)]
          para
            [Initial message: ] ; eol
            text_input "" (var Str message) columns 80 rows 20
            select "Message format:" (var Str encoding)
              option "Simple text" ""
              option "HTML" "html"
          button "Preview the new debate"
            var Str user := shunt user_name<>"" user_name "maybe "+name
            title "Message preview"
            table columns 1
              cell color (color hsl 60 20 65)
                para
                  center (bold (text f:title))
                para
                  if (exists f:subject:subject)
                    italic (text f:subject:subject:label+": ")
                  bold text:title
                text abstract
              cell color (color hsl 60 15 70)
                [Message posted by] ; fixed (text " "+user+" ") ; [on] ; fixed [ ] ; text string:datetime
              cell color (color hsl 60 10 80)
                if encoding=""
                  fixed
                    text message
                else
                  html message
            button "Post it now" noeol
              var Str id := generate_id
              f:debate create id
              var Data:ForumDebate d2 :> f:debate id
              var DateTime now := datetime
              d2 subpath := (string now:year)+(right (string now:month) 2 "0")+"/"+(right (string now:day) 2 "0")+"/"
              d2 subject := subject
              d2 title := title
              d2 abstract := abstract
              d2 last_message := now
              d2:maintainer create "creator"
              d2:maintainer "creator" := user_name
              if message<>""
                d2:message create id
                var Data:ForumMessage msg2 :> d2:message id
                msg2 user := user
                msg2 datetime := now
                msg2 encoding := encoding
                msg2 message := message
                d2 update (forum_path f d2 "/patch/")
                post_message f d2 msg2 "i"
              goto_backward 2
            button "Edit again"
              page html "<script language=[dq]JavaScript[dq]>[lf]"
              page html "history.go(-2)[lf]"
              page html "</script>[lf]"
        if maintainer
          fixed [  ]
          button "Download from another server" noeol
            title "Download patch"
            input "Server: " (var Str server) noeol
            input "Patch: " (var Str patch_id) noeol
            button "Download"
              var ExtendedStatus st := patch_download keyof:f patch_id server
              if st=success
                goto_backward
              else
                [Failed to download the patch.] ; eol
                fixed (text st:message)
    if not (options option "detailed")
      para
        link "DETAILED VIEW" "" options options+" detailed"
    para
      if status="" and not all
        each st f:status
          if st:display_all_label<>""
            link st:display_all_label "" options options+" status "+(string keyof:st)+" all" ; eol
      if not all
        link "display all debates" "" options options+" all"
    if user_name<>""
      var Str freq := f:subscriber:user_name frequency
      select "I want to receive messages by email " freq noeol
        option "Never" " "
        option "Once a week" "w"
        option "Once a day" "d"
        option "Once every hour" "h"
        option "Immediately" "i"
      var Str mailbox := f:subscriber:user_name mailbox
      if mailbox=""
        mailbox := user:user_name email
      input " at " mailbox noeol
      button "Do it now"
        if freq<>" " and mailbox<>""
          f:subscriber create user_name
          f:subscriber:user_name mailbox := mailbox
          f:subscriber:user_name frequency := freq 0
        else
          f:subscriber delete user_name
        reload_page
    else
      para
        if not post
          [If you want to open a new debate or subscribe this forum mailing list, ]
        else
          [If you want to subscribe this forum mailing list, ]
        [you should log in, after creating an account if you don't have one already.] ; eol
        execute_dynamic_page "pliant:/pliant/protocol/http/login.html"
    if maintainer
      para
        button "Display subscribers list" noeol
          title "Subscribers to "+f:title
          table columns 3
            cell header [User]
            cell header [Mailbox]
            cell header [Frequency]
            for (var Int lap) 0 3
              each sc f:subscriber
                if sc:frequency="ihdw":lap
                  cell
                    fixed (text keyof:sc)
                  cell
                    text sc:mailbox
                  cell
                    text (shunt lap=0 "immediatly" lap=1 "hourly" lap=2 "daily" "weekly")
          var Int n := f:subscriber:size
          text "There "+(shunt n>1 "are" "is" )+" " +(shunt n=0 "no" string:n)+" subscriber"+(shunt n>1 "s" "")+" to "+f:title+"." ; eol
          var Array:FileInfo files := file_list f:path+"out/" standard  
          var Int n := 0
          for (var Int i) 0 files:size-1
            if files:i:extension=".mail"
              n += 1
          text "There "+(shunt n>1 "are" "is" )+" "+(shunt n=0 "no" string:n)+" mail"+(shunt n>1 "s" "")+" pending in the forum out queue."
        if upgrade
          button "Move to conforming location" noeol
            f path := "data:/pliant/forum/"+keyof:f+"/"
            f url := "http://"+computer_fullname+"/pliant/browse/forum/"+keyof:f+"/"
            each d4 f:debate
              if d4:path<>""
                var Str old := d4 path
                d4 path := ""
                var DateTime now := d4 last_patch
                if now=undefined
                  now := datetime
                d4 subpath := (string now:year)+(right (string now:month) 2 "0")+"/"+(right (string now:day) 2 "0")+"/"
                file_tree_copy old (forum_path f d4 "/patch/")
                file_tree_delete old
            reload_page
        button "Recompute patches informations"
          each d3 f:debate
            d3 update (forum_path f d3 "/patch/")
          reload_page


#----------------------------------------------------------------------
#  dispatch request


method page forum path1 options
  arg_rw HtmlPage page ; arg Str path1 options
  implicit page
    if path1="/"
      title "List of the forums hosted on "+http_request:site_name
      table columns 1 border 0
        each f forum_database:data:forum
          if f:site=http_request:site_name and (allowed f:read)
            cell header
              para
                link f:title keyof:f+"/"
              text f:abstract
    eif (path1 parse "/" any:(var Str id) "/" any:(var Str remain))
      var Data:Forum f :> forum_database:data:forum id
      if exists:f and f:site=http_request:site_name and (allowed f:read)
        var Str path := "/"+remain
        var Bool post := allowed f:post
        var Bool maintainer := allowed f:maintainer
        if path="/"
          display f post maintainer options
        eif (path parse "/" any:(var Str id) "/" any:(var Str subpath))
          var Data:ForumDebate d :> f:debate id
          if exists:d
            var Bool patch := maintainer
            each m d:maintainer
              if user_name=m
                patch := true
            if subpath=""
              if options="browse" and f:reference_path<>""
                browse_directory f d patch "/" options
              eif options="patch_upload" and f:reference_path<>"" and patch
                title "Upload the overall patch"
                file_upload "Your local patch file: " (var Str patchfile) noeol
                button "Upload"
                  if patchfile<>""
                    var ExtendedStatus st := patch_unpack patchfile (forum_path f d "/patch/")
                    d update (forum_path f d "/")
                    if st=success
                      goto_backward
                    else
                      [Failed to handle the provided file as a Pliant patch file.] ; eol
                      fixed (text st:message)
                  else
                    [I have not received the patch file !]
              else
                display f d post maintainer patch options
            eif f:reference_path=""
              [There are no patches on this forum.]
            eif options="patch_download" and subpath=keyof:d+".patch"
              var Str temp := file_temporary
              patch_pack (forum_path f d "/patch/") temp
              reset_http_answer
              http_request send_static_file temp "filter_binary"
              http_request send_static_file temp "mime [dq]binary/*[dq]"
              file_delete temp
            eif options="tgz_download" and subpath=keyof:d+".tgz"
              patch_tgz_download (forum_path f d "/patch/") f:official_path
            eif (subpath subpath:len-1)="/"
              browse_directory f d patch "/"+subpath options
            else
              browse_file f d patch "/"+subpath options
          else
            [There is no] ; fixed (text " "+id+" ") ; [debate on this forum.]
      eif not exists:f
        [There is no such forum.]
      eif not (allowed f:read)
        [You are not allowed to access this forum.]
      else
        text "This forum is hosted on "+f:site

export '. forum'