# FILE: src-board-subs-104 #------------------------------------------------------------------------------- # DISCUS VERSION 3.10 COPYRIGHT NOTICE # # Discus 3.10 is copyright (c) 2000 by DiscusWare, LLC, all rights reserved. # The use of Discus is governed by the Discus License Agreement which is # available from the Discus WWW site at: # http://www.discusware.com/discus/license # # Pursuant to the Discus License Agreement, this copyright notice may not be # removed or altered in any way. #------------------------------------------------------------------------------- # # -------------------------------------------------------------------------------- # ATTENTION! THIS FILE IS PART OF THE DISCUS PRO DISTRIBUTION AND IS COMMERCIAL # SOFTWARE. REDISTRIBUTION OF THIS FILE IS STRICTLY PROHIBITED AND WILL RESULT IN # PROSECUTION TO THE MAXIMUM EXTENT OF THE LAW. YOU ARE NOT PERMITTED TO REMOVE # THIS NOTICE UNDER ANY CIRCUMSTANCES. # -------------------------------------------------------------------------------- #---SEPARATOR---# sub archive_mgr { if (!-w "$admin_dir/archive.txt") { &error_message("Archive Manager Error", "The file 'archive.txt' in your administration files directory does not exist or is not world writable. Check that permissions are 0777 (rwxrwxrwx) on this file.", 0, 1); } &header; print "Archive/Prune Manager\n"; print "\n"; print "\n"; print "$fs
Archive/Prune Manager
\n"; print "
\n"; print "

Automatic Archiving/Pruning

\n"; print "
\n"; print "
\n"; print "$fs", "Choose which topics you wish to archive (move messages) or prune (delete\n"; print "messages) automatically. Also specify how many messages must be in the\n"; print "conversation in order to invoke archiving/pruning and how many messages to leave\n"; print "in the conversation upon archiving/pruning.

\n"; print "\n"; open (ARCHIVE_CFG, "$admin_dir/archive.txt"); @archive = ; close (ARCHIVE_CFG); foreach $l (@archive) { if ($l =~ m|^(\w+)=(\d+)|) { $archive{$1} = $2; } } open (TOPICS, "$message_dir/$board_topics_file"); @topics = ; close (TOPICS); @t = grep(/^|; $d = $1; &extract("//$d/$d.$ext"); print ""; print ""; print ""; print ""; print ""; print ""; print "\n"; print "\n"; } print "
$fsArch.$fsPrune $fsInvoke$fsLeave $fsTopic
  $fs$topic_name
\n"; print "

\n"; print "

\n"; print "\n"; print "\n"; print "
\n"; print "

Manual Archiving/Pruning

\n"; print "
\n"; print "
\n"; print "\n"; print "\n"; print "
$fsTopic:
$fsOperation:"; print "\n"; print "
$fsThreshold:"; print "$fs days

\n"; print "\n"; print "

\n"; print "\n"; print "\n"; print "
\n"; exit(0); } #---SEPARATOR---# #REQ:regenerate_message #REQ:add_page #REQ:get_number #REQ:new_file #REQ:change_board_colors #REQ:incremental #REQ:show_gauge sub prune_messages { my ($topic, $tempfile, $dowhat, $prune_days, $place) = @_; my ($head, $color, $lm, $ann, $ann_src, $sublist, $about, $about_src, $message, $message_src, $description_src); if ($FORM{'place'} eq "") { ($fileref, $counter, $tempfiler) = &incremental("PRUNE", 1, "", $topic); &show_gauge("\U$FORM{'dowhat'}\E Operation", "Estimating time to \U$FORM{'dowhat'}\E this topic", 0, "$cgiurl?username=$superuser&action=prune_board&counter=$counter&tempfiler=$tempfiler&place=1&prune_days=$FORM{'prune_days'}&topic=$topic&dowhat=$FORM{'dowhat'}"); } if ($FORM{'place'} eq "1") { &lock("prune_messages", "*"); ($fileref) = &incremental($FORM{'tempfiler'}, 2, "", ""); @TEMPFILER = @{$fileref}; $starttime = time; $returned = ""; $sec_due_to_factor = int($GLOBAL_OPTIONS{'reindex_factor'} / 30); open (TREE, "$admin_dir/msg_index/$topic-tree.txt"); @TREE_STRUCTURE_FILE = ; close (TREE); undef %ddd; $cutoff = time - (24 * 60 * 60 * $FORM{'prune_days'}); $topic_is_running = $topic; $ft = time; $total_messages_touched = 0; O: while (time <= ($starttime + 2 + $sec_due_to_factor)) { $file = shift(@TEMPFILER); last if $file eq ""; $file =~ m|(\d+)/(\d+)\.$ext|; $page = $2; $topic = $1; $i_used_topic = $topic if $topic > 0; ($head, $color, $lm, $ann, $ann_src, $sublist, $about, $about_src, $message, $message_src, $description_src) = &get_page($topic, $page); @sublist = split(/\n/, $sublist); I: foreach $st (@sublist) { if ($st =~ m||) { $x = $1; if (grep(/^$topic\/$x\.$ext/, @TEMPFILER)) { push (@TEMPFILER, $file); redo O; } } } $FORM{'done'} += 1; $file =~ m|(\d+)/(\d+)\.$ext|; $page = $2; $topic = $1; if ($topic_is_running != $topic && $topic_is_running > 0) { unshift(@TEMPFILER, $file); last; } undef @newmsg; $flag = 0; ($head, $color, $lm, $ann, $ann_src, $sublist, $about, $about_src, $message, $message_src, $description_src) = &get_page($topic, $page); next if ($head =~ m|| && $FORM{'dowhat'} eq "archive"); next if ($head =~ m||); @msg = split(/\n/, $message); $lastpost = 0; MX: foreach $line (@msg) { if ($line =~ m|(.*)|) { ($post, $time) = ($1, $3); next MX if $time > $cutoff; $lastpost = $time if $time > $lastpost; $flag = 1; $total_messages_touched += 1; push (@newmsg, $line); $line = ""; } elsif ($line =~ m||) { $post = $1; $flag = 1; $total_messages_touched += 1; push (@newmsg, $line); $line = ""; } elsif ($line =~ m||) { if ($flag == 1) { $flag = 0; push (@newmsg, $line); $line = ""; } } elsif ($flag == 1) { push (@newmsg, $line); $line = ""; } } next if scalar(@newmsg) == 0; @msg = grep(/\S/, @msg); $message = join("\n", @msg); $message = ®enerate_message($topic, $page, $message); ($txl) = grep(/^(\d+)\t$topic\t$page\t/, @TREE_STRUCTURE_FILE); chomp $txl; @c = split(/\t/, $txl); @x = split(/,/, $c[11]); undef @y; foreach $line (@newmsg) { if ($line =~ m||) { $p = $1; @x = grep(!/^$p$/, @x); push (@y, $p); } } $c[11] = join(",", @x); $txl = join("\t", @c); $txl .= "\n"; ######################################### ### ARCHIVING ACTION if ($dowhat eq "archive") { next if scalar(@msg) == 0; $num = &get_number(12345); $new_page = $L{'ARCHIVE_SUBTOPIC_NAME'}; $lastpost = time if $lastpost <= 0; ($dt) = &get_date_time('dateonly', $lastpost); $new_page =~ s/\%date/$dt/g; $ct = 0; $lastnum = $page; foreach $line (@TREE_STRUCTURE_FILE) { @c = split(/\t/, $line); if ($c[3] == $page) { $lastnum = $c[2]; } elsif ($c[2] == $page) { $line = $txl; } } TSFL: foreach $line (@TREE_STRUCTURE_FILE) { @c = split(/\t/, $line); $ct++; if ($c[1] == $topic && $c[2] == $lastnum) { $poster_name = "-"; $newline = join("\t", ($c[0]+1), $c[1], $num, $page, &escape($new_page), "ArchiveMessages", $owner, scalar(@y), $lastpost, $lastpost, "-", join(",", @y)); $newline .= "\n"; if ($c[5] !~ m|Sublist|) { $c[5] .= "Sublist"; $line = join("\t", @c); } splice(@TREE_STRUCTURE_FILE, $ct, 0, $newline); last TSFL; } } foreach $xx (@y) { $ddd{$xx} = $num; } @sublist = split(/\n/, $sublist); $url = "$message_url/$topic/$num.$ext"; $url .= "?$lasttime" if !$noqm; $st = &get_date_time("shorter", $lasttime); push (@sublist, "" . &format_subtopics($url, $new_page, $st, "-", 0)); $sublist = join("\n", @sublist); if ($head =~ m||) { $p = $1; $b = $`; $a = $'; if ($p !~ m|Sublist|) { $head = join("", $b, "", $a); } } $head =~ m||; $owner = $1; &set_page($topic, $page, $head, $color, $lm, $ann, $ann_src, $sublist, $about, $about_src, $message, $message_src, $description_src); &new_file ($topic, $num, $page, $owner, $new_page, "ArchiveMessages", $lasttime, "", 12345); ($head, $color, $lm, $ann, $ann_src, $sublist, $about, $about_src, $message, $message_src, $description_src) = &get_page($topic, $num); $message = join("\n", @newmsg); $message = ®enerate_message($topic, $num, $message); &set_page($topic, $num, $head, $color, $lm, $ann, $ann_src, $sublist, $about, $about_src, $message, $message_src, $description_src); open (SRC, "$admin_dir/msg_index/$topic/$page-src.txt"); @src = ; close (SRC); open (SRCNEW, ">$admin_dir/msg_index/$topic/$num-src.txt"); foreach $l (@src) { ($s, $src) = split(/\s/, $l); if (grep(/^$s$/, @src)) { print SRCNEW $l; $l = ""; } } @src = grep(/\S/, @src); open (SRC, ">$admin_dir/msg_index/$topic/$page-src.txt"); print SRC @src; close (SRC); } else { ######################################### ### PRUNING ACTION $pg_gone = 0; undef %thisddd; if (!grep(/^/, @msg)) { $head =~ m||; $p = $1; $p =~ s/Messages//; $p =~ s/Add//; $p =~ s/Archive//; $p =~ s/Create//; if ($sublist !~ m|| && $p =~ m|Sublist|) { $p =~ s/Sublist//; } $pg_gone = 1 if $p eq ""; } foreach $line (@newmsg) { if ($line =~ m||) { ($post, $time) = ($1, $2); $ddd{$post} = -1; $thisddd{$post} = 1; } } if ($pg_gone == 1) { unlink("$message_dir/$topic/$page.$ext") if -e "$message_dir/$topic"; unlink("$secdir/$topic/$page.$ext") if -e "$secdir/$topic"; $head =~ m|