home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / FAQ / discus_admin_1357211388 / source / fcn-logs.pl < prev    next >
Text File  |  2009-11-06  |  21KB  |  714 lines

  1. # FILE: fcn-logs.pl
  2. # DESCRIPTION: Manipulate ###-log.txt and ###-search.txt
  3. #-------------------------------------------------------------------------------
  4. # DISCUS COPYRIGHT NOTICE
  5. #
  6. # Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
  7. # The use of Discus is governed by the Discus License Agreement which is
  8. # available from the Discus WWW site at:
  9. #    http://www.discusware.com/discus/license
  10. #
  11. # Pursuant to the Discus License Agreement, this copyright notice may not be
  12. # removed or altered in any way.
  13. #-------------------------------------------------------------------------------
  14.  
  15. use strict;
  16. use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);
  17.  
  18. ###
  19. ### Which mini-logs should be kept?
  20. ###
  21.  
  22. my @mini_logs = (1, 7);
  23.  
  24. sub get_mini_logs {
  25.     return @mini_logs;
  26. }
  27.  
  28. ###
  29. ### create_blank_mini_logs
  30. ###
  31. ### Create blank mini logs
  32. ###
  33.  
  34. sub create_blank_mini_logs {
  35.     my ($topic) = @_;
  36.     dreq("adm-tpc");
  37.     foreach my $m (@mini_logs) {
  38.         topic_error_touch("$DCONF->{admin_dir}/msg_index/$topic-log-$m.txt");
  39.     }    
  40. }
  41.  
  42. ###
  43. ### minilog_choose_log
  44. ###
  45. ### Chooses which minilog to use when performing a search
  46. ###
  47.  
  48. sub minilog_choose_log {
  49.     my ($cutoff, $timecache) = @_;
  50.     return undef if $cutoff == 0;
  51.     $timecache = time if ! defined $timecache;
  52.     my $days = int(($timecache - $cutoff)/86400);
  53.     $days += 1 if ($timecache - $cutoff) % 86400 != 0;
  54.     foreach my $ml (sort { $a <=> $b } @mini_logs) {
  55.         return $ml if $ml >= $days;
  56.     }
  57.     return undef;    
  58. }
  59.  
  60. ###
  61. ### minilog_maintenance
  62. ###
  63. ### Removes outdated entries from recent posting log file, or creates new
  64. ### minilogs if one or more is missing (usually called when operations unrelated
  65. ### to logs are running, so it sequentially updates the appropriate logs)
  66. ###
  67.  
  68. sub minilog_maintenance {
  69.     return undef if $GLOBAL_OPTIONS->{database};
  70.     my ($threshold, $topic) = @_;
  71.     if ($topic == 0) {
  72.         my @dir = ();
  73.         my $d = {};
  74.         opendir(DIR, "$DCONF->{admin_dir}/msg_index");
  75.         while (my $dir = readdir(DIR)) {
  76.             if ($dir =~ m|^(\d+)-log\.txt$|) {
  77.                 $d->{$1} += scalar(@mini_logs);
  78.             } elsif ($dir =~ m|^(\d+)-log-(\d+)\.txt$|) {
  79.                 $d->{$1} -= 1;
  80.                 
  81.             }
  82.             next if $dir !~ m|^(\d+)-log-(\d+)\.txt$|;
  83.             next if $2 != $threshold && $threshold;
  84.             my @s = stat "$DCONF->{admin_dir}/msg_index/$dir";
  85.             push @dir, { file => $dir, topic => $1, mtime => $s[9], thres => $2 };
  86.         }
  87.         closedir(DIR);
  88.         foreach my $k (keys(%{ $d })) {
  89.             next if $d->{$k} == 0;
  90.             my $rv = create_minilog($k);
  91.             return $rv if $rv == 1;
  92.         }
  93.         my $one = (sort { $a->{mtime} <=> $b->{mtime} } @dir)[0];
  94.         $topic = $one->{topic};
  95.         $threshold = $one->{thres};
  96.     }
  97.     return undef if $topic == 0;
  98.     return undef if ! -e "$DCONF->{admin_dir}/msg_index/$topic-log-$threshold.txt";
  99.     my $cutoff = time - (24*60*60*$threshold);
  100.     my $fsize = 0;
  101.     if (open(FILE, "< $DCONF->{admin_dir}/msg_index/$topic-log-$threshold.txt")) {
  102.         if (open(FILE2, "> $DCONF->{admin_dir}/msg_index/$topic-log-$threshold.NEW")) {
  103.             while (<FILE>) {
  104.                 my $h = log_line_to_hash($_);
  105.                 if ($h->{time} >= $cutoff) {
  106.                     print FILE2 $_;
  107.                     $fsize += length($_);
  108.                 }
  109.             }
  110.             close (FILE2);
  111.             close (FILE);
  112.         } else {
  113.             log_error("fcn-logs.pl", "minilog_remove_outdated", "Could not open new minilog for writing [$topic]: $!");
  114.             close (FILE);
  115.             return undef;
  116.         }
  117.     } else {
  118.         log_error("fcn-logs.pl", "minilog_remove_outdated", "Could not open old minilog for reading [$topic]: $!");
  119.         return undef;
  120.     }
  121.     rename_file("$DCONF->{admin_dir}/msg_index/$topic-log-$threshold.NEW", $fsize, "$DCONF->{admin_dir}/msg_index/$topic-log-$threshold.txt");
  122. }
  123.  
  124. ###
  125. ### create_minilog
  126. ###
  127. ### Creates a "minilog" - portion of a posting log of messages posted after a given
  128. ### time, so searching goes much faster.
  129. ###
  130.  
  131. sub create_minilog {
  132.     my ($topic) = @_;
  133.     return undef if ! -e "$DCONF->{admin_dir}/msg_index/$topic-log.txt";
  134.     my @ml = sort { $a <=> $b } @mini_logs;
  135.     my $max = pop @ml;
  136.     my $time = time;
  137.     my @d = ();
  138.     if (open(FILE, "< $DCONF->{admin_dir}/msg_index/$topic-log.txt")) {
  139.         my $t = $ml[$#ml];
  140.         open (OUT, "> $DCONF->{admin_dir}/msg_index/$topic-log-$max.txt");
  141.         while (<FILE>) {
  142.             my $h = log_line_to_hash($_);
  143.             next if $h->{'time'} < $time-(24*60*60*$max);
  144.             print OUT $_;
  145.             next if $h->{'time'} < $time-(24*60*60*$t);
  146.             push @d, $h;
  147.         }
  148.         close (OUT);
  149.         close (FILE);
  150.         chmod (oct($DCONF->{perms0666}), "$DCONF->{admin_dir}/msg_index/$topic-log-$max.txt");
  151.     }
  152.     while (my $x = pop @ml) {
  153.         my @k = ();
  154.         my $t = $ml[$#ml];
  155.         open (OUT, "> $DCONF->{admin_dir}/msg_index/$topic-log-$x.txt");
  156.         foreach my $d (@d) {
  157.             print OUT log_hash_to_line($d);
  158.             next if $d->{'time'} < $time-(24*60*60*$t);
  159.             push @k, $d;
  160.         }
  161.         close (OUT);
  162.         chmod (oct($DCONF->{perms0666}), "$DCONF->{admin_dir}/msg_index/$topic-log-$x.txt");
  163.         @d = @k;
  164.     }
  165.     return 1;
  166. }
  167.  
  168. ###
  169. ### search_line_to_hash
  170. ###
  171. ### Converts a line to a hash from ###-search.txt.  Note that
  172. ### search_line_to_hash(search_hash_to_line($ref)) = $ref
  173. ###
  174.  
  175. sub search_line_to_hash {
  176.     my ($line) = @_;
  177.     chomp $line;
  178.     my $d = {};
  179.     my @s = ('postindex', 'time', 'text');
  180.     my @l = split(/\s+/, $line, 3);
  181.     while (my $p = shift(@s)) {
  182.         $d->{$p} = shift @l;
  183.     }
  184.     return $d;
  185. }
  186.  
  187. ###
  188. ### search_hash_to_line
  189. ###
  190. ### Converts a hash to a line for writing into ###-search.txt.  Note that
  191. ### search_hash_to_line(search_line_to_hash($str)) = $str
  192. ###
  193.  
  194. sub search_hash_to_line {
  195.     my ($hash) = @_;
  196.     my $l = join(" ", $hash->{postindex}, $hash->{'time'}, $hash->{text});
  197.     $l .= "\n";
  198.     return $l;
  199. }
  200.  
  201. ###
  202. ### log_line_to_hash
  203. ###
  204. ### Converts a line to a hash from ###-log.txt.  Note that
  205. ### log_line_to_hash(log_hash_to_line($ref)) = $ref
  206. ###
  207.  
  208. sub log_line_to_hash {
  209.     my ($line) = @_;
  210.     chomp $line;
  211.     my $d = {};
  212.     my @s = ('postindex', 'username', 'time', 'where', 'remote_addr', 'remote_host', 'firstchars', 'poststr');
  213.     my @l = split(/;/, $line);
  214.     while (my $p = shift(@s)) {
  215.         $d->{$p} = shift @l;
  216.     }
  217.     ($d->{topic}, $d->{page}) = split(/\//, $d->{where});
  218.     return $d;
  219. }
  220.  
  221. ###
  222. ### log_hash_to_line
  223. ###
  224. ### Converts a hash to a line for writing into ###-log.txt.  Note that
  225. ### log_hash_to_line(log_line_to_hash($str)) = $str
  226. ###
  227.  
  228. sub log_hash_to_line {
  229.     my ($hash) = @_;
  230.     $hash->{'time'} = ( $hash->{'time'} > 0 ? $hash->{'time'} : time );
  231.     $hash->{'remote_addr'} = ( defined $hash->{'remote_addr'} ? $hash->{'remote_addr'} : $ENV{'REMOTE_ADDR'});
  232.     $hash->{'remote_host'} = ( defined $hash->{'remote_host'} ? $hash->{'remote_host'} : $ENV{'REMOTE_HOST'});
  233.     $hash->{'where'} = ( defined $hash->{'where'} ? $hash->{'where'} : "$hash->{topic}/$hash->{page}");
  234.     my $l = join(";", $hash->{postindex}, $hash->{username}, $hash->{'time'}, $hash->{where}, $hash->{remote_addr}, $hash->{remote_host}, $hash->{firstchars}, $hash->{poststr});
  235.     $l .= "\n";
  236.     return $l;
  237. }
  238.  
  239. ###
  240. ### log_read_file
  241. ###
  242. ### Reads from the log file.  Some searching is built in too.
  243. ###        bottom_cutoff        Bottom cutoff time
  244. ###        top_cutoff            Top cutoff time
  245. ###        poster_match        Require matching a poster's name
  246. ###        postindex            Return a single record identified by 'postindex'
  247. ###
  248.  
  249. sub log_read_file {
  250.     my ($topics, $param, $searches) = @_;
  251.     my $tpc = {};
  252.     if (ref $topics ne "HASH") {
  253.         foreach (split(/,/, $topics)) {
  254.             $tpc->{$_} = 1;
  255.         }
  256.     } else {
  257.         $tpc = $topics;
  258.     }
  259.     my %pi = {};
  260.     if (defined $searches->{postindex}) {
  261.         if (ref $searches->{postindex} eq "ARRAY") {
  262.             foreach my $j (@{ $searches->{postindex} }) { $pi{$j} = 1; }
  263.         } elsif (ref $searches->{postindex} eq "HASH") {
  264.             foreach my $j (keys(%{ $searches->{postindex} })) { $pi{$j} = 1; }
  265.         } else {
  266.             foreach my $j (split(/,/, $searches->{postindex})) { $pi{$j} = 1; }
  267.         }        
  268.     } else {
  269.         $pi{'*'} = 1;
  270.     }    
  271.     if ($GLOBAL_OPTIONS->{database} && $DCONF->{pro}) {
  272.         dreq("sql-logs-PRO");
  273.         return sql_logs_read_log_file($param, $searches, $tpc);
  274.     } else {
  275.         my $ml_ext = ".txt";
  276.         if (ref $searches eq 'HASH' && $searches->{bottom_cutoff} > 0) {
  277.             my $ml = minilog_choose_log($searches->{bottom_cutoff});
  278.             $ml_ext = "-$ml.txt" if defined $ml;
  279.         }
  280.         my @r = ();
  281.         my $req_re = [];
  282.         my $neg_re = "";
  283.         my $opt_re = "";
  284.         if ($searches->{poster_match} ne "") {
  285.             my ($req, $neg, $opt) = search_create_query_conditions($searches->{query_info}, undef, 1);
  286.             $req_re = $req;
  287.             $neg_re = $neg;
  288.             $opt_re = $opt;
  289.         }
  290.         foreach my $t (keys(%{ $tpc })) {
  291.             my $file = join("/", $DCONF->{admin_dir}, "msg_index", "$t-log$ml_ext");
  292.             $PARAMS->{files_read}++;
  293.             $PARAMS->{file_access}->{$file}->{read} += 1;
  294.             $PARAMS->{file_access}->{$file}->{write} += 0;
  295.             performance_string("< log_read_file $file") if $GLOBAL_OPTIONS->{performance_monitoring};
  296.             open (LOG, "< $file");
  297. W:            while (<LOG>) {
  298.                 my $h = log_line_to_hash($_);
  299.                 next W if defined $searches->{id} && $h->{username} ne $searches->{id};
  300.                 if ($searches->{postindex} && $pi{$h->{postindex}}) {
  301.                     push @r, $h;
  302.                     delete $pi{$h->{postindex}};
  303.                     if (scalar(keys(%pi)) == 0) {
  304.                         close (LOG);
  305.                         return $h if $searches->{postindex} =~ /^\d+/;
  306.                         return \@r;
  307.                     }
  308.                 }
  309.                 next W if defined $searches->{postindex};
  310.                 my $poststr = unescape($h->{poststr});
  311.                 next W if (defined $searches->{bottom_cutoff} && $h->{'time'} < $searches->{bottom_cutoff});
  312.                 next W if (defined $searches->{top_cutoff} && $h->{'time'} > $searches->{top_cutoff});
  313.                 next W if ($neg_re ne "" && $poststr =~ /$neg_re/);
  314.                 if (ref $req_re eq "ARRAY" && scalar(@{ $req_re })) {
  315.                     foreach my $re (@{ $req_re }) {
  316.                         next W if $poststr !~ /$re/;                        
  317.                     }    
  318.                 }
  319.                 next W if ($opt_re ne "" && $poststr !~ /$opt_re/);
  320.                 $h->{topic} = $t;
  321.                 push @r, $h;
  322.                 if ($param->{no_cutoff} == 0 && $GLOBAL_OPTIONS->{tree_search_absolute_cutoff_point} > 0 && scalar(@r) > $GLOBAL_OPTIONS->{tree_search_absolute_cutoff_point}) {
  323.                     close(LOG);
  324.                     return \@r;
  325.                 }
  326.             }
  327.             close (LOG);
  328.         }
  329.         return \@r;
  330.     }
  331. }
  332.  
  333. ###
  334. ### search_create_query_conditions
  335. ###
  336. ### Creates a full search query
  337. ###
  338.  
  339. sub search_create_query_conditions {
  340.     my ($o, $flag, $no_stop) = @_;
  341.     dreq("search");
  342.     my @r = search_prepare_query($o, undef, $no_stop);
  343.     my @req = @{ $r[0] };
  344.     my @neg = @{ $r[1] };
  345.     my @opt = @{ $r[2] };
  346.     return (\@req, \@neg, \@opt) if $flag == 303;
  347.     my $opt_re = join("|", @opt);
  348.     my $neg_re = join("|", @neg);
  349.     $opt_re = join("", "(", $opt_re, ")") if $opt_re ne "";
  350.     $neg_re = join("", "(", $neg_re, ")") if $neg_re ne "";
  351.     $opt_re = join("", "(?i)", $opt_re) if (! $o->{search_opt}->{sensitive} && $opt_re);
  352.     $neg_re = join("", "(?i)", $neg_re) if (! $o->{search_opt}->{sensitive} && $neg_re);
  353.     return (\@req, $neg_re, $opt_re);
  354. }
  355.  
  356. ###
  357. ### log_search_update_entry
  358. ###
  359. ### Updates a log or search entry within the same topic
  360. ###
  361.  
  362. sub log_search_update_entry {
  363.     my ($topic, $type, $updates) = @_;
  364.     if ($DCONF->{pro} && $GLOBAL_OPTIONS->{database}) {
  365.         dreq("sql-logs-PRO");
  366.         return sql_log_search_update_entry($topic, $type, $updates);
  367.     }
  368.     my %miniseen = {};
  369.     my $timecache = time;
  370.     my @file = ("$DCONF->{admin_dir}/msg_index/$topic-$type.txt");
  371.     while (my $filename = shift @file) {
  372.         &lock("log_search_update_entry", $filename);
  373.         open (FILE1, "< $filename");
  374.         open (FILE2, "> $filename.new");
  375.         my $bytectr = 0;
  376.         my $ctr = 1;
  377.         my %seen = {};
  378.         foreach my $u (@{ $updates }) {
  379.             $seen{$u->{postindex}} = $ctr; $ctr++;
  380.         }
  381. F:        while (<FILE1>) {
  382.             my $hash = $type eq "search" ? search_line_to_hash($_) : log_line_to_hash($_);
  383.             if (! $seen{ $hash->{postindex} }) {
  384.                 print FILE2 $_;
  385.                 $bytectr += length($_);
  386.                 next F;
  387.             } else {
  388.                 my $x = $updates->[ $seen{ $hash->{postindex} } -1 ];
  389.                 foreach my $k (keys(%{ $x })) {
  390.                     $hash->{$k} = $x->{$k};
  391.                 }
  392.                 my $line = $type eq "search" ? search_hash_to_line($hash) : log_hash_to_line($hash);
  393.                 print FILE2 $line;
  394.                 delete $seen{ $hash->{postindex} };
  395.                 $bytectr += length($line);
  396.                 if ($type eq "log") {
  397. M:                    foreach my $m (@mini_logs) {
  398.                         next M if $miniseen{$m};
  399.                         if ($timecache - 24*60*60*$m <= $hash->{'time'}) {
  400.                             push @file, "$DCONF->{admin_dir}/msg_index/$topic-$type-$m.txt";
  401.                             $miniseen{$m} = 1;
  402.                         }
  403.                     }
  404.                 }                    
  405.                 if (scalar(keys(%seen)) == 0) {
  406.                     while (<FILE1>) {
  407.                         $bytectr += length($_);
  408.                         print FILE2;
  409.                     }
  410.                     last F;
  411.                 }
  412.             }
  413.         }
  414.         close (FILE1);
  415.         close (FILE2);
  416.         rename_file("$filename.new", $bytectr, "$filename");
  417.         unlock("log_search_update_entry", $filename);
  418.     }
  419. }
  420.  
  421. ###
  422. ### search_push_entry
  423. ###
  424. ### Adds one or more entries to a ###-search.txt file (or database)
  425. ###
  426.  
  427. sub search_push_entry {
  428.     my ($topic, $data, $params) = @_;
  429.     my @d = ref $data eq "ARRAY" ? @{ $data } : ( $data );
  430.     if ($GLOBAL_OPTIONS->{database} && $DCONF->{pro}) {
  431.         dreq("sql-logs-PRO", "dbint");
  432.         return sql_logs_search_push_entry(\@d, $topic, $params);
  433.     } else {
  434.         my @q = ();
  435.         foreach my $hash (@d) {
  436.             push (@q, search_hash_to_line($hash));
  437.         }
  438.         appendfile("$DCONF->{admin_dir}/msg_index/$topic-search.txt", \@q, "search_push_entry", undef);
  439.     }
  440. }
  441.  
  442. ###
  443. ### log_push_entry
  444. ###
  445. ### Adds one or more entries to a ###-log.txt file (or database)
  446. ###
  447.  
  448. sub log_push_entry {
  449.     my ($topic, $data, $params) = @_;
  450.     my @d = ref $data eq "ARRAY" ? @{ $data } : ( $data );
  451.     if ($GLOBAL_OPTIONS->{database} && $DCONF->{pro}) {
  452.         dreq("sql-logs-PRO", "dbint");
  453.         return sql_logs_log_push_entry(\@d, $topic, $params);
  454.     } else {
  455.         my @q = ();
  456.         foreach my $hash (@d) {
  457.             push (@q, log_hash_to_line($hash));
  458.         }
  459.         appendfile("$DCONF->{admin_dir}/msg_index/$topic-log.txt", \@q, "log_push_entry", undef);
  460.         append_minilogs(\@q, $topic);
  461.     }
  462. }
  463.  
  464. ###
  465. ### append_minilogs
  466. ###
  467. ### Writes out new information in posting mini-logs
  468. ###
  469.  
  470. sub append_minilogs {
  471.     my ($data, $topic) = @_;
  472.     my $flag = 0;
  473.     foreach my $mini_log (@mini_logs) {
  474.         return undef if ! -e "$DCONF->{admin_dir}/msg_index/$topic-log-$mini_log.txt";
  475.     }    
  476.     foreach my $mini_log (@mini_logs) {
  477.         appendfile("$DCONF->{admin_dir}/msg_index/$topic-log-$mini_log.txt", $data, "append_minilogs", undef);
  478.     }    
  479. }
  480.  
  481. ###
  482. ### search_stop_word_file
  483. ###
  484. ### Returns the list of stop words from the stop words file
  485. ### (or from the cache if this file has already been opened)
  486. ###
  487.  
  488. sub search_stop_word_file {
  489.     return $PARAMS->{'stop_words'} if defined $PARAMS->{'stop_words'};
  490.     my $sw = readfile("$DCONF->{admin_dir}/stopwords.conf", "search_stop_word_file", { no_lock => 1, no_unlock => 1, zero_ok => 1 } );
  491.     foreach my $x (@{$sw}) {
  492.         next if $x =~ m|^\s*#|;
  493.         next if $x !~ m|\S|;
  494.         $x =~ s/\s//g;
  495.         $x = case_lower($x);
  496.         $PARAMS->{'stop_words'}->{$x} = 1;
  497.     }
  498.     return $PARAMS->{'stop_words'};
  499. }
  500.  
  501. ###
  502. ### search_stop
  503. ###
  504. ### Removes words in "stopwords.conf" from posts for writing into search index files
  505. ###
  506.  
  507. sub search_stop {
  508.     my ($input, $flag) = @_;
  509.     my $y = remove_html($input, 1);
  510.     return $y if $GLOBAL_OPTIONS->{'search_stopwords'} eq "0";
  511.     my $l = search_stop_word_file();
  512.     my @q = ();
  513.     foreach my $k (keys(%{ $l })) { push @q, quotemeta($k); }
  514.     my $x = join("|", @q);
  515.     $y =~ s/(^|\b)($x)(\b|$)//gio;
  516.     $y =~ s/\+\+\+ (\w+) \+\+\+ (\d+) \+\+\+ (.*?) \+\+\+/\[$3\]/g;
  517.     return trim($y);
  518. }
  519.  
  520. ###
  521. ### delete_entry
  522. ###
  523. ### Removes things from the search index and the posting logs
  524. ###
  525.  
  526. sub delete_entry {
  527.     my ($arg) = @_;
  528.     if ($GLOBAL_OPTIONS->{database} && $DCONF->{pro}) {
  529.         dreq("sql-logs-PRO");
  530.         return sql_logs_delete_entry($arg);
  531.     } else {
  532.         my @f = ();
  533.         my $tcache = time;
  534.         foreach my $m (@mini_logs) {
  535.             next if $arg->{time} > ($tcache - $m*24*60*60);
  536.             push @f, "$DCONF->{admin_dir}/msg_index/$arg->{topic}-log-$m.txt";
  537.         }
  538.         push @f, "$DCONF->{admin_dir}/msg_index/$arg->{topic}-log.txt";
  539.         foreach my $file (@f) {
  540.             lock($file) if ! $arg->{files_already_locked};
  541.             my $fs = 0;
  542.             if (open (FILE, "< $file")) {
  543.                 if (open (FILE2, "> $file.new")) {
  544.                     while (<FILE>) {
  545.                         my ($msgnum) = split(/;/, $_, 2);
  546.                         if (! defined $arg->{messages}->{$msgnum}) {
  547.                             print FILE2 $_; $fs += length($_);
  548.                         }
  549.                     }
  550.                     close (FILE2);
  551.                 }
  552.                 close (FILE);
  553.                 rename_file("$file.new", $fs, "$file");
  554.             }
  555.             unlock($file) if ! $arg->{files_already_locked};
  556.         }
  557.         my $fs = 0;
  558.         lock("$DCONF->{admin_dir}/msg_index/$arg->{topic}-search.txt") if ! $arg->{files_already_locked};
  559.         if (open (FILE, "< $DCONF->{admin_dir}/msg_index/$arg->{topic}-search.txt")) {
  560.             if (open (FILE2, "> $DCONF->{admin_dir}/msg_index/$arg->{topic}-search.new")) {
  561.                 while (<FILE>) {
  562.                     my ($msgnum) = split(/\s+/, $_, 2);
  563.                     if (! defined $arg->{messages}->{$msgnum}) {
  564.                         print FILE2 $_; $fs += length($_);
  565.                     }
  566.                 }
  567.                 close (FILE2);
  568.             }
  569.             close (FILE);
  570.             rename_file("$DCONF->{admin_dir}/msg_index/$arg->{topic}-search.new", $fs, "$DCONF->{admin_dir}/msg_index/$arg->{topic}-search.txt");
  571.         }
  572.         unlock("$DCONF->{admin_dir}/msg_index/$arg->{topic}-search.txt") if ! $arg->{files_already_locked};
  573.     }
  574. }
  575.  
  576. ###
  577. ### update_entry_post_topic
  578. ###
  579. ### Another function to move posts from one topic to another
  580. ###
  581.  
  582. sub update_entry_post_topic {
  583.     my ($moved, $old, $new) = @_;
  584.     my @m = @{$moved};
  585.     foreach my $m (@m) {
  586.         $m->{old_topic} = $old;
  587.         $m->{new_topic} = $new;
  588.         $m->{postindex} = $m->{number};
  589.     }
  590.     update_entry_post_location(\@m);
  591. }
  592.  
  593. ###
  594. ### update_entry_post_location
  595. ###
  596. ### Allows moving of messages from one page to another, whether or not in
  597. ### the same topic.
  598. ###
  599.  
  600. sub update_entry_post_location {
  601.     my ($info) = @_;
  602.     return undef if ref $info ne "ARRAY";
  603.     if ($GLOBAL_OPTIONS->{database} && $DCONF->{pro}) {
  604.         dreq("sql-logs-PRO");
  605.         return sql_logs_update_entry_post_location($info);
  606.     }
  607.     my @posts = @{ $info }; 
  608.     my $timecache = time;
  609.     my $cuts = {};
  610.     my $posthash = {};
  611.     foreach my $post (@posts) {
  612.         my $x = minilog_choose_log($post->{'time'}, $timecache);
  613.         $cuts->{$x} = 1 if defined $x;
  614.         $posthash->{$post->{postindex}} = $post;
  615.     }
  616.     my $min_mini = (sort { $a <=> $b } keys(%{ $cuts }))[0];
  617.     foreach my $i (@mini_logs) {
  618.         $cuts->{$i} = 1 if $i > $min_mini;
  619.     }
  620.     my $p = $posts[0];
  621.     my @source_files = ("$DCONF->{admin_dir}/msg_index/$p->{old_topic}-log.txt");
  622.     foreach my $minilog (keys(%{ $cuts })) {
  623.         push @source_files, "$DCONF->{admin_dir}/msg_index/$p->{old_topic}-log-$minilog.txt";
  624.     }
  625.     push @source_files, "$DCONF->{admin_dir}/msg_index/$p->{old_topic}-search.txt";
  626.     my @dest_files = ("$DCONF->{admin_dir}/msg_index/$p->{new_topic}-log.txt");
  627.     foreach my $minilog (keys(%{ $cuts })) {
  628.         push @dest_files, "$DCONF->{admin_dir}/msg_index/$p->{new_topic}-log-$minilog.txt";
  629.     }
  630.     push @dest_files, "$DCONF->{admin_dir}/msg_index/$p->{new_topic}-search.txt";
  631.     foreach my $SRCFILE (@source_files) {
  632.         &lock("update_entry_post_location", $SRCFILE);
  633.         my $DSTFILE = shift @dest_files;
  634.         open (SRCFILE, "< $SRCFILE");
  635.         open (DSTFILE, "> $DSTFILE.NEW");
  636.         my $exp_len = 0;
  637.         if ($SRCFILE =~ m|\-search\.txt$|) {
  638.             if ($DSTFILE eq $SRCFILE) {
  639.                 while (my $line = <SRCFILE>) {
  640.                     my $h = search_line_to_hash($line);
  641.                     if ($posthash->{$h->{postindex}}->{new_page}) {
  642.                         $h->{page} = $posthash->{$h->{postindex}}->{new_page};
  643.                     }
  644.                     my $ln = search_hash_to_line($h);
  645.                     print DSTFILE $ln;
  646.                     $exp_len += length($ln);
  647.                 }
  648.                 close (DSTFILE);
  649.                 close (SRCFILE);
  650.                 rename_file("$DSTFILE.NEW", $exp_len, "$DSTFILE");
  651.             } else {
  652.                 my @newhash = ();
  653.                 while (my $line = <SRCFILE>) {
  654.                     my $h = search_line_to_hash($line);
  655.                     if ($posthash->{$h->{postindex}}) {
  656.                         $h->{page} = $posthash->{$h->{postindex}}->{new_page};
  657.                         $h->{topic} = $posthash->{$h->{postindex}}->{new_topic};
  658.                         my $ln = search_hash_to_line($h);
  659.                         push @newhash, $ln;
  660.                     } else {
  661.                         print DSTFILE $line;
  662.                         $exp_len += length($line);                        
  663.                     }
  664.                 }
  665.                 close (DSTFILE);
  666.                 close (SRCFILE);
  667.                 &lock("update_entry_post_location", $DSTFILE);
  668.                 open (DSTFILE, ">> $DSTFILE");
  669.                 print DSTFILE @newhash;
  670.                 close (DSTFILE);
  671.                 unlock("update_entry_post_location", $DSTFILE);
  672.                 rename_file("$DSTFILE.NEW", $exp_len, "$SRCFILE");
  673.             }
  674.         } else {
  675.             if ($DSTFILE eq $SRCFILE) {
  676.                 while (my $line = <SRCFILE>) {
  677.                     my $h = log_line_to_hash($line);
  678.                     $h->{where} = join("/", $posthash->{$h->{postindex}}->{new_topic}, $posthash->{$h->{postindex}}->{new_page}) if $posthash->{$h->{postindex}}->{new_page};
  679.                     my $ln = log_hash_to_line($h);
  680.                     print DSTFILE $ln;
  681.                     $exp_len += length($ln);
  682.                 }
  683.                 close (DSTFILE);
  684.                 close (SRCFILE);
  685.                 rename_file("$DSTFILE.NEW", $exp_len, "$DSTFILE");
  686.             } else {
  687.                 my @newhash = ();
  688.                 while (my $line = <SRCFILE>) {
  689.                     my $h = log_line_to_hash($line);
  690.                     if ($posthash->{$h->{postindex}}) {
  691.                         $h->{where} = join("/", $posthash->{$h->{postindex}}->{new_topic}, $posthash->{$h->{postindex}}->{new_page});
  692.                         my $ln = log_hash_to_line($h);
  693.                         push @newhash, $line;
  694.                     } else {
  695.                         print DSTFILE $line;
  696.                         $exp_len += length($line);                        
  697.                     }
  698.                 }
  699.                 close (DSTFILE);
  700.                 close (SRCFILE);
  701.                 &lock("update_entry_post_location", $DSTFILE);
  702.                 open (DSTFILE, ">> $DSTFILE");
  703.                 print DSTFILE @newhash;
  704.                 close (DSTFILE);
  705.                 unlock("update_entry_post_location", $DSTFILE);
  706.                 rename_file("$DSTFILE.NEW", $exp_len, "$SRCFILE");
  707.             }
  708.         }
  709.         unlock("update_entry_post_location", $SRCFILE);
  710.     }
  711. }
  712.  
  713. 1;
  714.