]> git.p6c8.net - selfforum.git/blob - selfforum-cgi/shared/Posting/Write.pm
CGI::Carp does not block eval errors all the time (bug?)
[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> #
8 # #
9 # Description: Save a posting #
10 # #
11 ################################################################################
12
13 use strict;
14 use vars qw(
15 %error
16 @EXPORT
17 );
18
19 use Encode::Plain; $Encode::Plain::utf8 = 1;
20 use Encode::Posting;
21 use Lock;
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 # Version check
45 #
46 # last modified:
47 # $Date$ (GMT)
48 # by $Author$
49 #
50 sub VERSION {(q$Revision$ =~ /([\d.]+)\s*$/)[0] or '0.0'}
51
52 ################################################################################
53 #
54 # Export
55 #
56 use base qw(Exporter);
57 @EXPORT = qw(
58 write_new_thread
59 write_reply_posting
60 );
61
62 ### sub write_new_thread ($) ###################################################
63 #
64 # save a posting and update the forum main file
65 #
66 # Params: $param - hashreference
67 # (see doc for details)
68 #
69 # Return: (0 or error, thread-xml, new mid)
70 #
71 sub write_new_thread ($) {
72 my $param = shift;
73 my $thread;
74 my $mid = 'm'.($param -> {lastMessage} + 1);
75 my $tid = 't'.($param -> {lastThread} + 1);
76
77 # define the params needed for a new thread
78 #
79 my $pars = {
80 msg => $mid,
81 ip => $param -> {ip},
82 name => defined $param -> {author} ? $param -> {author} : '',
83 email => defined $param -> {email} ? $param -> {email} : '',
84 home => defined $param -> {homepage} ? $param -> {homepage} : '',
85 image => defined $param -> {image} ? $param -> {image} : '',
86 category => defined $param -> {category} ? $param -> {category} : '',
87 subject => defined $param -> {subject} ? $param -> {subject} : '',
88 body => encoded_body(
89 \($param -> {body}),
90 { quoteChars => $param -> {quoteChars},
91 messages => $param -> {messages},
92 base_uri => $param -> {base_uri}
93 }
94 ),
95 time => $param -> {time},
96 dtd => $param -> {dtd},
97 thread => $tid
98 };
99
100 # create new thread and save it to disk
101 #
102 $thread = create_new_thread ($pars);
103 save_file ($param -> {messagePath}.$tid.'.xml',\($thread -> toString)) or return $error{threadWrite};
104
105 # update forum main file
106 #
107 $param
108 -> {parsedThreads}
109 -> {$param -> {lastThread} + 1} = [
110 { mid => $param -> {lastMessage} + 1,
111 unid => $param -> {uniqueID},
112 name => plain($pars -> {name}),
113 cat => plain($pars -> {category}),
114 subject => plain($pars -> {subject}),
115 time => plain($pars -> {time}),
116 level => 0,
117 }
118 ];
119
120 my $forum = create_forum_xml_string (
121 $param -> {parsedThreads},
122 { dtd => $pars -> {dtd},
123 lastMessage => $mid,
124 lastThread => $tid
125 }
126 );
127
128 save_file ($param -> {forumFile}, $forum) or return $error{forumWrite};
129 new Lock ($param -> {messagePath}.$tid.'.xml') -> release;
130 return (0, $thread, $mid, $tid);
131 }
132
133 ### sub write_reply_posting ($) ################################################
134 #
135 # save a reply and update the forum main file
136 #
137 # Params: $param - hashreference
138 # (see doc for details)
139 #
140 # Return: (0 or error, thread-xml, new mid)
141 #
142 sub write_reply_posting ($) {
143 my $param = shift;
144 my $thread;
145 my $mid = 'm'.($param -> {lastMessage} + 1);
146 my $tid = 't'.($param -> {thread});
147
148 my $tfile = new Lock ($param -> {messagePath}.$tid.'.xml');
149
150 unless ($tfile->lock(LH_EXCL)) {
151 return $error{threadFile};
152 }
153
154 else {
155 my $xml = parse_xml_file ($tfile->filename);
156
157 unless ($xml) {
158 $tfile -> unlock;
159 return $error{threadFile};
160 }
161
162 my $mnode = get_message_node ($xml, $tid, 'm'.$param -> {parentMessage});
163
164 unless (defined $mnode) {
165 $tfile -> unlock;
166 return $error{noParent};
167 }
168
169 my $pars = {
170 msg => $mid,
171 ip => $param -> {ip},
172 name => defined $param -> {author} ? $param -> {author} :'',
173 email => defined $param -> {email} ? $param -> {email} :'',
174 home => defined $param -> {homepage} ? $param -> {homepage} :'',
175 image => defined $param -> {image} ? $param -> {image} :'',
176 category => defined $param -> {category} ? $param -> {category} :'',
177 subject => defined $param -> {subject} ? $param -> {subject} :'',
178 time => $param -> {time},
179 };
180
181 my $message = create_message ($xml, $pars);
182
183 $mnode -> appendChild ($message);
184
185 my $mcontent = $xml -> createElement ('MessageContent');
186 $mcontent -> setAttribute ('mid' => $mid);
187 $mcontent -> appendChild (
188 $xml -> createCDATASection (
189 ${encoded_body(
190 \($param -> {body}),
191 { quoteChars => $param -> {quoteChars},
192 messages => $param -> {messages},
193 base_uri => $param -> {base_uri}
194 }
195 )}
196 )
197 );
198
199 my $content = $xml -> getElementsByTagName ('ContentList', 1) -> item (0);
200 $content -> appendChild ($mcontent);
201
202 # save thread file
203 #
204 unless (save_file ($tfile->filename, \($xml -> toString))) {
205 $tfile -> unlock;
206 return $error{threadWrite};
207 }
208
209 $tfile -> unlock;
210
211 $thread = $xml;
212
213 # add message to thread tree
214 # ATTENTION: don't use the tree for visual output after this operation
215 #
216 my $i=1;
217 for (@{$param -> {parsedThreads} -> {$param -> {thread}}}) {
218 if ($_ -> {mid} == $param -> {parentMessage}) {
219 splice @{
220 $param -> {parsedThreads} -> {$param -> {thread}}},$i, 0,
221 { mid => $param -> {lastMessage} + 1,
222 unid => plain ($param -> {uniqueID}),
223 name => plain ($pars -> {name}),
224 cat => plain ($pars -> {category}),
225 subject => plain ($pars -> {subject}),
226 level => $_ -> {level} + 1,
227 time => plain ($pars -> {time})
228 };
229 last;
230 }
231 $i++;
232 }
233
234 # create & save forum main file
235 #
236 my $forum = create_forum_xml_string (
237 $param -> {parsedThreads},
238 { dtd => $param -> {dtd},
239 lastMessage => $mid,
240 lastThread => 't'.$param -> {lastThread}
241 }
242 );
243
244 save_file ($param -> {forumFile}, $forum) or return $error{forumWrite};
245 }
246
247 return (0, $thread, $mid, $tid);
248 }
249
250 # keep 'require' happy
251 #
252 1;
253
254 #
255 #
256 ### end of Posting::Write ######################################################

patrick-canterino.de