plugins/form/bbs.pm

use strict;
package SuikaWiki::Plugin::Registry;


our %Info;
$Info{q#WikiFormBBS#}->{Name} = q#WikiFormBBS#;
$Info{q#WikiFormBBS#}->{q#Version#} = q#2005.0121.1411#;
$Info{q#WikiFormBBS#}->{q#InterfaceVersion#} = q#2.9.1#;
$Info{q#WikiFormBBS#}->{q#mkpluginVersion#} = q#2.1.21#;
$Info{q#WikiFormBBS#}->{q#module_name#} = q#SuikaWiki::Plugin::plugin::WikiFormBBS1050021141130FgbG#;
$Info{q#WikiFormBBS#}->{q#Date.RCS#} = q#$Date: 2004/03/29 03:00:52 $#;
$Info{q#WikiFormBBS#}->{RequiredPlugin} = [q#WikiFormCore#];
$Info{q#WikiFormBBS#}->{RequiredModule} = [q#Digest::MD5#];
$Info{q#WikiFormBBS#}->{Description} = [[q#WikiFormBBS WikiPlugin module implements some features well-supported
in Web BBS systems, such as "sage", "ID", and so on.#, q#en#, q##]];
$Info{q#WikiFormBBS#}->{License} = [[q#%%Perl%%#, q##, q##]];
$Info{q#WikiFormBBS#}->{Author} = [[[], [q##], [q##]]];
package SuikaWiki::Plugin::plugin::WikiFormBBS1050021141130FgbG;


#line 1 "(WikiPlugin module source bbs.wp2, block Plugin/Use)"
require Digest::MD5;
my $WIKIRESOURCE;
#line 1 "(WikiPlugin module WikiFormBBS, chunk 1)"

$SuikaWiki::Plugin::Rule{form_template}->{bbs__check_sage} = {q#after#, sub {my ($f, $rule_name, $p, $o, %opt) = @_;

#line 1 "(WikiPlugin module source bbs.wp2, block FormattingRule[name()='[q#form-template#]/bbs__check_sage']/After)"
my $name = $o->{wiki}->{input}->parameter
('wikiform__'.($p->{source} || 'mail'));
if ($name =~ /sage/) {
$o->{form}->{output}->{bbs__sage} = 1;
}}, q#Parameter#, {q#source#, {q#Type#, q#ID#, q#Default#, q#"mail"#, q#Description#, [[q#Input field name#, q#en#, q##]]}}, q#Description#, [[q#Check whether "sage" is in input and disable updating Last-Modified
date-time feature if it is.#, q#en#, q##]]}
#line 1 "(WikiPlugin module WikiFormBBS, chunk 2)"
;

$SuikaWiki::Plugin::Rule{form_template}->{bbs__2ch_id} = {q#after#, sub {my ($f, $rule_name, $p, $o, %opt) = @_;

#line 1 "(WikiPlugin module source bbs.wp2, block FormattingRule[name()='[q#form-template#]/bbs__2ch_id']/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;}, q#Parameter#, {q#sage#, {q#Type#, q#ID#, q#Default#, q#(none)#, q#Description#, [[q#WikiForm field name in which "sage" check is done.  If missing,
hiding IDs by "sage" is not allowed.#, q#en #, q##]]}, q#name#, {q#Type#, q#string#, q#Default#, q#(auto)#, q#Description#, [[q#Board name (aka bbskey).  If missing, defaulted to current WikiName.#, q#en#, q##]]}}, q#Description#, [[q#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.#, q#en#, q##]]}
#line 1 "(WikiPlugin module WikiFormBBS, chunk 4)"
;

$SuikaWiki::Plugin::Rule{form_template}->{bbs__2ch_trip} = {q#after#, sub {my ($f, $rule_name, $p, $o, %opt) = @_;

#line 1 "(WikiPlugin module source bbs.wp2, block FormattingRule[name()='[q#form-template#]/bbs__2ch_trip']/After)"
my $key = $o->{wiki}->{input}->parameter ('wikiform__'.$p->{source});
$p->{-result} .= SuikaWiki::Plugin::plugin::WikiFormBBS1050021141130FgbG->key2trip (key => $key);}, q#Parameter#, {q#source#, {q#Type#, q#ID#, q#Default#, q#(required)#, q#Description#, [[q#WikiForm field in which trip key is inputed#, q#en#, q##]]}}, q#Description#, [[q#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.#, q#en#, q##]]}
#line 1 "(WikiPlugin module WikiFormBBS, chunk 6)"
;

$SuikaWiki::Plugin::Rule{form_template}->{bbs__2ch_name} = {q#after#, sub {my ($f, $rule_name, $p, $o, %opt) = @_;

#line 1 "(WikiPlugin module source bbs.wp2, block FormattingRule[name()='[q#form-template#]/bbs__2ch_name']/After)"
my $name = $o->{wiki}->{input}->parameter
('wikiform__'.($p->{source} || 'name'));
my $trip;
if ($name =~ s/\#(.*)$//g) {
$trip = SuikaWiki::Plugin::plugin::WikiFormBBS1050021141130FgbG->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 ||= SuikaWiki::Plugin->module_package ('WikiResource'))->get (name => 'WikiForm:WikiComment:DefaultName',
o => $o, wiki => $o->{wiki});
}
if ($name =~ />>\d/ or $name =~ /^\d+$/) {
$p->{-result} .= $name;
} else {
$p->{-result} .= "[[$name]]";
}
$p->{-result} .= ' #' . $trip if $trip;}, q#Parameter#, {q#source#, {q#Type#, q#ID#, q#Default#, q#"name"#, q#Description#, [[q#Input field name#, q#en#, q##]]}}, q#Description#, [[q#Inserting "name" with SuikaWiki/0.9 emphasis and link,
as well as 2ch style trip and fusianasan.#, q#en#, q##]]}
#line 1 "(WikiPlugin module WikiFormBBS, chunk 8)"
;


sub key2trip {

#line 1 "(WikiPlugin module source bbs.wp2, block 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;
}

#line 1 "(WikiPlugin module WikiFormBBS, chunk 10)"

package SuikaWiki::Plugin::Registry;

$Info{q#WikiFormBBS#}->{provide} = {q#rule#, {q#form_template#, [q#bbs__check_sage#, q#bbs__2ch_id#, q#bbs__2ch_trip#, q#bbs__2ch_name#]}};

1;
1	wakaba	1.1	use strict;
2			package SuikaWiki::Plugin::Registry;
3
4
5			our %Info;
6			$Info{q#WikiFormBBS#}->{Name} = q#WikiFormBBS#;
7	hero	1.1.2.1	$Info{q#WikiFormBBS#}->{q#Version#} = q#2005.0121.1411#;
8	wakaba	1.1	$Info{q#WikiFormBBS#}->{q#InterfaceVersion#} = q#2.9.1#;
9	hero	1.1.2.1	$Info{q#WikiFormBBS#}->{q#mkpluginVersion#} = q#2.1.21#;
10			$Info{q#WikiFormBBS#}->{q#module_name#} = q#SuikaWiki::Plugin::plugin::WikiFormBBS1050021141130FgbG#;
11	wakaba	1.1	$Info{q#WikiFormBBS#}->{q#Date.RCS#} = q#$Date: 2004/03/29 03:00:52 $#;
12			$Info{q#WikiFormBBS#}->{RequiredPlugin} = [q#WikiFormCore#];
13			$Info{q#WikiFormBBS#}->{RequiredModule} = [q#Digest::MD5#];
14			$Info{q#WikiFormBBS#}->{Description} = [[q#WikiFormBBS WikiPlugin module implements some features well-supported
15			in Web BBS systems, such as "sage", "ID", and so on.#, q#en#, q##]];
16			$Info{q#WikiFormBBS#}->{License} = [[q#%%Perl%%#, q##, q##]];
17			$Info{q#WikiFormBBS#}->{Author} = [[[], [q##], [q##]]];
18	hero	1.1.2.1	package SuikaWiki::Plugin::plugin::WikiFormBBS1050021141130FgbG;
19	wakaba	1.1
20
21			#line 1 "(WikiPlugin module source bbs.wp2, block Plugin/Use)"
22			require Digest::MD5;
23			my $WIKIRESOURCE;
24			#line 1 "(WikiPlugin module WikiFormBBS, chunk 1)"
25
26			$SuikaWiki::Plugin::Rule{form_template}->{bbs__check_sage} = {q#after#, sub {my ($f, $rule_name, $p, $o, %opt) = @_;
27
28			#line 1 "(WikiPlugin module source bbs.wp2, block FormattingRule[name()='[q#form-template#]/bbs__check_sage']/After)"
29			my $name = $o->{wiki}->{input}->parameter
30			('wikiform__'.($p->{source} \|\| 'mail'));
31			if ($name =~ /sage/) {
32			$o->{form}->{output}->{bbs__sage} = 1;
33			}}, q#Parameter#, {q#source#, {q#Type#, q#ID#, q#Default#, q#"mail"#, q#Description#, [[q#Input field name#, q#en#, q##]]}}, q#Description#, [[q#Check whether "sage" is in input and disable updating Last-Modified
34			date-time feature if it is.#, q#en#, q##]]}
35			#line 1 "(WikiPlugin module WikiFormBBS, chunk 2)"
36			;
37
38			$SuikaWiki::Plugin::Rule{form_template}->{bbs__2ch_id} = {q#after#, sub {my ($f, $rule_name, $p, $o, %opt) = @_;
39
40			#line 1 "(WikiPlugin module source bbs.wp2, block FormattingRule[name()='[q#form-template#]/bbs__2ch_id']/After)"
41			if ($p->{sage}) {
42			if ($o->{wiki}->{input}->parameter ('wikiform__'.$p->{sage}) =~ /sage/) {
43			$p->{-result} .= '???';
44			return;
45			}
46			}
47			my $name = $p->{name} \|\| $o->{wiki}->{var}->{page}
48			->stringify (wiki => $o->{wiki});
49			my @time = gmtime;
50			my $rand = substr sprintf ('%02d%02d%04d%02d%02d%04d', @time[3,4,5,3,4,5]),
51			0, 16;
52			my $host = $o->{wiki}->{input} ?
53			$o->{wiki}->{input}->meta_variable ('REMOTE_HOST') \|\|
54			$o->{wiki}->{input}->meta_variable ('REMOTE_ADDR') :
55			'unknown.invalid';
56			my $md5 = new Digest::MD5;
57			$md5->add (substr Digest::MD5::md5_hex ($host), -4);
58			$md5->add ($name);
59			$md5->add ($time[3]);
60			$md5->add ($rand);
61			$p->{-result} .= substr $md5->b64digest, 0, 8;}, q#Parameter#, {q#sage#, {q#Type#, q#ID#, q#Default#, q#(none)#, q#Description#, [[q#WikiForm field name in which "sage" check is done. If missing,
62			hiding IDs by "sage" is not allowed.#, q#en #, q##]]}, q#name#, {q#Type#, q#string#, q#Default#, q#(auto)#, q#Description#, [[q#Board name (aka bbskey). If missing, defaulted to current WikiName.#, q#en#, q##]]}}, q#Description#, [[q#This rule inserts 2ch style "ID" string. Note that ID generating
63			algorithm implemented by this rule is not exact same as one implemented
64			by 2ch or other "ID" implementing BBSes.#, q#en#, q##]]}
65			#line 1 "(WikiPlugin module WikiFormBBS, chunk 4)"
66			;
67
68			$SuikaWiki::Plugin::Rule{form_template}->{bbs__2ch_trip} = {q#after#, sub {my ($f, $rule_name, $p, $o, %opt) = @_;
69
70			#line 1 "(WikiPlugin module source bbs.wp2, block FormattingRule[name()='[q#form-template#]/bbs__2ch_trip']/After)"
71			my $key = $o->{wiki}->{input}->parameter ('wikiform__'.$p->{source});
72	hero	1.1.2.1	$p->{-result} .= SuikaWiki::Plugin::plugin::WikiFormBBS1050021141130FgbG->key2trip (key => $key);}, q#Parameter#, {q#source#, {q#Type#, q#ID#, q#Default#, q#(required)#, q#Description#, [[q#WikiForm field in which trip key is inputed#, q#en#, q##]]}}, q#Description#, [[q#Inserts 2ch style trip. Note that algorithm generating trip
73	wakaba	1.1	is not exact same as that of 2ch. Only basic latin alphabets
74			should be used for compatibility.#, q#en#, q##]]}
75			#line 1 "(WikiPlugin module WikiFormBBS, chunk 6)"
76			;
77
78			$SuikaWiki::Plugin::Rule{form_template}->{bbs__2ch_name} = {q#after#, sub {my ($f, $rule_name, $p, $o, %opt) = @_;
79
80			#line 1 "(WikiPlugin module source bbs.wp2, block FormattingRule[name()='[q#form-template#]/bbs__2ch_name']/After)"
81			my $name = $o->{wiki}->{input}->parameter
82			('wikiform__'.($p->{source} \|\| 'name'));
83			my $trip;
84			if ($name =~ s/\#(.*)$//g) {
85	hero	1.1.2.1	$trip = SuikaWiki::Plugin::plugin::WikiFormBBS1050021141130FgbG->key2trip (key => $1);
86	wakaba	1.1	}
87			if ($name =~ /fusianasan/) {
88			my $host = $o->{wiki}->{input}->meta_variable ('REMOTE_HOST') \|\|
89			$o->{wiki}->{input}->meta_variable ('REMOTE_ADDR') \|\|
90			'unknown.invalid';
91			$name =~ s/fusianasan/$host/g;
92			}
93			unless (length $name) {
94			WHOLETREE:
95			for (@{$o->{var}->{sw09__document_tree}->child_nodes}) {
96			if ($_->node_type eq '#element' and $_->local_name eq 'head') {
97			for (@{$_->child_nodes}) {
98			if ($_->node_type eq '#element' and $_->local_name eq 'parameter') {
99			if ($_->get_attribute_value ('name', default => '') eq
100			'default-name') {
101			for (@{$_->child_nodes}) {
102			if ($_->node_type eq '#element' and
103			$_->local_name eq 'value') {
104			$name = $_->inner_text;
105			last WHOLETREE;
106			}
107			}
108			last WHOLETREE;
109			}
110			}
111			}
112			}
113			}
114			}
115			unless (length $name) {
116			$name = ($WIKIRESOURCE \|\|= SuikaWiki::Plugin->module_package ('WikiResource'))->get (name => 'WikiForm:WikiComment:DefaultName',
117			o => $o, wiki => $o->{wiki});
118			}
119			if ($name =~ />>\d/ or $name =~ /^\d+$/) {
120			$p->{-result} .= $name;
121			} else {
122			$p->{-result} .= "[[$name]]";
123			}
124			$p->{-result} .= ' #' . $trip if $trip;}, q#Parameter#, {q#source#, {q#Type#, q#ID#, q#Default#, q#"name"#, q#Description#, [[q#Input field name#, q#en#, q##]]}}, q#Description#, [[q#Inserting "name" with SuikaWiki/0.9 emphasis and link,
125			as well as 2ch style trip and fusianasan.#, q#en#, q##]]}
126			#line 1 "(WikiPlugin module WikiFormBBS, chunk 8)"
127			;
128
129
130			sub key2trip {
131
132			#line 1 "(WikiPlugin module source bbs.wp2, block Function[Name='key2trip']/Main)"
133			my (undef, %opt) = @_;
134			my $salt = substr substr ($opt{key}, 1, 2) . 'H.', 0, 2;
135			$salt =~ tr/:;<=>?\@[\\]^_`/ABCDEFGabcdefg/;
136			$salt =~ s{[^./0-9A-Za-z]}{.}g;
137			return substr crypt ($opt{key}, $salt), -10;
138			}
139
140			#line 1 "(WikiPlugin module WikiFormBBS, chunk 10)"
141
142			package SuikaWiki::Plugin::Registry;
143
144			$Info{q#WikiFormBBS#}->{provide} = {q#rule#, {q#form_template#, [q#bbs__check_sage#, q#bbs__2ch_id#, q#bbs__2ch_trip#, q#bbs__2ch_name#]}};
145
146			1;