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(
  15   %error
  16   @EXPORT
  17   $VERSION
  18 );
  19
  20 use Encode::Plain; $Encode::Plain::utf8 = 1;
  21 use Encode::Posting;
  22 use Lock qw(
  23   :WRITE
  24   release_file
  25 );
  26 use Posting::_lib qw(
  27   get_message_node
  28   get_message_header
  29   create_forum_xml_string
  30   create_new_thread
  31   create_message
  32   save_file
  33   parse_xml_file
  34   KEEP_DELETED
  35 );
  36
  37 use XML::DOM;
  38
  39 %error = (
  40   threadWrite => '1 could not write thread file',
  41   forumWrite  => '2 could not write forum file',
  42   threadFile  => '3 could not load thread file',
  43   noParent    => '4 could not find parent message'
  44 );
  45
  46 ################################################################################
  47 #
  48 # Version check
  49 #
  50 $VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
  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   release_file ($param -> {messagePath}.$tid.'.xml');
 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 = $param -> {messagePath}.$tid.'.xml';
 149
 150   unless (write_lock_file ($tfile)) {
 151     violent_unlock_file ($tfile);
 152     return $error{threadFile};
 153   }
 154
 155   else {
 156     my $xml = parse_xml_file ($tfile);
 157
 158     unless ($xml) {
 159       violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
 160       return $error{threadFile};
 161     }
 162
 163     my $mnode = get_message_node ($xml, $tid, 'm'.$param -> {parentMessage});
 164
 165     unless (defined $mnode) {
 166       violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
 167       return $error{noParent};
 168     }
 169
 170     my $pars = {
 171       msg      => $mid,
 172       ip       => $param -> {ip},
 173       name     => defined $param -> {author}   ? $param -> {author}   :'',
 174       email    => defined $param -> {email}    ? $param -> {email}    :'',
 175       home     => defined $param -> {homepage} ? $param -> {homepage} :'',
 176       image    => defined $param -> {image}    ? $param -> {image}    :'',
 177       category => defined $param -> {category} ? $param -> {category} :'',
 178       subject  => defined $param -> {subject}  ? $param -> {subject}  :'',
 179       time     => $param -> {time},
 180     };
 181
 182     my $message = create_message ($xml, $pars);
 183
 184     $mnode -> appendChild ($message);
 185
 186     my $mcontent = $xml -> createElement ('MessageContent');
 187     $mcontent -> setAttribute ('mid' => $mid);
 188     $mcontent -> appendChild (
 189       $xml -> createCDATASection (
 190         ${encoded_body(
 191           \($param -> {body}),
 192           { quoteChars => $param -> {quoteChars},
 193             messages   => $param -> {messages},
 194             base_uri   => $param -> {base_uri}
 195           }
 196         )}
 197       )
 198     );
 199
 200     my $content = $xml -> getElementsByTagName ('ContentList', 1) -> item (0);
 201        $content -> appendChild ($mcontent);
 202
 203     # save thread file
 204     #
 205     unless (save_file ($tfile, \($xml -> toString))) {
 206       violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
 207       return $error{threadWrite};
 208     }
 209
 210     violent_unlock_file ($tfile) unless (write_unlock_file ($tfile));
 211
 212     $thread = $xml;
 213
 214     # add message to thread tree
 215     # ATTENTION: don't use the tree for visual output after this operation
 216     #
 217     my $i=1;
 218     for (@{$param -> {parsedThreads} -> {$param -> {thread}}}) {
 219       if ($_ -> {mid} == $param -> {parentMessage}) {
 220         splice @{
 221           $param -> {parsedThreads} -> {$param -> {thread}}},$i, 0,
 222           { mid     => $param -> {lastMessage} + 1,
 223             unid    => plain ($param -> {uniqueID}),
 224             name    => plain ($pars -> {name}),
 225             cat     => plain ($pars -> {category}),
 226             subject => plain ($pars -> {subject}),
 227             level   => $_ -> {level} + 1,
 228             time    => plain ($pars -> {time})
 229           };
 230         last;
 231       }
 232       $i++;
 233     }
 234
 235     # create & save forum main file
 236     #
 237     my $forum = create_forum_xml_string (
 238       $param -> {parsedThreads},
 239       { dtd         => $param -> {dtd},
 240         lastMessage => $mid,
 241         lastThread  => 't'.$param -> {lastThread}
 242       }
 243     );
 244
 245     save_file ($param -> {forumFile}, $forum) or return $error{forumWrite};
 246   }
 247
 248   return (0, $thread, $mid, $tid);
 249 }
 250
 251 # keep 'require' happy
 252 #
 253 1;
 254
 255 #
 256 #
 257 ### end of Posting::Write ######################################################