selfforum-cgi/shared/Posting/Admin.pm

   1 package Posting::Admin;
   2
   3 ################################################################################
   4 #                                                                              #
   5 # File:        shared/Posting/Admin.pm                                         #
   6 #              (was: ~Handle.pm)                                               #
   7 #                                                                              #
   8 # Authors:     Frank Schönmann <fs@tower.de>                                   #
   9 #              André Malo <nd@o3media.de>                                      #
  10 #              Christian Kruse <ckruse@wwwtech.de>                             #
  11 #                                                                              #
  12 # Description: Allow administration of postings                                #
  13 #                                                                              #
  14 # Todo:        * Lock files before modification                                #
  15 #              * Change body in change_posting_body()                          #
  16 #                                                                              #
  17 ################################################################################
  18
  19 use strict;
  20 use vars qw(
  21   @EXPORT
  22 );
  23
  24 use Lock;
  25 use Posting::_lib qw(
  26   parse_xml_file
  27   get_message_node
  28   save_file
  29   get_all_threads
  30   create_forum_xml_string
  31 );
  32
  33 use XML::DOM;
  34
  35 ################################################################################
  36 #
  37 # Version check
  38 #
  39 # last modified:
  40 #    $Date$ (GMT)
  41 # by $Author$
  42 #
  43 sub VERSION {(q$Revision$ =~ /([\d.]+)\s*$/)[0] or '0.0'}
  44
  45 ################################################################################
  46 #
  47 # Export
  48 #
  49 use base qw(Exporter);
  50
  51 @EXPORT = qw(
  52   hide_posting
  53   recover_posting
  54   modify_posting
  55   add_user_vote
  56   level_vote
  57 );
  58
  59 ### add_user_vote () ###########################################################
  60 #
  61 # Increase number of user votes (only in thread file)
  62 #
  63 # Params: $forum  Path and filename of forum
  64 #         $tpath  Path to thread files
  65 #         \%info  Hash reference: 'thread', 'posting', 'percent'
  66 # Return: Status code (Bool)
  67 #
  68 # Todo:
  69 #  * Lock files before modification
  70 #
  71 sub add_user_vote ($$$) {
  72   my ($forum, $tpath, $info) = @_;
  73   my ($tid, $mid, $percent) = ($info->{'thread'},
  74                                $info->{'posting'},
  75                                $info->{'percent'});
  76
  77   # Thread
  78   my $tfile = $tpath . '/t' . $tid . '.xml';
  79   my $xml   = parse_xml_file($tfile);
  80
  81   my $mnode = get_message_node($xml, $tid, $mid);
  82   my $votes = $mnode->getAttribute('votingUser') + 1;
  83   $mnode->setAttribute('votingUser', $votes);
  84
  85   return save_file($tfile, \$xml->toString);
  86 }
  87
  88 ### level_vote () ##############################################################
  89 #
  90 # Set 1st or 2nd level voting (only in thread file)
  91 #
  92 # Params: $forum  Path and filename of forum
  93 #         $tpath  Path to thread files
  94 #         \%info  Hash reference: 'thread', 'posting', 'level', 'value'
  95 # Return: Status code (Bool)
  96 #
  97 # Todo:
  98 #  * Lock files before modification
  99 #
 100 sub level_vote {
 101   my ($forum, $tpath, $info) = @_;
 102   my ($tid, $mid, $level, $value) = ($info->{'thread'},
 103                                      $info->{'posting'},
 104                                      $info->{'level'},
 105                                      $info->{'value'});
 106
 107   # Thread
 108   my $tfile = $tpath . '/t' . $tid . '.xml';
 109   my $xml = parse_xml_file($tfile);
 110   my $mnode = get_message_node($xml, $tid, $mid);
 111
 112   unless (defined $value) {
 113     removeAttribute($level);
 114   }
 115   else {
 116     $mnode->setAttribute($level, $value);
 117   }
 118
 119   return save_file($tfile, \$xml->toString);
 120 }
 121
 122 ### hide_posting () ############################################################
 123 #
 124 # Hide a posting: set 'invisible' flag
 125 #
 126 # Params: $forum  Path and filename of forum
 127 #         $tpath  Path to thread files
 128 #         \%info  Hash reference: 'thread', 'posting'
 129 # Return: -none-
 130 #
 131 sub hide_posting($$$) {
 132   my ($forum, $tpath, $info) = @_;
 133   my ($tid, $mid) = ($info->{'thread'},
 134                      $info->{'posting'});
 135
 136   # Thread
 137   my $tfile = $tpath . '/t' . $tid . '.xml';
 138
 139   # lock files
 140   my $main  = new Lock $forum;
 141   my $tlock = new Lock $tfile;
 142
 143   return unless $tlock->lock(LH_EXCL); # lock failed
 144   unless ($main->lock(LH_EXCL)) { # lock failed
 145     $tlock->unlock;
 146     return;
 147   }
 148
 149   #
 150   # Change invisibility in the thread file.
 151   #
 152   unless (change_posting_visibility($tfile, 't'.$tid, 'm'.$mid, 1)) { # saving failed
 153     $tlock->unlock;
 154     $main->unlock;
 155     return;
 156   }
 157
 158   # get all Forum threads
 159   my ($f, $lthread, $lmsg,$dtd) = get_all_threads($forum, 1);
 160   unless ($f) {
 161     $tlock->unlock;
 162     $main->unlock;
 163   }
 164
 165   #
 166   # Change invisibility in the main forum index.
 167   #
 168   for my $i (0 .. $#{$f->{$tid}}) {
 169     if ($f->{$tid}->[$i]->{'mid'} == $mid) {
 170       $f->{$tid}->[$_]->{'deleted'} = 1 for ($i .. $i+$f->{$tid}->[$i]->{'answers'});
 171       last;
 172     }
 173   }
 174
 175   my $success = save_file($forum,
 176                           create_forum_xml_string($f,
 177                                                   {
 178                                                     'dtd'         => $dtd,
 179                                                     'lastMessage' => $lmsg,
 180                                                     'lastThread'  => $lthread
 181                                                   })
 182                          );
 183
 184   $tlock->unlock;
 185   $main->unlock;
 186
 187   return $success;
 188 }
 189
 190 ### recover_posting() ##########################################################
 191 #
 192 # Recover a posting: delete 'invisible' flag
 193 #
 194 # Params: $forum  Path and filename of forum
 195 #         $tpath  Path to thread files
 196 #         \%info  Hash reference: 'thread', 'posting'
 197 # Return: success or unsuccess
 198 #
 199 sub recover_posting ($$$) {
 200   my ($forum, $tpath, $info) = @_;
 201   my ($tid, $mid) = ($info->{'thread'},
 202                      $info->{'posting'});
 203
 204   # Thread
 205   my $tfile = $tpath . '/t' . $tid . '.xml';
 206
 207   # lock files
 208   my $main  = new Lock $forum;
 209   my $tlock = new Lock $tfile;
 210
 211   return unless $tlock->lock(LH_EXCL); # lock failed
 212   unless ($main->lock(LH_EXCL)) { # lock failed
 213     $tlock->unlock;
 214     return;
 215   }
 216
 217   #
 218   # Change invisibility in the thread file.
 219   #
 220   unless (change_posting_visibility($tfile, 't'.$tid, 'm'.$mid, 0)) { # saving failed
 221     $main->unlock;
 222     $tlock->unlock;
 223     return;
 224   }
 225
 226   # get all Forum threads
 227   my ($f, $lthread, $lmsg,$dtd) = get_all_threads($forum,1);
 228
 229   unless ($f) {
 230     $main->unlock;
 231     $tlock->unlock;
 232
 233     return;
 234   }
 235
 236   #
 237   # Change invisibility in the main forum index.
 238   #
 239   for my $i (0 .. $#{$f->{$tid}}) {
 240     if ($f->{$tid}->[$i]->{'mid'} == $mid) {
 241       $f->{$tid}->[$_]->{'deleted'} = 0 for ($i .. $i+$f->{$tid}->[$i]->{'answers'});
 242       last;
 243     }
 244   }
 245
 246   my $success = save_file($forum,
 247                           create_forum_xml_string($f,
 248                                                   {
 249                                                     'dtd'         => $dtd,
 250                                                     'lastMessage' => $lmsg,
 251                                                     'lastThread'  => $lthread
 252                                                   })
 253                          );
 254
 255   $tlock->unlock;
 256   $main->unlock;
 257
 258   return $success;
 259 }
 260
 261 ### change_posting_visibility () ###############################################
 262 #
 263 # Set a postings visibility flag to $invisible
 264 #
 265 # Params: $fname      Filename
 266 #         $tid        Thread ID
 267 #         $mid        Message ID
 268 #         $invisible  1 - invisible, 0 - visible
 269 # Return: Status code
 270 #
 271 sub change_posting_visibility($$$$) {
 272   my ($fname, $tid, $mid, $invisible) = @_;
 273
 274   my $xml = parse_xml_file($fname);
 275   return unless $xml; # parser failed
 276
 277   # Set flag in given msg
 278   my $mnode = get_message_node($xml, $tid, $mid);
 279   $mnode->setAttribute('invisible', $invisible);
 280
 281   # Set flag in sub nodes
 282   $_->setAttribute('invisible', $invisible) foreach $mnode->getElementsByTagName('Message');
 283
 284   return save_file($fname, \$xml->toString);
 285 }
 286
 287 ### modify_posting () ##########################################################
 288 #
 289 # Modify a posting (only subject and category until now!)
 290 #
 291 # Params: $forum  Path and filename of forum
 292 #         $tpath  Path to thread files
 293 #         \%info  Reference: 'thread', 'posting', 'indexFile', 'data'
 294 #                 (data = \%hashref: 'subject', 'category', 'body')
 295 # Return: -none-
 296 #
 297 # Todo:
 298 #   * Lock files!
 299 #   * save return values
 300 #
 301 sub modify_posting($$$) {
 302   my ($forum, $tpath, $info) = @_;
 303   my ($tid, $mid, $indexFile, $data) = (
 304     $info->{'thread'},
 305     $info->{'posting'},
 306     $info->{'indexFile'},
 307     $info->{'data'}
 308   );
 309
 310   my ($subject, $category, $body) = (
 311     $data->{'subject'},
 312     $data->{'category'},
 313     $data->{'body'}
 314   );
 315
 316   my %msgdata;
 317
 318   # These values may be changed by change_posting_value()
 319   $msgdata{'Subject'} = $subject if $subject;
 320   $msgdata{'Category'} = $category if $category;
 321
 322   # Thread
 323   my $tfile = $tpath . '/t' . $tid . '.xml';
 324   change_posting_value($tfile, 't'.$tid, 'm'.$mid, \%msgdata);
 325   change_posting_body($tfile, 't'.$tid, 'm'.$mid, $body) if $body;
 326
 327   # Forum (does not contain msg bodies)
 328   if ($subject or $category) {
 329     my ($f, $lthread, $lmsg, $dtd, $zlev) = get_all_threads($forum, 1, 0);
 330
 331     for (@{$f->{$tid}}) {
 332       if ($_->{'mid'} == $mid) {
 333         $_->{'subject'} = $subject if $subject;
 334         $_->{'cat'} = $category if $category;
 335       }
 336     }
 337
 338    save_file($forum, create_forum_xml_string($f,{dtd=>$dtd,lastMessage=>$lmsg,lastThread$lthread}));
 339   }
 340
 341 }
 342
 343 ### change_posting_value () ####################################################
 344 #
 345 # Change specific values of a posting
 346 #
 347 # Params: $fname    Filename
 348 #         $tid      Thread ID
 349 #         $mid      Message ID
 350 #         \%values  New values
 351 # Return: Status code
 352 #
 353 sub change_posting_value($$$$) {
 354   my ($fname, $tid, $mid, $values) = @_;
 355
 356   my $xml   = parse_xml_file($fname);
 357   my $mnode = get_message_node($xml, $tid, $mid);
 358
 359   for (keys %$values) {
 360     # Find first direct child node with name $_
 361     my $nodes = $mnode->getElementsByTagName($_, 0);
 362     my $node = $nodes->item(0);
 363     $node->setValue($values->{$_});
 364   }
 365
 366   return save_file($fname, \$xml->toString);
 367 }
 368
 369 ### change_posting_body () #####################################################
 370 #
 371 # Change body of a posting
 372 #
 373 # Params: $fname  Filename
 374 #         $tid    Thread ID (unused, for compatibility purposes)
 375 #         $mid    Message ID
 376 #         $body   New body
 377 # Return: Status code
 378 #
 379 # Todo:
 380 #  * Change body
 381 #
 382 sub change_posting_body ($$$$) {
 383   my ($fname, $tid, $mid, $body) = @_;
 384
 385   my $xml    = parse_xml_file($fname);
 386   my $mbnody = get_message_body($xml, $mid);
 387
 388     # todo: change body
 389
 390   return save_file($fname, \$xml->toString);
 391 }
 392
 393
 394 # Let it be true
 395 1;
 396
 397 #
 398 #
 399 ### end of Posting::Admin ######################################################