plugins/form/bbs.wp2

#?SuikaWikiConfig/2.0

Plugin:
  @Name: WikiFormBBS
  @FullName:
    WikiForm: BBS Features Support
  @Description:
    @@@:
      WikiFormBBS WikiPlugin module implements some features well-supported
      in Web BBS systems, such as "sage", "ID", and so on.
    @@lang: en
  @License: %%Perl%%
  @Author[list]:
     Wakaba <w@suika.fam.cx>
  @Date.RCS:
    $Date: 2004/02/01 12:08:07 $
  @RequiredModule[list]:
    Digest::MD5
  @RequiredPlugin[list]:
    WikiFormCore
  @Use:
    require Digest::MD5;
    my $WIKIRESOURCE;

PluginConst:
  @NS_XHTML1:
    http://www.w3.org/1999/xhtml
  @WIKIRESOURCE:
    {($WIKIRESOURCE ||= SuikaWiki::Plugin->module_package ('WikiResource'))}


FormattingRule:
  @Category[list]: form-template
  @Name: bbs--check-sage
  @Description:
    @@@:
      Check whether "sage" is in input and disable updating Last-Modified
      date-time feature if it is.
    @@lang: en
  @Parameter:
    @@Name: source
    @@Type: ID
    @@Default: "mail"
    @@Description:
      @@@@: Input field name
      @@@lang: en
  @After:
    my $name = $o->{wiki}->{input}->parameter
                                      ('wikiform__'.($p->{source} || 'mail'));
    if ($name =~ /sage/) {
      $o->{form}->{output}->{bbs__sage} = 1;
    }

FormattingRule:
  @Category[list]:
    form-template
  @Name: bbs--2ch-id
  @Description:
    @@@:
      This rule inserts 2ch style "ID" string.  Note that ID generating
      algorithm implemented by this rule is not exact same as one implemented
      by 2ch or other "ID" implementing BBSes.
    @@lang: en
  @Parameter:
    @@Name: name
    @@Type: string
    @@Default: (auto)
    @@Description:
      @@@@:
        Board name (aka bbskey).  If missing, defaulted to current WikiName.
      @@@lang: en
  @Parameter:
    @@Name: sage
    @@Type: ID
    @@Default: (none)
    @@Description:
      @@@@:
        WikiForm field name in which "sage" check is done.  If missing,
        hiding IDs by "sage" is not allowed.
      @@@lang: en 
  @After:
    if ($p->{sage}) {
      if ($o->{wiki}->{input}->parameter ('wikiform__'.$p->{sage}) =~ /sage/) {
        $p->{-result} .= '???';
        return;
      }
    }
    my $name = $p->{name} || $o->{wiki}->{var}->{page}
                               ->stringify (wiki => $o->{wiki});
    my @time = gmtime;
    my $rand = substr sprintf ('%02d%02d%04d%02d%02d%04d', @time[3,4,5,3,4,5]),
                      0, 16;
    my $host = $o->{wiki}->{input} ? 
               $o->{wiki}->{input}->meta_variable ('REMOTE_HOST') ||
               $o->{wiki}->{input}->meta_variable ('REMOTE_ADDR') :
               'unknown.invalid';
    my $md5 = new Digest::MD5;
    $md5->add (substr Digest::MD5::md5_hex ($host), -4);
    $md5->add ($name);
    $md5->add ($time[3]);
    $md5->add ($rand);
    $p->{-result} .= substr $md5->b64digest, 0, 8;

FormattingRule:
  @Category[list]:
    form-template
  @Name: bbs--2ch-trip
  @Description:
    @@@:
      Inserts 2ch style trip.  Note that algorithm generating trip
      is not exact same as that of 2ch.  Only basic latin alphabets
      should be used for compatibility.
    @@lang: en
  @Parameter:
    @@Name: source
    @@Type: ID
    @@Default: (required)
    @@Description:
      @@@@: WikiForm field in which trip key is inputed
      @@@lang: en
  @After:
    my $key = $o->{wiki}->{input}->parameter ('wikiform__'.$p->{source});
    $p->{-result} .= __FUNCPACK__->key2trip (key => $key);

FormattingRule:
  @Category[list]:
    form-template
  @Name: bbs--2ch-name
  @Description:
    @@@:
      Inserting "name" with SuikaWiki/0.9 emphasis and link,
      as well as 2ch style trip and fusianasan.
    @@lang: en
  @Parameter:
    @@Name: source
    @@Type: ID
    @@Default: "name"
    @@Description:
      @@@@: Input field name
      @@@lang: en
  @After:
    my $name = $o->{wiki}->{input}->parameter
                                      ('wikiform__'.($p->{source} || 'name'));

    my $trip;
    if ($name =~ s/\#(.*)$//g) {
      $trip = __FUNCPACK__->key2trip (key => $1);
    }

    if ($name =~ /fusianasan/) {
      my $host = $o->{wiki}->{input}->meta_variable ('REMOTE_HOST') ||
                 $o->{wiki}->{input}->meta_variable ('REMOTE_ADDR') ||
                 'unknown.invalid';
      $name =~ s/fusianasan/$host/g;
    }
    
    unless (length $name) {
      WHOLETREE:
      for (@{$o->{var}->{sw09__document_tree}->child_nodes}) {
        if ($_->node_type eq '#element' and $_->local_name eq 'head') {
          for (@{$_->child_nodes}) {
            if ($_->node_type eq '#element' and $_->local_name eq 'parameter') {
              if ($_->get_attribute_value ('name', default => '') eq
                  'default-name') {
                for (@{$_->child_nodes}) {
                  if ($_->node_type eq '#element' and
                      $_->local_name eq 'value') {
                    $name = $_->inner_text;
                    last WHOLETREE;
                  }
                }
                last WHOLETREE;
              }
            }
          }
        }
      }
    }
    unless (length $name) {
      $name = $WIKIRESOURCE->get (name => 'WikiForm:WikiComment:DefaultName',
                                  o => $o, wiki => $o->{wiki});
    }

 ## TODO: replace star and diamond
    if ($name =~ />>\d/ or $name =~ /^\d+$/) {
      $p->{-result} .= $name;
    } else {
      $p->{-result} .= "[[$name]]";
    }
    
    $p->{-result} .= ' #' . $trip if $trip;
    

Function:
  @Name: key2trip
  @Main:
    my (undef, %opt) = @_;
    my $salt = substr substr ($opt{key}, 1, 2) . 'H.', 0, 2;
    $salt =~ tr/:;<=>?\@[\\]^_`/ABCDEFGabcdefg/;
    $salt =~ s{[^./0-9A-Za-z]}{.}g;
    return substr crypt ($opt{key}, $salt), -10;


1	wakaba	1.1	#?SuikaWikiConfig/2.0
2
3			Plugin:
4			@Name: WikiFormBBS
5			@FullName:
6			WikiForm: BBS Features Support
7			@Description:
8			@@@:
9			WikiFormBBS WikiPlugin module implements some features well-supported
10			in Web BBS systems, such as "sage", "ID", and so on.
11			@@lang: en
12			@License: %%Perl%%
13			@Author[list]:
14			Wakaba <w@suika.fam.cx>
15			@Date.RCS:
16			$Date: 2004/02/01 12:08:07 $
17			@RequiredModule[list]:
18			Digest::MD5
19			@RequiredPlugin[list]:
20			WikiFormCore
21			@Use:
22			require Digest::MD5;
23			my $WIKIRESOURCE;
24
25			PluginConst:
26			@NS_XHTML1:
27			http://www.w3.org/1999/xhtml
28			@WIKIRESOURCE:
29			{($WIKIRESOURCE \|\|= SuikaWiki::Plugin->module_package ('WikiResource'))}
30
31
32			FormattingRule:
33			@Category[list]: form-template
34			@Name: bbs--check-sage
35			@Description:
36			@@@:
37			Check whether "sage" is in input and disable updating Last-Modified
38			date-time feature if it is.
39			@@lang: en
40			@Parameter:
41			@@Name: source
42			@@Type: ID
43			@@Default: "mail"
44			@@Description:
45			@@@@: Input field name
46			@@@lang: en
47			@After:
48			my $name = $o->{wiki}->{input}->parameter
49			('wikiform__'.($p->{source} \|\| 'mail'));
50			if ($name =~ /sage/) {
51			$o->{form}->{output}->{bbs__sage} = 1;
52			}
53
54			FormattingRule:
55			@Category[list]:
56			form-template
57			@Name: bbs--2ch-id
58			@Description:
59			@@@:
60			This rule inserts 2ch style "ID" string. Note that ID generating
61			algorithm implemented by this rule is not exact same as one implemented
62			by 2ch or other "ID" implementing BBSes.
63			@@lang: en
64			@Parameter:
65			@@Name: name
66			@@Type: string
67			@@Default: (auto)
68			@@Description:
69			@@@@:
70			Board name (aka bbskey). If missing, defaulted to current WikiName.
71			@@@lang: en
72			@Parameter:
73			@@Name: sage
74			@@Type: ID
75			@@Default: (none)
76			@@Description:
77			@@@@:
78			WikiForm field name in which "sage" check is done. If missing,
79			hiding IDs by "sage" is not allowed.
80			@@@lang: en
81			@After:
82			if ($p->{sage}) {
83			if ($o->{wiki}->{input}->parameter ('wikiform__'.$p->{sage}) =~ /sage/) {
84			$p->{-result} .= '???';
85			return;
86			}
87			}
88			my $name = $p->{name} \|\| $o->{wiki}->{var}->{page}
89			->stringify (wiki => $o->{wiki});
90			my @time = gmtime;
91			my $rand = substr sprintf ('%02d%02d%04d%02d%02d%04d', @time[3,4,5,3,4,5]),
92			0, 16;
93			my $host = $o->{wiki}->{input} ?
94			$o->{wiki}->{input}->meta_variable ('REMOTE_HOST') \|\|
95			$o->{wiki}->{input}->meta_variable ('REMOTE_ADDR') :
96			'unknown.invalid';
97			my $md5 = new Digest::MD5;
98			$md5->add (substr Digest::MD5::md5_hex ($host), -4);
99			$md5->add ($name);
100			$md5->add ($time[3]);
101			$md5->add ($rand);
102			$p->{-result} .= substr $md5->b64digest, 0, 8;
103
104			FormattingRule:
105			@Category[list]:
106			form-template
107			@Name: bbs--2ch-trip
108			@Description:
109			@@@:
110			Inserts 2ch style trip. Note that algorithm generating trip
111			is not exact same as that of 2ch. Only basic latin alphabets
112			should be used for compatibility.
113			@@lang: en
114			@Parameter:
115			@@Name: source
116			@@Type: ID
117			@@Default: (required)
118			@@Description:
119			@@@@: WikiForm field in which trip key is inputed
120			@@@lang: en
121			@After:
122			my $key = $o->{wiki}->{input}->parameter ('wikiform__'.$p->{source});
123			$p->{-result} .= __FUNCPACK__->key2trip (key => $key);
124
125			FormattingRule:
126			@Category[list]:
127			form-template
128			@Name: bbs--2ch-name
129			@Description:
130			@@@:
131			Inserting "name" with SuikaWiki/0.9 emphasis and link,
132			as well as 2ch style trip and fusianasan.
133			@@lang: en
134			@Parameter:
135			@@Name: source
136			@@Type: ID
137			@@Default: "name"
138			@@Description:
139			@@@@: Input field name
140			@@@lang: en
141			@After:
142			my $name = $o->{wiki}->{input}->parameter
143			('wikiform__'.($p->{source} \|\| 'name'));
144
145			my $trip;
146			if ($name =~ s/\#(.*)$//g) {
147			$trip = __FUNCPACK__->key2trip (key => $1);
148			}
149
150			if ($name =~ /fusianasan/) {
151			my $host = $o->{wiki}->{input}->meta_variable ('REMOTE_HOST') \|\|
152			$o->{wiki}->{input}->meta_variable ('REMOTE_ADDR') \|\|
153			'unknown.invalid';
154			$name =~ s/fusianasan/$host/g;
155			}
156
157			unless (length $name) {
158			WHOLETREE:
159			for (@{$o->{var}->{sw09__document_tree}->child_nodes}) {
160			if ($_->node_type eq '#element' and $_->local_name eq 'head') {
161			for (@{$_->child_nodes}) {
162			if ($_->node_type eq '#element' and $_->local_name eq 'parameter') {
163			if ($_->get_attribute_value ('name', default => '') eq
164			'default-name') {
165			for (@{$_->child_nodes}) {
166			if ($_->node_type eq '#element' and
167			$_->local_name eq 'value') {
168			$name = $_->inner_text;
169			last WHOLETREE;
170			}
171			}
172			last WHOLETREE;
173			}
174			}
175			}
176			}
177			}
178			}
179			unless (length $name) {
180			$name = $WIKIRESOURCE->get (name => 'WikiForm:WikiComment:DefaultName',
181			o => $o, wiki => $o->{wiki});
182			}
183
184			## TODO: replace star and diamond
185			if ($name =~ />>\d/ or $name =~ /^\d+$/) {
186			$p->{-result} .= $name;
187			} else {
188			$p->{-result} .= "[[$name]]";
189			}
190
191			$p->{-result} .= ' #' . $trip if $trip;
192
193
194			Function:
195			@Name: key2trip
196			@Main:
197			my (undef, %opt) = @_;
198			my $salt = substr substr ($opt{key}, 1, 2) . 'H.', 0, 2;
199			$salt =~ tr/:;<=>?\@[\\]^_`/ABCDEFGabcdefg/;
200			$salt =~ s{[^./0-9A-Za-z]}{.}g;
201			return substr crypt ($opt{key}, $salt), -10;
202
203