]> git.p6c8.net - selfforum.git/blob - selfforum-cgi/shared/Posting/Write.pm
copyright holders modified
[selfforum.git] / selfforum-cgi / shared / Posting / Write.pm
1 package Posting::Write;
2
3 ################################################################################
4 # #
5 # File: shared/Posting/Write.pm #
6 # #
7 # Authors: André Malo <nd@o3media.de>, 2001-04-08 #
8 # #
9 # Description: Save a posting #
10 # #
11 ################################################################################
12
13 use strict;
14 use vars qw(%error @EXPORT);
15
16 use Encode::Plain; $Encode::Plain::utf8 = 1;
17 use Encode::Posting;
18 use Lock qw(
19 :WRITE
20 release_file
21 );
22 use Posting::_lib qw(
23 get_message_node
24 get_message_header
25 create_forum_xml_string
26 create_new_thread
27 create_message
28 save_file
29 parse_xml_file
30 KEEP_DELETED
31 );
32
33 use XML::DOM;
34
35 %error = (
36 threadWrite => '1 could not write thread file',
37 forumWrite => '2 could not write forum file',
38 threadFile => '3 could not load thread file',
39 noParent => '4 could not find parent message'
40 );
41
42 ################################################################################
43 #
44 # Export
45 #
46 use base qw(Exporter);
47 @EXPORT = qw(
48 write_new_thread
49 write_reply_posting
50 );
51
52 ### sub write_new_thread ($) ###################################################
53 #
54 # save a posting and update the forum main file
55 #
56 # Params: $param - hashreference
57 # (see doc for details)
58 #
59 # Return: (0 or error, thread-xml, new mid)
60 #
61 sub write_new_thread ($) {
62 my $param = shift;
63 my $thread;
64 my $mid = 'm'.($param -> {lastMessage} + 1);
65 my $tid = 't'.($param -> {lastThread} + 1);
66
67 # define the params needed for a new thread
68 #
69 my $pars = {
70 msg => $mid,
71 ip => $param -> {ip},
72 name => defined $param -> {author} ? $param -> {author} : '',
73 email => defined $param -> {email} ? $param -> {email} : '',
74 home => defined $param -> {homepage} ? $param -> {homepage} : '',
75 image => defined $param -> {image} ? $param -> {image} : '',
76 category => defined $param -> {category} ? $param -> {category} : '',
77 subject => defined $param -> {subject} ? $param -> {subject} : '',
78 body => encoded_body(
79 \($param -> {body}),
80 { quoteChars => $param -> {quoteChars},
81 messages => $param -> {messages},
82 base_uri => $param -> {base_uri}
83 }
84 ),
85 time => $param -> {time},
86 dtd => $param -> {dtd},
87 thread => $tid
88 };
89
90 # create new thread and save it to disk
91 #
92 $thread = create_new_thread ($pars);
93 save_file ($param -> {messagePath}.$tid.'.xml',\($thread -> toString)) or return $error{threadWrite};
94
95 # update forum main file
96 #
97 $param
98 -> {parsedThreads}
99 -> {$param -> {lastThread} + 1} = [
100 { mid => $param -> {lastMessage} + 1,
101 unid => $param -> {uniqueID},
102 name => plain($pars -> {name}),
103 cat => plain($pars -> {category}),
104 subject => plain($pars -> {subject}),
105 time => plain($pars -> {time}),
106 level => 0,
107 }
108 ];
109
110 my $forum = create_forum_xml_string (
111 $param -> {parsedThreads},
112 { dtd => $pars -> {dtd},
113 lastMessage => $mid,
114 lastThread => $tid
115 }
116 );
117
118 save_file ($param -> {forumFile}, $forum) or return $error{forumWrite};
119 release_file ($param -> {messagePath}.$tid.'.xml');
120 return (0, $thread, $mid, $tid);
121 }
122
123 ### sub write_reply_posting ($) ################################################
124 #
125 # save a reply and update the forum main file
126 #
127 # Params: $param - hashreference
128 # (see doc for details)
129 #
130 # Return: (0 or error, thread-xml, new mid)
131 #
132 sub write_reply_posting ($) {
133 my $param = shift;
134 my $thread;
135 my $mid = 'm'.($param -> {lastMessage} + 1);
136 my $tid = 't'.($param -> {thread});
137
138 my $tfile = $param -> {messagePath}.$tid.'.xml';
139
140 unless (write_lock_file ($tfile)) {
141 violent_unlock_file ($tfile);
142 return $error{threadFile};
143 }
144
145 else {
146 my $xml = parse_xml_file ($tfile);
147
148 unless ($xml) {
149 violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
150 return $error{threadFile};
151 }
152
153 my $mnode = get_message_node ($xml, $tid, 'm'.$param -> {parentMessage});
154
155 unless (defined $mnode) {
156 violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
157 return $error{noParent};
158 }
159
160 my $pars = {
161 msg => $mid,
162 ip => $param -> {ip},
163 name => defined $param -> {author} ? $param -> {author} :'',
164 email => defined $param -> {email} ? $param -> {email} :'',
165 home => defined $param -> {homepage} ? $param -> {homepage} :'',
166 image => defined $param -> {image} ? $param -> {image} :'',
167 category => defined $param -> {category} ? $param -> {category} :'',
168 subject => defined $param -> {subject} ? $param -> {subject} :'',
169 time => $param -> {time},
170 };
171
172 my $message = create_message ($xml, $pars);
173
174 $mnode -> appendChild ($message);
175
176 my $mcontent = $xml -> createElement ('MessageContent');
177 $mcontent -> setAttribute ('mid' => $mid);
178 $mcontent -> appendChild (
179 $xml -> createCDATASection (
180 ${encoded_body(
181 \($param -> {body}),
182 { quoteChars => $param -> {quoteChars},
183 messages => $param -> {messages},
184 base_uri => $param -> {base_uri}
185 }
186 )}
187 )
188 );
189
190 my $content = $xml -> getElementsByTagName ('ContentList', 1) -> item (0);
191 $content -> appendChild ($mcontent);
192
193 # save thread file
194 #
195 unless (save_file ($tfile, \($xml -> toString))) {
196 violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
197 return $error{threadWrite};
198 }
199
200 violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
201
202 $thread = $xml;
203
204 # add message to thread tree
205 # ATTENTION: don't use the tree for visual output after this operation
206 #
207 my $i=1;
208 for (@{$param -> {parsedThreads} -> {$param -> {thread}}}) {
209 if ($_ -> {mid} == $param -> {parentMessage}) {
210 splice @{
211 $param -> {parsedThreads} -> {$param -> {thread}}},$i, 0,
212 { mid => $param -> {lastMessage} + 1,
213 unid => plain ($param -> {uniqueID}),
214 name => plain ($pars -> {name}),
215 cat => plain ($pars -> {category}),
216 subject => plain ($pars -> {subject}),
217 level => $_ -> {level} + 1,
218 time => plain ($pars -> {time})
219 };
220 last;
221 }
222 $i++;
223 }
224
225 # create & save forum main file
226 #
227 my $forum = create_forum_xml_string (
228 $param -> {parsedThreads},
229 { dtd => $param -> {dtd},
230 lastMessage => $mid,
231 lastThread => 't'.$param -> {lastThread}
232 }
233 );
234
235 save_file ($param -> {forumFile}, $forum) or return $error{forumWrite};
236 }
237
238 return (0, $thread, $mid, $tid);
239 }
240
241 # keep 'require' happy
242 #
243 1;
244
245 #
246 #
247 ### end of Posting::Write ######################################################

patrick-canterino.de