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