/pliant/appli/forum.pli
 
 1  module "/pliant/protocol/http/server.pli" 
 2  module "/pliant/protocol/http/style/default.style" 
 3  module "/pliant/protocol/common/mime.pli" 
 4  module "/pliant/language/unsafe.pli" 
 5  module "/pliant/language/stream.pli" 
 6  module "/pliant/admin/file.pli" 
 7  module "/pliant/fullpliant/user.pli" 
 8   
 9  module "forum/database.pli" 
 10  module "forum/difference.pli" 
 11  module "forum/patch.pli" 
 12  module "forum/display.pli" 
 13  module "forum/sync.remote" 
 14   
 15  module "/pliant/language/context.pli" 
 16  module "/pliant/protocol/smtp/meta.pli" 
 17  module "/pliant/util/crypto/random.pli" 
 18  module "/pliant/util/encoding/html.pli" 
 19  module "/pliant/util/encoding/date.pli" 
 20  module "/pliant/protocol/smtp/forward.pli" 
 21  module "/pliant/language/schedule/daemon.pli" 
 22  module "/pliant/language/schedule/resourcesem.pli" 
 23   
 24   
 25 
 
 26  #  build mails 
 27   
 28   
 29  function post_debate f d count s 
 30    arg Data:Forum f ; arg Data:ForumDebate d ; arg Int count ; arg_rw Stream s 
 31    writeline "<tr><td bgcolor=[dq]#B8B885[dq]>" 
 32    writeline "<p>" 
 33    if (exists f:subject:(d:subject)) 
 34      writeline "<i>"+(html_encode f:subject:(d:subject):label)+": </i>" 
 35    writeline "<a href=[dq]"+f:url+keyof:d+"/[dq]>"+html_encode:(shunt d:title<>"" d:title "no title")+"</a>" 
 36    writeline "</p>" 
 37    writeline (html_encode d:abstract) 
 38    var Int total := d:message:size 
 39    writeline "</td></tr>" 
 40    writeline "<tr><td>" 
 41    writeline "<i>"+string:count+" out of "+string:total+" message"+(shunt total>"s" "")+" in debate<tt> "+keyof:d+"</tt></i>" 
 42    writeline "</td></tr>" 
 43   
 44  function post_message m s 
 45    arg Data:ForumMessage m ; arg_rw Stream s 
 46    writeline "<tr><td bgcolor=[dq]#BEBE98[dq]>" 
 47    writeline "Message posted by<tt> <b>"+(html_encode m:user)+"</b> </tt>on "+(string m:datetime) 
 48    writeline "</td></tr>" 
 49    writeline "<tr><td bgcolor=[dq]#D1D1B8[dq]>" 
 50    if m:encoding="" 
 51      if false 
 52        s writeline "<tt>" 
 53        s writeline (replace (html_encode m:message true) " " "&nbsp;") 
 54        s writeline "</tt>" 
 55      else 
 56        writeline "<pre>" 
 57        writechars (replace (replace (replace m:message  "&" "&#38;""<" "&#60;"">" "&#62;") 
 58        writeline "</pre>" 
 59    else 
 60      writeline m:message 
 61    writeline "</td></tr>" 
 62   
 63  function post_message f d m freq 
 64    arg_rw Data:Forum f ; arg_rw Data:ForumDebate d ; arg Data:ForumMessage m ; arg Str freq 
 65    var Str base := f:path+"out/"+freq+generate_id 
 66    var Str subject 
 67    if freq="i" 
 68      if (exists f:subject:(d:subject)) 
 69        subject := f:subject:(d:subject):label+": "+d:title 
 70      else 
 71        subject := title 
 72    eif freq="h" 
 73      subject := f:title+" - hourly report" 
 74    eif freq="d" 
 75      subject := f:title+" - daily report" 
 76    eif freq="w" 
 77      subject := f:title+" - weekly report" 
 78    var Str boundary := (repeat "-") 
 79    for (var Int i) 1 (max 128\8\uInt:size 1) 
 80      var uInt rnd ; memory_strong_random addressof:rnd Int:size 
 81      boundary += string rnd "radix 36" 
 82    if freq<>"i" 
 83      var List:Str keys 
 84      each dd f:debate 
 85        var CBool some := false 
 86        each mm dd:message 
 87          if (mm:report search freq -1)=(-1) 
 88            some := true 
 89        if some 
 90          keys += keyof dd 
 91      if not (exists keys:first) 
 92        return 
 93    var DateTime now := datetime 
 94    (var Stream s) open base+".tmp" out+mkdir+safe 
 95    writeline "From: "+f:from 
 96    writeline "Subject: "+subject 
 97    writeline "Date: "+rfc1123_date:now 
 98    writeline "X-Mailer: Pliant forum "+string:pliant_release_number 
 99    writeline "MIME-Version: 1.0" 
 100    writeline "Content-Type: multipart/mixed; boundary=[dq]"+(boundary boundary:len)+"[dq]" 
 101    writeline "" 
 102    writeline "This is a multi-part message in MIME format." 
 103    writeline boundary 
 104    writeline "Content-Type: text/html; charset=iso-8859-1" 
 105    writeline "" 
 106    writeline "<!DOCTYPE HTML PUBLIC [dq]-//W3C//DTD HTML 3.2 Final//EN[dq]>" 
 107    writeline "<html>" 
 108    writeline "<head>" 
 109    writeline "<title>"+html_encode:subject+"</title>" 
 110    writeline "</head>" 
 111    writeline "<body>" 
 112    if freq="i" 
 113      writeline "<table>" 
 114      post_debate s 
 115      post_message s 
 116      writeline "</table>" 
 117    else 
 118      var Pointer:Str :> keys first 
 119      writeline "<p>" 
 120      while exists:k 
 121        var Data:ForumDebate dd :> f:debate k 
 122        if (exists f:subject:(dd:subject)) 
 123          writeline "<i>"+(html_encode f:subject:(dd:subject):label+": ")+"</i>" 
 124        writeline "<a href=[dq]#"+k+"[dq]>"+html_encode:(shunt dd:title<>"" dd:title "no title")+"</a><br>" 
 125        :> keys next k 
 126      writeline "</p>" 
 127      var Pointer:Str :> keys first 
 128      while exists:k 
 129        writeline "<p>" 
 130        writeline "<a name=[dq]"+k+"[dq]></a>" 
 131        writeline "<table>" 
 132        var Int count := 0 
 133        each mm f:debate:k:message 
 134          if (mm:report search freq -1)=(-1) 
 135            count += 1 
 136        post_debate f:debate:count s 
 137        each mm f:debate:k:message 
 138          if (mm:report search freq -1)=(-1) 
 139            post_message mm s 
 140            mm report := mm:report+freq 
 141        writeline "</table>" 
 142        writeline "</p>" 
 143        :> keys next k 
 144    writeline "</body>" 
 145    writeline "</html>" 
 146    writeline boundary+"--" 
 147    writeline "" 
 148    close 
 149    var (Link Database:MailMeta) db :> new Database:MailMeta 
 150    db load base+".pdb" 
 151    var Data:MailMeta meta :> db data 
 152    meta push 
 153    meta queued_on := now 
 154    meta from := from 
 155    each su f:subscriber 
 156      if su:frequency=freq 
 157        meta:target create keyof:su 
 158        meta:target:(keyof su) box := su mailbox 
 159    db store 
 160    file_move base+".tmp" base+".mail" 
 161    if freq="i" 
 162      forward_mail base+".mail" true "forward a just posted forum message" 
 163   
 164  function forward_forum 
 165    daemon "forum mailer daemon" 
 166      while not daemon_emergency 
 167        daemon_sleep 3600 
 168        if not daemon_emergency 
 169          var DateTime now := datetime 
 170          each forum_database:data:forum 
 171            if now:seconds-f:last_hourly_report:seconds>=3600 
 172              post_message f (var Data:ForumDebate no_debate) (var Data:ForumMessage no_message) "h" 
 173              last_hourly_report := now 
 174            if now:seconds-f:last_daily_report:seconds>=86400 
 175              post_message f (var Data:ForumDebate no_debate) (var Data:ForumMessage no_message) "d" 
 176              last_daily_report := now 
 177            if now:seconds-f:last_weekly_report:seconds>=7*86400 
 178              post_message f (var Data:ForumDebate no_debate) (var Data:ForumMessage no_message) "w" 
 179              last_weekly_report := now 
 180            var Array:FileInfo files := file_list f:path+"out/" standard   
 181            for (var Int i) files:size-1 
 182              if files:i:extension=".mail" 
 183                if not daemon_emergency 
 184                  forward_mail files:i:name 
 185  forward_forum 
 186   
 187   
 188 
 
 189  #  display patches 
 190   
 191   
 192  method page browse_directory f d patch path options 
 193    arg_rw HtmlPage page ; arg_rw Data:Forum f ; arg_rw Data:ForumDebate d ; arg CBool patch ; arg Str path options 
 194    implicit page 
 195      title "Browse patch '"+d:title+"'" 
 196      if options="delete" and patch 
 197        [Are you sure that you want to delete directory] ; fixed:(text " "+path) ; eol 
 198        button "yes" noeol 
 199          file_tree_delete (forum_path "/patch"+path) 
 200          goto_backward 
 201        button "no" 
 202          goto_backward 
 203      eif options="list" 
 204        var Array:FileInfo files := file_list (forum_path "/patch"+path) standard+relative+directories 
 205        for (var Int i) files:size-1 
 206          file_header path+files:i:name (var FileInfo old_info) (var FileInfo new_info) (var CBool binary) (var Int lines) 
 207          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]" 
 208      else 
 209        table columns 2 border 0 
 210          cell [Path:] 
 211          cell fixed:(text path) 
 212        var Array:FileInfo patches := file_list (forum_path "/patch"+path) standard+relative+directories 
 213        if patches:size=0 
 214          head "<meta name=[dq]robots[dq] content=[dq]noindex,nofollow[dq]>[lf]" 
 215        var (Index Str FileInfo) sorted 
 216        for (var Int i) patches:size-1 
 217          if not patches:i:is_directory 
 218            file_header (forum_path "/patch"+path)+patches:i:name (var FileInfo old_info) (var FileInfo new_info) (var CBool binary) (var Int lines) 
 219            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]" 
 220            patches:i:size := new_info size 
 221            patches:i:datetime := new_info datetime 
 222            patches:i:options += " changed_lines "+string:lines 
 223          else 
 224            html "<pfile name=[dq]"+(html_encode patches:i:name)+"[dq] size=[dq]?[dq] date=[dq]?[dq] options=[dq][dq] />[lf]" 
 225            patches:i:options += " patched_directory" 
 226          sorted insert patches:i:name patches: 
 227        var Array:FileInfo files := file_list f:reference_path+(path path:len) standard+relative+directories 
 228        for (var Int i) files:size-1 
 229          if not exists:(sorted first files:i:name) 
 230            sorted insert files:i:name files:i    
 231        table columns 4 
 232          cell header 
 233            bold [name] 
 234          cell header 
 235            bold [size] 
 236          cell header 
 237            bold [date ] 
 238            note "*" 
 239              title "Pliant date format" 
 240              [The date is displayed using] ; fixed [ ] ; italic [year] ; [/] ; italic [month] ; [/] ; italic [day] ; [ ] ; italic [hour] ; [:] ; italic [minute] ; [:] ; italic [second] ; fixed [ ] ; [format.] 
 241          cell header 
 242            void 
 243          var Pointer:FileInfo file :> sorted first 
 244          while exists:file 
 245            if file:is_directory 
 246              if (file:options option "patched_directory") 
 247                cell color (color hsl 60 30 80) 
 248                  bold 
 249                    link file:name file:name options "browse" 
 250              else 
 251                cell 
 252                  bold 
 253                    link file:name file:name options "browse" 
 254              cell void ; cell void 
 255              cell 
 256                small 
 257                  if (file_list path+file:name standard+directories):size=and patch 
 258                    link "delete" file:name options "delete" 
 259            else 
 260              if (file:options option "changed_lines") 
 261                cell color (color hsl 60 30 80) 
 262                  text file:name 
 263              else 
 264                cell 
 265                  text file:name 
 266              cell 
 267                text (string file:size) 
 268              cell 
 269                text (string file:datetime) 
 270              cell 
 271                small 
 272                  var Str mime := query_mime_type file:extension 
 273                  if not (mime parse "binary/" any) and not (mime parse "image/" any) 
 274                    link "view" file:name no_extension options "view" ; fixed [ ] 
 275                    if patch 
 276                      link "edit" file:name no_extension options "edit" ; fixed [ ] 
 277                  link "download" file:name no_extension options "download" ; fixed [ ]  
 278                  if patch 
 279                    link "delete" file:name no_extension options "delete" 
 280            file :> sorted next file 
 281        if patch 
 282          file_upload "" (var Str filename) noeol 
 283          button "Upload" 
 284            if (file_query filename standard)=defined 
 285              var Str remote := filename option "remote_name" Str 
 286              if remote<>"" 
 287                file_difference f:reference_path+(path path:len)+remote filename (forum_path "/patch"+path)+remote 
 288                file_hook (forum_path "/patch"+path)+remote 
 289                status := " " 
 290                update (forum_path "/") 
 291                reload_page 
 292              else 
 293                [I have not received the file name !] 
 294            else 
 295              [I have not received the file !] 
 296              para 
 297                [The explaination might be that your browser does not support uploading because it cannot send multipart forms.] ; eol 
 298                [If you wonder what browsers supports uploading, then all I can tel you is that Nestcape 4 and Mozilla do.] 
 299          input "" (var Str filename2) noeol 
 300          button "Create file" noeol 
 301            (var Stream s) open (forum_path "/patch"+path)+filename2 out+safe+mkdir ; close 
 302            reload_page 
 303          button "Create directory" 
 304            file_tree_create (forum_path "/patch"+path)+filename2+"/" 
 305            reload_page 
 306        para 
 307          link "Browse the main tree" "/pliant/browse/file"+path 
 308        para 
 309          [Yellow cells indicate that the file is modifyed in this patch, or the directory contains files modifyed in this patch.] 
 310   
 311   
 312  method page browse_file f d patch path options 
 313    arg_rw HtmlPage page ; arg_rw Data:Forum f ; arg CBool patch ; arg_rw Data:ForumDebate d ; arg Str path options 
 314    var CBool patched := (file_query (forum_path "/patch"+path) standard)=defined 
 315    if patched 
 316      file_header (forum_path "/patch"+path) (var FileInfo old_info) (var FileInfo new_info) (var CBool binary) (var Int lines) 
 317    implicit page 
 318      if (options option "view"or (options option "review"and not binary 
 319        var Str section := (shunt (options option "rejected""/rejected" "/patch") 
 320        patched := (file_query (forum_path section+path) standard)=defined 
 321        table columns 1 border 0 
 322          cell color (color hsl 0 0 90) 
 323            table columns 2 border 0 
 324              cell [Patch title:] 
 325              cell 
 326                text d:title 
 327              cell [Abstract:] 
 328              cell 
 329                table columns 1 
 330                  cell color (color hsl 60 10 80) 
 331                    text d:abstract 
 332              cell [File:] 
 333              cell 
 334                bold 
 335                  fixed text:path 
 336              cell [Key:] 
 337              cell 
 338                table columns 2 border 0 
 339                  cell color (color hsl 0 25 80) 
 340                    fixed [   ] 
 341                  cell 
 342                    [Removed line] 
 343                  cell color (color hsl 120 25 80) 
 344                    fixed [   ] 
 345                  cell 
 346                    [Added line] 
 347        if patched 
 348          display_difference (forum_path section+path) (shunt f:live_path<>"" f:live_path f:reference_path)+path patch section path options 
 349        else 
 350          head "<meta name=[dq]robots[dq] content=[dq]noindex,nofollow[dq]>[lf]" 
 351          fixed 
 352            (var Stream s0) open f:reference_path+(path path:len) in+safe 
 353            while not s0:atend 
 354              text s0:readline+"[lf]" 
 355      eif options="edit" and patch 
 356        if (patched and not binary) or file_is_ascii:path 
 357          small 
 358            bold text:path 
 359            fixed [     ] 
 360            if not patched 
 361              new_info := file_query path standard 
 362              text (string new_info:size)+" bytes last modifyed on "+(string new_info:datetime) 
 363            eol 
 364          var Stream s1 
 365          if patched 
 366            var Str temp := file_temporary 
 367            file_extract_new (forum_path "/patch"+path) temp 
 368            s1 open temp in+safe 
 369          else 
 370            s1 open f:reference_path+(path path:len) in+safe 
 371          var Str all := "" 
 372          while not s1:atend 
 373            all += s1:readline+"[lf]" 
 374          if patched 
 375            file_delete temp 
 376          text_input "" all columns 80 rows 35 
 377          button "Update "+(path (path search_last "/" -1)+path:len) 
 378            var Str final := file_temporary 
 379            (var Stream s2) open final out+safe+mkdir 
 380            s2 writechars all 
 381            s2 close 
 382            if (file_query (forum_path "/patch"+path) standard)=defined 
 383              var Str temp := file_temporary 
 384              file_extract_old (forum_path "/patch"+path) temp 
 385              file_difference temp final (forum_path "/patch"+path) 
 386              file_delete temp 
 387            else 
 388              file_difference f:reference_path+(path path:len) final (forum_path "/patch"+path) 
 389            file_hook (forum_path "/patch"+path)  
 390            file_delete final 
 391            status := " " 
 392            update (forum_path "/") 
 393            goto_backward 
 394        else 
 395          [This is a binary file !] 
 396      eif options="download" 
 397        if patched 
 398          var Str temp := file_temporary 
 399          file_extract_new (forum_path "/patch"+path) temp 
 400        reset_http_answer 
 401        http_request send_static_file (shunt patched temp f:reference_path+(path path:len)) "mime [dq]binary/*[dq]" 
 402        if patched 
 403          file_delete temp 
 404      eif options="delete" and patch 
 405        [Are you sure that you want to delete file] ; fixed:(text " "+path+" " ) ; [in patch '] ; text d:title ; ['] ; eol 
 406        button "yes" noeol 
 407          file_delete (forum_path "/patch"+path) 
 408          file_hook (forum_path "/patch"+path) 
 409          goto_backward 
 410        button "no" 
 411          goto_backward 
 412      else 
 413        if patched 
 414          var Str temp := file_temporary 
 415          file_extract_new (forum_path "/patch"+path) temp 
 416        var Str ext := forum_path "/patch"+path ; ext := ext (ext search_last "." ext:len) ext:len 
 417        var Str mime := query_mime_type ext 
 418        reset_http_answer 
 419        http_request send_static_file (shunt patched temp f:reference_path+(path path:len)) "mime "+string:mime 
 420        if patched 
 421          file_delete temp 
 422   
 423   
 424   
 425   
 426 
 
 427  #  display forum 
 428   
 429   
 430  method page display f d post maintainer patch options 
 431    arg_rw HtmlPage page ; arg_rw Data:Forum f ; arg_rw Data:ForumDebate d ; arg Bool post maintainer patch ; arg Str options 
 432    implicit page 
 433      html "<title>"+(html_encode f:title)+"</title>[lf]" 
 434      table columns 1 border 0 
 435        cell color (color hsl 60 25 80) 
 436          para 
 437            center (bold (text f:title)) 
 438          if maintainer or (user_name<>"" and user_name=d:maintainer:"creator") 
 439            para 
 440              select "" d:subject noeol 
 441                option "" "" 
 442                each su f:subject sort su:order 
 443                  option su:label keyof:su 
 444              input "" d:title length 60 
 445            text_input "" d:abstract columns 60 rows 8 
 446          else 
 447            para 
 448              if (exists f:subject:(d:subject)) 
 449                italic (text f:subject:(d:subject):label+": ") 
 450              bold (text d:title) 
 451            text d:abstract 
 452        if f:reference_path<>"" and (maintainer or (user_name<>"" and user_name=d:maintainer:"creator")) 
 453          cell color (color hsl 60 20 65) 
 454            each d:maintainer 
 455              text m ; eol 
 456            if patch and (user_name=d:maintainer:"creator" or allowed:"administrator") 
 457              input "Maintainer name: " (var Str name) noeol 
 458              button "Add new maintainer" noeol 
 459                if (exists user:name) 
 460                  var Str key := "m"+(string datetime:seconds) 
 461                  d:maintainer create key 
 462                  d:maintainer key := name 
 463                  reload_page 
 464                else 
 465                  [There is no ] ; fixed text:name ; [ user defined on this site.] 
 466              button "Remove maintainer" 
 467                part remove 
 468                  each d:maintainer 
 469                    if m=name and (keyof:m<>"creator" or allowed:"administrator") 
 470                      d:maintainer delete keyof:m 
 471                      leave remove 
 472                reload_page 
 473        if maintainer 
 474          cell color (color hsl 60 20 65) 
 475            read_only not maintainer 
 476              select "" d:status noeol 
 477                option "" "" 
 478                each st f:status sort st:order 
 479                  option st:label keyof:st 
 480            button "Record changes" 
 481              goto_backward 
 482        if f:reference_path<>"" 
 483          var Array:FileInfo patches := file_list (forum_path "/patch/") standard+recursive+relative 
 484          cell void 
 485          cell 
 486            table columns 2 border 0 
 487              cell 
 488                [Patch] ; fixed { [ ] ; bold (text keyof:d) ; [ ] } ; eol 
 489                if maintainer 
 490                  button "Apply all" 
 491                    title "Apply all the patch" 
 492                    study_patch f:reference_path (forum_path "/patch/""" 
 493                    button "Apply the patch" 
 494                      apply_patch f:reference_path f:live_path (forum_path "/patch/""" (forum_path "/rejected/") 
 495                      each d:patch_section 
 496                        if s:release="" 
 497                          release := string pliant_release_number 
 498                      goto_backward 
 499                  button "Reverse all" 
 500                    title "Reverse all the patch" 
 501                    study_reverse f:reference_path (forum_path "/patch/""" 
 502                    button "Reverse the patch" 
 503                      reverse_patch f:reference_path f:live_path (forum_path "/patch/""" (forum_path "/rejected/") 
 504                      goto_backward 
 505              cell 
 506                table columns 3 
 507                 cell header [Patch section] 
 508                 cell header 
 509                   [Release ] 
 510                   note "*" 
 511                     [The Pliant release in which the patch has been included.] 
 512                 cell void 
 513                 each d:patch_section 
 514                   cell  
 515                     text keyof:s 
 516                   cell 
 517                     read_only not maintainer 
 518                       input "" s:release length 5 
 519                   cell 
 520                     if maintainer 
 521                       button "Apply" noeol 
 522                         title "Apply patch" 
 523                         study_patch f:reference_path (forum_path "/patch/"keyof:s 
 524                         button "Apply the patch" 
 525                           apply_patch f:reference_path f:live_path (forum_path "/patch/"keyof:s (forum_path "/rejected/") 
 526                           if s:release="" 
 527                             release := string pliant_release_number 
 528                           goto_backward 
 529                       button "Reverse" noeol 
 530                         title "Reverse patch" 
 531                         study_reverse f:reference_path (forum_path "/patch/"keyof:s 
 532                         button "Reverse the patch" 
 533                           reverse_patch f:reference_path f:live_path (forum_path "/patch/"keyof:s (forum_path "/rejected/") 
 534                           goto_backward 
 535                 if maintainer 
 536                   cell 
 537                     input "" (var Str section_id) length 12 
 538                   cell void 
 539                   cell 
 540                     button "Create" noeol 
 541                       d:patch_section create section_id 
 542                       reload_page 
 543                     button "Delete" noeol 
 544                       d:patch_section delete section_id 
 545                       reload_page 
 546          cell 
 547            if f:live_path<>"" and maintainer 
 548              button "Include live changes" noeol 
 549                title "Include live changes" 
 550                study_live_changes f:reference_path f:live_path (forum_path "/patch/") 
 551                input "Include only the changes in: " (var Str filter) 
 552                button "Include the changes" 
 553                  catch_live_changes f:reference_path f:live_path filter (forum_path "/patch/") (forum_path "/rejected/") 
 554                  update (forum_path "/") 
 555                  goto_backward 
 556              fixed [  ] 
 557            if (file_query (forum_path "/rejected/") standard)=defined and maintainer 
 558              button "Drop rejected changes" noeol 
 559                title "Drop rejected changes" 
 560                var Array:FileInfo rejected := file_list (forum_path "/rejected/") standard+recursive+relative 
 561                table border 0 columns 3 
 562                  for (var Int i) rejected:size-1 
 563                    file_header (forum_path "/rejected/"+rejected:i:name) (var FileInfo old_info2) (var FileInfo new_info2) (var CBool binary2) (var Int lines2) 
 564                    cell 
 565                      link rejected:i:name rejected:i:name no_extension options "view rejected" 
 566                    cell 
 567                      if binary2 
 568                        text (string new_info2:size)+" byte"+(shunt new_info2:size>"s" "") 
 569                      eif lines2=defined 
 570                        text string:lines2+" modified line"+(shunt lines2>"s" "") 
 571                    cell 
 572                      link "review" rejected:i:name no_extension options "review rejected" 
 573                button "Drop rejected changes" 
 574                  file_tree_delete (forum_path "/rejected/") 
 575                  goto_backward 
 576              fixed [  ] 
 577            if maintainer 
 578              button "Upload to another server" noeol 
 579                title "Upload patch" 
 580                input "Server to upload the patch to: " (var Str server) noeol 
 581                button "Upload" 
 582                  var ExtendedStatus st2 := patch_upload keyof:keyof:server 
 583                  if st2=success 
 584                    goto_backward 
 585                  else 
 586                    [Failed to upload the patch.] ; eol 
 587                    fixed (text st2:message) 
 588          cell 
 589            table border 0 columns 5 
 590              for (var Int i) patches:size-1 
 591                file_header (forum_path "/patch/"+patches:i:name) (var FileInfo old_info) (var FileInfo new_info) (var CBool binary) (var Int lines) (var List:Str sections) 
 592                cell 
 593                  link patches:i:name patches:i:name no_extension options "view" 
 594                cell 
 595                  if (exists sections:first) 
 596                    small 
 597                      var Pointer:Str section :> sections first 
 598                      while exists:section 
 599                        text " "+section 
 600                        section :> sections next section 
 601                cell 
 602                  text (string patches:i:datetime) 
 603                cell 
 604                  if binary 
 605                    text (string new_info:size)+" byte"+(shunt new_info:size>"s" "") 
 606                  eif lines=defined 
 607                    text string:lines+" modified line"+(shunt lines>"s" "") 
 608                cell 
 609                  var Str dir := patches:i:name ; dir := dir 0 (dir search_last "/" -1)+1 
 610                  link "browse" dir options "browse" no_extension 
 611                  fixed [ ] 
 612                  link "review" patches:i:name no_extension options "review" 
 613                  if (file_query (forum_path "/rejected/"+patches:i:name) standard)=defined 
 614                    fixed [ ] 
 615                    link "review rejected changes" patches:i:name no_extension options "review rejected" 
 616          cell 
 617            link "Browse patch files tree" "" options "browse" ; eol 
 618            link "Download the patch" keyof:d+".patch" options "patch_download" 
 619            if patch 
 620              fixed [  ] ; link "Upload the patch" "" options "patch_upload" 
 621            fixed [  ] ; link "Download as a ready to extract .tgz tarball" keyof:d+".tgz" options "tgz_download" 
 622          cell void 
 623        each msg d:message 
 624          cell color (color hsl 60 15 70) 
 625            [Message posted by] ; fixed (text " "+msg:user+" ") ; [on] ; fixed [ ] ; text (string msg:datetime) 
 626          cell color (color hsl 60 10 80) 
 627            if msg:encoding="" 
 628              fixed 
 629                text msg:message 
 630            else 
 631              html msg:message 
 632      if post 
 633        button "Post a new message" 
 634          title "New message" 
 635          if user_name="" 
 636            input "Your name: " (var Str name) 
 637          text_input "" (var Str message) columns 80 rows 20 
 638          select "Message format:" (var Str encoding) 
 639            option "Simple text" "" 
 640            option "HTML" "html" 
 641          button "Preview the message" 
 642            var Str user := shunt user_name<>"" user_name "maybe "+name 
 643            title "Message preview" 
 644            table columns 1 
 645              cell color (color hsl 60 20 65) 
 646                para 
 647                  center (bold (text f:title)) 
 648                para 
 649                  if (exists f:subject:(d:subject)) 
 650                    italic (text f:subject:(d:subject):label+": ") 
 651                  bold (text d:title) 
 652                text d:abstract 
 653              cell color (color hsl 60 15 70) 
 654                [Message posted by] ; fixed (text " "+user+" ") ; [on] ; fixed [ ] ; text string:datetime 
 655              cell color (color hsl 60 10 80) 
 656                if encoding="" 
 657                  fixed 
 658                    text message 
 659                else 
 660                  html message 
 661            button "Post the message" noeol 
 662              var DateTime now := datetime 
 663              var Str id := generate_id 
 664              d:message create id 
 665              var Data:ForumMessage msg2 :> d:message id 
 666              msg2 user := user 
 667              msg2 datetime := now 
 668              msg2 encoding := encoding 
 669              msg2 message := message 
 670              last_author := user 
 671              last_message := now 
 672              post_message msg2 "i" 
 673              goto_backward 2 
 674            button "Edit again" 
 675              page html "<script language=[dq]JavaScript[dq]>[lf]" 
 676              page html "history.go(-2)[lf]" 
 677              page html "</script>[lf]" 
 678      
 679   
 680  method page how_long_ago dt now 
 681    arg_rw HtmlPage page ; arg DateTime dt now 
 682    implicit page 
 683      var Float ago := now:seconds-dt:seconds 
 684      if ago<3600 
 685        var Int := cast ago/60 Int 
 686        text string:u+" mn" 
 687      eif ago<86400 
 688        var Int := cast ago/3600 Int 
 689        text string:u+" hour"+(shunt u>"s" "") 
 690      else 
 691        var Int := cast ago/86400 Int 
 692        text string:u+" day"+(shunt u>"s" "") 
 693   
 694  function archive f d -> dt 
 695    arg Data:Forum f ; arg Data:ForumDebate d ; arg DateTime dt 
 696    var Str status := status 
 697    var Data:ForumStatus st :> f:status status 
 698    dt := timestamp 
 699    dt seconds += st archive_delay 
 700   
 701  method page display f post maintainer options 
 702    arg_rw HtmlPage page ; arg_rw Data:Forum f ; arg CBool post maintainer ; arg Str options 
 703    implicit page 
 704      title f:title 
 705      box border 1 
 706        text f:abstract 
 707      var DateTime now := datetime 
 708      var Str status := options option "status" Str 
 709      var CBool all := options option "all" 
 710      var CBool patches := f:reference_path<>"" 
 711      var Float hue := http_request:style_options option "hue" Float 
 712      if hue=undefined 
 713        hue := 120 
 714      var CBool upgrade := false 
 715      if (options option "detailed") 
 716        table columns 2+(shunt patches 1 0)+(shunt maintainer 1 0) border 0 
 717          cell color (color hsl hue 8 70) [Subject] 
 718          cell color (color hsl hue 8 70) [Messages] 
 719          if patches 
 720            cell color (color hsl hue 8 70) [Files] 
 721          if maintainer 
 722            cell void 
 723          each f:debate filter (status="" or d:status=status) and (all or (archive d)=undefined or (archive d)>now) sort d:timestamp reversed 
 724            cell header 
 725              para 
 726                if (exists f:subject:(d:subject)) 
 727                  italic (text f:subject:(d:subject):label+": ") 
 728                link (shunt d:title<>"" d:title "no title"keyof:d+"/" 
 729              text d:abstract 
 730            cell header 
 731              para 
 732                italic (text (shunt  (exists f:status:(d:status)) f:status:(d:status):label "")) 
 733              var Int := d:message:size 
 734              if n>0 
 735                text string:n+" message"+(shunt n>"s" "") ; eol 
 736                how_long_ago d:last_message now ; eol 
 737                text d:last_author 
 738            if patches 
 739              cell header 
 740                if false # para 
 741                  italic 
 742                    text (shunt d:patch_status="A" "applied" d:patch_status="R" "reversed" "") 
 743                    if d:patch_release<>"" 
 744                      text " in release "+d:patch_release 
 745                var Int := patch_count 
 746                if n>0 
 747                  text string:n+" file"+(shunt n>"s" "") ; eol 
 748                  how_long_ago d:last_patch now 
 749                  each d:maintainer 
 750                    eol ; text m 
 751            if maintainer 
 752              cell 
 753                button "Delete" 
 754                  title "Delete a patch" 
 755                  [Patch title: ] ; fixed (text d:title) ; eol 
 756                  [Patch maintainers:] 
 757                  each d:maintainer 
 758                    fixed (text " "+m) 
 759                  eol 
 760                  button "Do delete it" 
 761                    file_tree_delete (forum_path "/") 
 762                    f:debate delete keyof:d 
 763                    goto_backward 
 764      else 
 765        table columns 5 border 0 
 766          cell header [Subject] 
 767          cell header small:[Messages[lf]count] 
 768          cell header small:[Last post] 
 769          cell header [By] 
 770          cell header small:[Status] 
 771          each f:debate filter (status="" or d:status=status) and (all or (archive d)>now) sort d:timestamp reversed 
 772            cell 
 773              if (exists f:subject:(d:subject)) 
 774                italic (text f:subject:(d:subject):label+": ") 
 775              link (shunt d:title<>"" d:title "no title"keyof:d+"/" 
 776            cell 
 777              text (string d:message:size) 
 778            cell 
 779              if d:last_message=defined 
 780                how_long_ago d:last_message now 
 781            cell 
 782              text d:last_author 
 783            cell 
 784              if (exists f:status:(d:status)) 
 785                small (italic (text f:status:(d:status):label)) 
 786              if d:path<>"" 
 787                upgrade := true 
 788              if false #  d:patch_status<>"" 
 789                eol 
 790                small 
 791                  italic 
 792                    text (shunt d:patch_status="A" "applied" d:patch_status="R" "reversed" "") 
 793                    if d:patch_release<>"" 
 794                      text " "+d:patch_release 
 795      if post 
 796        para 
 797          button "Open a new debate" noeol 
 798            title f:title+": create a new debate" 
 799            if user_name="" 
 800              input "Your name: " (var Str name) 
 801            if f:subject:size>0 
 802              select "Subject: " (var Str subject) 
 803                option "" "" 
 804                each su f:subject sort su:order 
 805                  option su:label keyof:su 
 806            input "Title: " (var Str title) length 60 
 807            para 
 808              text_input "Abstract: " (var Str abstract) columns 60 rows 8 
 809              italic [The abstract is always in simple text format (ASCII)] 
 810            para 
 811              [Initial message: ] ; eol 
 812              text_input "" (var Str message) columns 80 rows 20 
 813              select "Message format:" (var Str encoding) 
 814                option "Simple text" "" 
 815                option "HTML" "html" 
 816            button "Preview the new debate" 
 817              var Str user := shunt user_name<>"" user_name "maybe "+name 
 818              title "Message preview" 
 819              table columns 1 
 820                cell color (color hsl 60 20 65) 
 821                  para 
 822                    center (bold (text f:title)) 
 823                  para 
 824                    if (exists f:subject:subject) 
 825                      italic (text f:subject:subject:label+": ") 
 826                    bold text:title 
 827                  text abstract 
 828                cell color (color hsl 60 15 70) 
 829                  [Message posted by] ; fixed (text " "+user+" ") ; [on] ; fixed [ ] ; text string:datetime 
 830                cell color (color hsl 60 10 80) 
 831                  if encoding="" 
 832                    fixed 
 833                      text message 
 834                  else 
 835                    html message 
 836              button "Post it now" noeol 
 837                var Str id := generate_id 
 838                f:debate create id 
 839                var Data:ForumDebate d2 :> f:debate id 
 840                var DateTime now := datetime 
 841                d2 subpath := (string now:year)+(right (string now:month) "0")+"/"+(right (string now:day) "0")+"/" 
 842                d2 subject := subject 
 843                d2 title := title 
 844                d2 abstract := abstract 
 845                d2 last_message := now 
 846                d2:maintainer create "creator" 
 847                d2:maintainer "creator" := user_name 
 848                if message<>"" 
 849                  d2:message create id 
 850                  var Data:ForumMessage msg2 :> d2:message id 
 851                  msg2 user := user 
 852                  msg2 datetime := now 
 853                  msg2 encoding := encoding 
 854                  msg2 message := message 
 855                  d2 update (forum_path d2 "/patch/") 
 856                  post_message d2 msg2 "i" 
 857                goto_backward 2 
 858              button "Edit again" 
 859                page html "<script language=[dq]JavaScript[dq]>[lf]" 
 860                page html "history.go(-2)[lf]" 
 861                page html "</script>[lf]" 
 862          if maintainer 
 863            fixed [  ] 
 864            button "Download from another server" noeol 
 865              title "Download patch" 
 866              input "Server: " (var Str server) noeol 
 867              input "Patch: " (var Str patch_id) noeol 
 868              button "Download" 
 869                var ExtendedStatus st := patch_download keyof:patch_id server 
 870                if st=success 
 871                  goto_backward 
 872                else 
 873                  [Failed to download the patch.] ; eol 
 874                  fixed (text st:message) 
 875      if not (options option "detailed") 
 876        para 
 877          link "DETAILED VIEW" "" options options+" detailed" 
 878      para 
 879        if status="" and not all 
 880          each st f:status 
 881            if st:display_all_label<>"" 
 882              link st:display_all_label "" options options+" status "+(string keyof:st)+" all" ; eol 
 883        if not all 
 884          link "display all debates" "" options options+" all" 
 885      if user_name<>"" 
 886        var Str freq := f:subscriber:user_name frequency 
 887        select "I want to receive messages by email " freq noeol 
 888          option "Never" " " 
 889          option "Once a week" "w" 
 890          option "Once a day" "d" 
 891          option "Once every hour" "h" 
 892          option "Immediately" "i" 
 893        var Str mailbox := f:subscriber:user_name mailbox 
 894        if mailbox="" 
 895          mailbox := user:user_name email 
 896        input " at " mailbox noeol 
 897        button "Do it now" 
 898          if freq<>" " and mailbox<>"" 
 899            f:subscriber create user_name 
 900            f:subscriber:user_name mailbox := mailbox 
 901            f:subscriber:user_name frequency := freq 0 
 902          else 
 903            f:subscriber delete user_name 
 904          reload_page 
 905      else 
 906        para 
 907          if not post 
 908            [If you want to open a new debate or subscribe this forum mailing list, ] 
 909          else 
 910            [If you want to subscribe this forum mailing list, ] 
 911          [you should log in, after creating an account if you don't have one already.] ; eol 
 912          execute_dynamic_page "pliant:/pliant/protocol/http/login.html" 
 913      if maintainer 
 914        para 
 915          button "Display subscribers list" noeol 
 916            title "Subscribers to "+f:title 
 917            table columns 3 
 918              cell header [User] 
 919              cell header [Mailbox] 
 920              cell header [Frequency] 
 921              for (var Int lap) 0 3 
 922                each sc f:subscriber 
 923                  if sc:frequency="ihdw":lap 
 924                    cell 
 925                      fixed (text keyof:sc) 
 926                    cell 
 927                      text sc:mailbox 
 928                    cell 
 929                      text (shunt lap="immediatly" lap="hourly" lap="daily" "weekly") 
 930            var Int := f:subscriber:size 
 931            text "There "+(shunt n>"are" "is" )+" " +(shunt n="no" string:n)+" subscriber"+(shunt n>"s" "")+" to "+f:title+"." ; eol 
 932            var Array:FileInfo files := file_list f:path+"out/" standard   
 933            var Int := 0 
 934            for (var Int i) files:size-1 
 935              if files:i:extension=".mail" 
 936                += 1 
 937            text "There "+(shunt n>"are" "is" )+" "+(shunt n="no" string:n)+" mail"+(shunt n>"s" "")+" pending in the forum out queue." 
 938          if upgrade 
 939            button "Move to conforming location" noeol 
 940              path := "data:/pliant/forum/"+keyof:f+"/" 
 941              url := "http://"+computer_fullname+"/pliant/browse/forum/"+keyof:f+"/" 
 942              each d4 f:debate 
 943                if d4:path<>"" 
 944                  var Str old := d4 path 
 945                  d4 path := "" 
 946                  var DateTime now := d4 last_patch 
 947                  if now=undefined 
 948                    now := datetime 
 949                  d4 subpath := (string now:year)+(right (string now:month) "0")+"/"+(right (string now:day) "0")+"/" 
 950                  file_tree_copy old (forum_path d4 "/patch/") 
 951                  file_tree_delete old 
 952              reload_page 
 953          button "Recompute patches informations" 
 954            each d3 f:debate 
 955              d3 update (forum_path d3 "/patch/") 
 956            reload_page 
 957   
 958   
 959 
 
 960  #  dispatch request 
 961   
 962   
 963  method page forum path1 options 
 964    arg_rw HtmlPage page ; arg Str path1 options 
 965    implicit page 
 966      if path1="/" 
 967        title "List of the forums hosted on "+http_request:site_name 
 968        table columns 1 border 0 
 969          each forum_database:data:forum 
 970            if f:site=http_request:site_name and (allowed f:read) 
 971              cell header 
 972                para 
 973                  link f:title keyof:f+"/" 
 974                text f:abstract 
 975      eif (path1 parse "/" any:(var Str id) "/" any:(var Str remain)) 
 976        var Data:Forum :> forum_database:data:forum id 
 977        if exists:and f:site=http_request:site_name and (allowed f:read) 
 978          var Str path := "/"+remain 
 979          var Bool post := allowed f:post 
 980          var Bool maintainer := allowed f:maintainer 
 981          if path="/" 
 982            display post maintainer options 
 983          eif (path parse "/" any:(var Str id) "/" any:(var Str subpath)) 
 984            var Data:ForumDebate :> f:debate id 
 985            if exists:d 
 986              var Bool patch := maintainer 
 987              each d:maintainer 
 988                if user_name=m 
 989                  patch := true 
 990              if subpath="" 
 991                if options="browse" and f:reference_path<>"" 
 992                  browse_directory patch "/" options 
 993                eif options="patch_upload" and f:reference_path<>"" and patch 
 994                  title "Upload the overall patch" 
 995                  file_upload "Your local patch file: " (var Str patchfile) noeol 
 996                  button "Upload" 
 997                    if patchfile<>"" 
 998                      var ExtendedStatus st := patch_unpack patchfile (forum_path "/patch/") 
 999                      update (forum_path "/") 
 1000                      if st=success 
 1001                        goto_backward 
 1002                      else 
 1003                        [Failed to handle the provided file as a Pliant patch file.] ; eol 
 1004                        fixed (text st:message) 
 1005                    else 
 1006                      [I have not received the patch file !] 
 1007                else 
 1008                  display post maintainer patch options 
 1009              eif f:reference_path="" 
 1010                [There are no patches on this forum.] 
 1011              eif options="patch_download" and subpath=keyof:d+".patch" 
 1012                var Str temp := file_temporary 
 1013                patch_pack (forum_path "/patch/"temp 
 1014                reset_http_answer 
 1015                http_request send_static_file temp "mime [dq]binary/*[dq]" 
 1016                file_delete temp 
 1017              eif options="tgz_download" and subpath=keyof:d+".tgz" 
 1018                patch_tgz_download (forum_path "/patch/"f:official_path 
 1019              eif (subpath subpath:len-1)="/" 
 1020                browse_directory patch "/"+subpath options 
 1021              else 
 1022                browse_file patch "/"+subpath options 
 1023            else 
 1024              [There is no] ; fixed (text " "+id+" ") ; [debate on this forum.] 
 1025        eif not exists:f 
 1026          [There is no such forum.] 
 1027        eif not (allowed f:read) 
 1028          [You are not allowed to access this forum.] 
 1029        else 
 1030          text "This forum is hosted on "+f:site 
 1031   
 1032  export '. forum'  
 1033   
 1034   
 1035