modules/thread.pl

   1 # Copyright (C) 2004  Alex Schroeder <alex@emacswiki.org>
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program; if not, write to the
  15 #    Free Software Foundation, Inc.
  16 #    59 Temple Place, Suite 330
  17 #    Boston, MA 02111-1307 USA
  18
  19 $ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/thread.pl">thread.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/Thread_Server_Extension">Thread Server Extension</a></p>';
  20
  21 $Action{getthread} = \&ThreadGet;
  22 $Action{addthread} = \&ThreadAdd;
  23
  24 push(@MyRules, \&ThreadRule);
  25
  26 sub ThreadRule {
  27   if (m/\G(\[\[thread:$FreeLinkPattern\]\])/gcs) {
  28     Dirty($1);
  29     my $oldpos = pos;
  30     ThreadGet($2, 1, 1);
  31     pos = $oldpos;
  32     return '';
  33   }
  34   return undef;
  35 }
  36
  37 sub ThreadGet {
  38   my ($id, $interactive, $inline) = @_;
  39   my ($page, $thread) = ThreadExtract($id);
  40   print GetHttpHeader('text/html') . GetHtmlHeader(Ts('Thread: %s', $id), '') unless $inline;
  41   if (GetParam('interactive', $interactive)) {
  42     $thread = ThreadInteractive($id, $thread);
  43   }
  44   ApplyRules($thread);
  45   print $q->end_html unless $inline;
  46 }
  47
  48 sub ThreadExtract {
  49   my $id = shift;
  50   ReportError(T('ID parameter is missing.'), '400 BAD REQUEST') unless $id;
  51   $page = GetPageContent($id);
  52   ReportError(Ts('Thread %s does not exist.', $id), '404 NOT FOUND') unless $page;
  53   # ignore all the stuff that gets processed anyway
  54   foreach my $tag ('nowiki', 'pre', 'code') {
  55     $page =~ s|<$tag>(.*\n)*?</$tag>||gi;
  56   }
  57   if ($page =~ m/(^|\n)(\*(.+\n)+)/) {
  58     return ($page, $2);
  59   } else {
  60     ReportError(Ts('Page %s does not contain a thread.', $id), '404 NOT FOUND');
  61   }
  62 }
  63
  64 sub ThreadInteractive {
  65   my ($id, $thread) = @_;
  66   my @items = split(/(^|\n)(\*+)/, $thread);
  67   my $result;
  68   while (@items) {
  69     my $level;
  70     while (@items and substr($level, 0, 1) ne '*') {
  71       $level = shift(@items);
  72     }
  73     my $rest = shift(@items);
  74     if ($rest =~ m/\[$UrlPattern\s+([^\]]+?)\]/) {
  75       my $url = UrlEncode($1);
  76       my $add = T('Add');
  77       my $link = "[$ScriptName?action=addthread;id=$id;url=$url $add]";
  78       $result .= $level . ' '. $link . ' ' . $rest . "\n";
  79     }
  80   }
  81   ReportError('Unable to parse thread', '500 INTERNAL SERVER ERROR') unless $result;
  82   return $result;
  83 }
  84
  85 sub ThreadAdd {
  86   my $id = shift;
  87   ReportError(T('ID parameter is missing.'), '400 BAD REQUEST') unless $id;
  88   my $url = GetParam('url', '');
  89   ReportError(T('URL parameter is missing.'), '400 BAD REQUEST') unless $url;
  90   if (not (GetParam('new', '')) or not(GetParam('name', ''))) {
  91     print GetHeader('', Ts('Add to %s thread', $id), '');
  92     print $q->div({-class=>'thread'}, '<p>'
  93                   . GetFormStart(0, 1)
  94                   . GetHiddenValue('action', 'addthread')
  95                   . GetHiddenValue('id', $id)
  96                   . '<table><tr><td>'
  97                   . T('Below:')
  98                   . '</td><td>'
  99                   . $q->textfield(-name=>'url', -value=>$url,
 100                                   -size=>100, -maxlength=>500)
 101                   . '</td></tr><tr><td>'
 102                   . T('URL:')
 103                   . '</td><td>'
 104                   . $q->textfield(-name=>'new',
 105                                   -size=>100, -maxlength=>500)
 106                   . '</td></tr><tr><td>'
 107                   . T('Name:')
 108                   . '</td><td>'
 109                   . $q->textfield(-name=>'name',
 110                                   -size=>50, -maxlength=>100)
 111                   . '</td></tr></table>'
 112                   . '<p>'
 113                   . $q->p($q->submit(-name=>'Save', -value=>T('Save')))
 114                   . $q->endform());
 115     print $q->end_html;
 116   } else {
 117     my ($page, $thread) = ThreadExtract($id);
 118     my $new = GetParam('new', '');
 119     my $name = GetParam('name', '');
 120     my @items = split(/(^|\n)(\*+)/, $thread);
 121     my $result;
 122     while (@items) {
 123       my $level;
 124       while (@items and substr($level, 0, 1) ne '*') {
 125         $level = shift(@items);
 126       }
 127       my $rest = shift(@items);
 128       $rest =~ s/\s+$//;
 129       if ($rest =~ m/\[$UrlPattern\s+([^\]]+?)\]/) {
 130         my $current = $1;
 131         $result .= $level . $rest . "\n";
 132         if ($current eq $url) {
 133           $result .= $level . "* [$new $name]\n";
 134         }
 135       }
 136     }
 137     # print GetHttpHeader('text/html', $Now) . GetHtmlHeader(Ts('Thread: %s', $id), '');
 138     # ApplyRules($result);
 139     # print $q->pre($new . "\n" . $result);
 140     # print $q->end_html;
 141     $thread = quotemeta($thread);
 142     $page =~ s/$thread/$result/;
 143     SetParam('text', $page);
 144     DoPost($id);
 145   }
 146 }