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       }
  83     ),
  84     time     => $param -> {time},
  85     dtd      => $param -> {dtd},
  86     thread   => $tid
  87   };
  88
  89   # create new thread and save it to disk
  90   #
  91   $thread = create_new_thread ($pars);
  92   save_file ($param -> {messagePath}.$tid.'.xml',\($thread -> toString)) or return $error{threadWrite};
  93
  94   # update forum main file
  95   #
  96   $param
  97     -> {parsedThreads}
  98     -> {$param -> {lastThread} + 1} = [
  99         { mid     => $param -> {lastMessage} + 1,
 100           unid    => $param -> {uniqueID},
 101           name    => plain($pars -> {name}),
 102           cat     => plain($pars -> {category}),
 103           subject => plain($pars -> {subject}),
 104           time    => plain($pars -> {time}),
 105           level   => 0,
 106         }
 107        ];
 108
 109   my $forum = create_forum_xml_string (
 110     $param -> {parsedThreads},
 111     { dtd         => $pars -> {dtd},
 112       lastMessage => $mid,
 113       lastThread  => $tid
 114     }
 115   );
 116
 117   save_file ($param -> {forumFile}, $forum) or return $error{forumWrite};
 118   release_file ($param -> {messagePath}.$tid.'.xml');
 119   return (0, $thread, $mid);
 120 }
 121
 122 ### sub write_reply_posting ($) ################################################
 123 #
 124 # save a reply and update the forum main file
 125 #
 126 # Params: $param - hashreference
 127 #                  (see doc for details)
 128 #
 129 # Return: (0 or error, thread-xml, new mid)
 130 #
 131 sub write_reply_posting ($) {
 132   my $param = shift;
 133   my $thread;
 134   my $mid   = 'm'.($param -> {lastMessage} + 1);
 135   my $tid   = 't'.($param -> {thread});
 136
 137   my $tfile = $param -> {messagePath}.$tid.'.xml';
 138
 139   unless (write_lock_file ($tfile)) {
 140     violent_unlock_file ($tfile);
 141     return $error{threadFile};
 142   }
 143
 144   else {
 145     my $xml = parse_xml_file ($tfile);
 146
 147     unless ($xml) {
 148       violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
 149       return $error{threadFile};
 150     }
 151
 152     my $mnode = get_message_node ($xml, $tid, 'm'.$param -> {parentMessage});
 153
 154     unless (defined $mnode) {
 155       violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
 156       return $error{noParent};
 157     }
 158
 159     my $pars = {
 160       msg      => $mid,
 161       ip       => $param -> {ip},
 162       name     => defined $param -> {author}   ? $param -> {author}   :'',
 163       email    => defined $param -> {email}    ? $param -> {email}    :'',
 164       home     => defined $param -> {homepage} ? $param -> {homepage} :'',
 165       image    => defined $param -> {image}    ? $param -> {image}    :'',
 166       category => defined $param -> {category} ? $param -> {category} :'',
 167       subject  => defined $param -> {subject}  ? $param -> {subject}  :'',
 168       time     => $param -> {time},
 169     };
 170
 171     my $message = create_message ($xml, $pars);
 172
 173     $mnode -> appendChild ($message);
 174
 175     my $mcontent = $xml -> createElement ('MessageContent');
 176     $mcontent -> setAttribute ('mid' => $mid);
 177     $mcontent -> appendChild (
 178       $xml -> createCDATASection (
 179         ${encoded_body(
 180           \($param -> {body}),
 181           { quoteChars => $param -> {quoteChars},
 182             messages   => $param -> {messages}
 183           }
 184         )}
 185       )
 186     );
 187
 188     my $content = $xml -> getElementsByTagName ('ContentList', 1) -> item (0);
 189        $content -> appendChild ($mcontent);
 190
 191     # save thread file
 192     #
 193     unless (save_file ($tfile, \($xml -> toString))) {
 194       violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
 195       return $error{threadWrite};
 196     }
 197
 198     violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
 199
 200     $thread = $xml;
 201
 202     # add message to thread tree
 203     # ATTENTION: don't use the tree for visual output after this operation
 204     #
 205     my $i=1;
 206     for (@{$param -> {parsedThreads} -> {$param -> {thread}}}) {
 207       if ($_ -> {mid} == $param -> {parentMessage}) {
 208         splice @{
 209           $param -> {parsedThreads} -> {$param -> {thread}}},$i, 0,
 210           { mid     => $param -> {lastMessage} + 1,
 211             unid    => plain ($param -> {uniqueID}),
 212             name    => plain ($pars -> {name}),
 213             cat     => plain ($pars -> {category}),
 214             subject => plain ($pars -> {subject}),
 215             level   => $_ -> {level} + 1,
 216             time    => plain ($pars -> {time})
 217           };
 218         last;
 219       }
 220       $i++;
 221     }
 222
 223     # create & save forum main file
 224     #
 225     my $forum = create_forum_xml_string (
 226       $param -> {parsedThreads},
 227       { dtd         => $param -> {dtd},
 228         lastMessage => $mid,
 229         lastThread  => $tid
 230       }
 231     );
 232
 233     save_file ($param -> {forumFile}, $forum) or return $error{forumWrite};
 234   }
 235
 236   return (0, $thread, $mid);
 237 }
 238
 239 # keeping 'require' happy
 240 #
 241 1;
 242
 243 #
 244 #
 245 ### end of Posting::Write ######################################################