home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
rtsi.com
/
2014.01.www.rtsi.com.tar
/
www.rtsi.com
/
OS9
/
FAQ
/
cgi-bin
/
discus4_00
/
source
/
fcn-regn.pl
< prev
next >
Wrap
Text File
|
2009-11-06
|
18KB
|
554 lines
# FILE: fcn-regn.pl
# DESCRIPTION: Regeneration of board/incremental processing
#-------------------------------------------------------------------------------
# DISCUS COPYRIGHT NOTICE
#
# Discus is copyright (c) 2002 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.
#-------------------------------------------------------------------------------
use strict;
use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);
###
### REGEN_admin
###
### Administration interface to regeneration
###
sub REGEN_admin {
my ($FORMref) = @_;
my $result = check_password($FORMref->{username}, undef, { type_required => 'moderator' }, $FORMref->{'COOKIE'});
bad_login({ username => 1}) if ! scalar(@{ $result });
my $pid = undef;
if ($FORMref->{action} eq "regen6" && $DCONF->{pro}) {
dreq("fcn-msg-PRO");
$pid = regenerate_board_6({ esc => 0, operation => $FORMref->{operation}, description => $FORMref->{description}, topic => $FORMref->{topic}, hold => unescape($FORMref->{hold}), tempfile => $FORMref->{tempfile}, done => $FORMref->{done}, total => $FORMref->{total}, action => $FORMref->{action}, username => $result->[0]->{user}, changefile => $FORMref->{changefile} });
} elsif ($FORMref->{action} eq "appear_regen" && $FORMref->{chgurl}) {
error_message("Old URL invalid", "You did not specify a valid old URL for your board!", 0, 1) if $FORMref->{oldurl} !~ m%^https?://%;
my $chgfile = regeneration_create_change_process_file("regen_board_url_change", trim($FORMref->{oldurl}));
$pid = regenerate_board({ dbtime => defined $FORMref->{dbtime} ? $FORMref->{dbtime} : undef, esc => 0, operation => $FORMref->{operation}, description => $FORMref->{description}, topic => $FORMref->{topic}, hold => unescape($FORMref->{hold}), tempfile => $FORMref->{tempfile}, done => $FORMref->{done}, total => $FORMref->{total}, action => $FORMref->{action}, username => $result->[0]->{user}, changefile => $chgfile });
} else {
$pid = regenerate_board({ dbtime => defined $FORMref->{dbtime} ? $FORMref->{dbtime} : undef, esc => 0, operation => $FORMref->{operation}, description => $FORMref->{description}, topic => $FORMref->{topic}, hold => unescape($FORMref->{hold}), tempfile => $FORMref->{tempfile}, done => $FORMref->{done}, total => $FORMref->{total}, action => $FORMref->{action}, username => $result->[0]->{user}, changefile => $FORMref->{changefile} });
}
return regeneration_set_screen($FORMref, $pid);
}
###
### regen_level_change
###
### Changes a specified level's name (renaming subtopics)
###
sub regen_level_change {
my ($self, $levelnum, $newname) = @_;
$self->{head}->{levels}->[$levelnum]->{level_name} = $newname;
return $self;
}
###
### regen_board_url_change
###
### Changes the URL for the entire board
###
sub regen_board_url_change {
my ($self, $oldurl) = @_;
$self->{move_board_flag} = quotemeta($oldurl);
return $self;
}
###
### regen_topic_name_change
###
### Changes a topic name
###
sub regen_topic_name_change {
my ($self, $newname) = @_;
$self->{head}->{topic_name} = $newname;
return $self;
}
###
### regen_meta_tag_change
###
### Change META tags
###
sub regen_meta_tag_change {
my ($self, $descr, $keywords, $robots) = @_;
$self->{meta_description} = $descr;
$self->{meta_keywords} = $keywords;
$self->{meta_robots} = $robots;
return $self;
}
###
### regen_open_close
###
### Open and close subtopics/message pages
###
sub regen_open_close {
dreq("fcn-msg-PRO");
return regen_open_close_pro(@_);
}
###
### regen_move_page_functions
###
### Rewrites the header to reflect a new page location (moving pages)
###
sub regen_move_page_functions {
my $self = shift @_;
my %trig = map { $_, 1 } split(/,/, shift @_);
my $old_topic = shift @_;
$self->{head}->{topic_number} = shift @_;
$self->{head}->{topic_name} = shift @_;
my @l = ();
my $parent = $self->{head}->{topic_number};
while (my @j = splice @_, 0, 2) {
push @l, { level_number => $j[0], level_name => $j[1] };
}
my $flag = 0;
foreach my $q (@{ $self->{head}->{levels} }) {
$flag = 1 if $trig{$q->{level_number}};
push @l, $q if $flag == 1;
}
$self->{head}->{levels} = \@l;
if (scalar(@l) > 1) {
$parent = $l[scalar(@l)-2]->{level_number};
}
$self->{head}->{parent} = $parent;
if ($old_topic != $self->{head}->{topic_number}) {
my $new_topic = $self->{head}->{topic_number};
my $att = attachment_scan($self->{messages});
my $sdir = get_message_path($old_topic);
if (ref $att eq 'ARRAY' && scalar(@{$att})) {
my $ddir = get_message_path($new_topic);
foreach my $Z (@{$att}) {
$self->{messages}->[$Z->{counter}]->{text} =~ s%/$old_topic/$Z->{filename}%/$new_topic/$Z->{filename}%gi;
writefile_binary("$ddir/$Z->{filename}", readfile_binary("$sdir/$Z->{filename}")) && unlink "$sdir/$Z->{filename}";
}
$self->{general}->{messages_raw} = 0;
}
unlink "$sdir/$self->{head}->{me_number}.$DCONF->{ext}";
}
return $self;
}
###
### regeneration_set_screen
###
### Sets you back to the "done" screen based on action
###
sub regeneration_set_screen {
my ($FORMref, $tinfo) = @_;
$FORMref->{action} =~ m|^regen(\d+)|;
my $a = $1;
if ($a == 1) {
dreq("adm-accs");
$FORMref->{action} = "access_mgr_2";
$FORMref->{topic} = (regeneration_parse_hold($FORMref->{hold}))->{topic};
ACCESS_admin($FORMref);
}
if ($a == 3 || $a == 4) {
dreq("adm-page");
hash_merge($FORMref, regeneration_parse_hold($FORMref->{hold}), 1);
$FORMref->{menu} = 2;
$FORMref->{action} = "pm-page_editor";
PAGE_admin($FORMref);
}
if ($a == 6) {
dreq("adm-page");
hash_merge($FORMref, regeneration_parse_hold($FORMref->{hold}), 1);
$FORMref->{menu} = 5;
$FORMref->{action} = "pm-page_editor";
PAGE_admin($FORMref);
}
if ($a == 5) {
dreq("adm-tpc");
$FORMref->{menu} = 0;
$FORMref->{action} = "topic_mgmt";
$FORMref->{SELECTION_who} = (regeneration_parse_hold($FORMref->{hold}))->{topic};
$FORMref->{SELECTION_action} = "p";
$FORMref->{renamed} = "1" if (regeneration_parse_hold($FORMref->{hold}))->{action} eq "rename";
$FORMref->{metasave} = "1" if (regeneration_parse_hold($FORMref->{hold}))->{action} eq "meta";
TOPIC_admin($FORMref);
}
if ($a == 7) {
dreq("adm-dr");
$FORMref->{menu} = 1;
$FORMref->{action} = "data_recovery";
DR_admin($FORMref);
}
dreq("topic-pg");
regenerate_topic_page();
return $tinfo;
}
###
### regeneration_parse_hold
###
### Gets data for "held" variables
###
sub regeneration_parse_hold {
my ($hold) = @_;
my @u = split(/&/, unescape($hold));
my $i = {};
foreach my $k (@u) {
if ($k =~ m|^(\w+)=(.*)|) {
$i->{$1} = $2;
}
}
return $i;
}
###
### regeneration_create_hold
###
### Create string for held variables
###
sub regeneration_create_hold {
my ($hold_hash) = @_;
my @j = ();
foreach my $k (keys(%{ $hold_hash })) {
push @j, join('=', $k, escape($hold_hash->{$k}));
}
return join('&',@j);
}
###
### regeneration_get_saved_changes
###
### Figures out what the changes are that you saved, between regenerations
###
sub regeneration_get_saved_changes {
my ($chgfile) = @_;
$chgfile =~ s/\D//g;
if (-e "$DCONF->{admin_dir}/backups/CHG$chgfile.TMP") {
open (FILE, "< $DCONF->{admin_dir}/backups/CHG$chgfile.TMP");
my @u = <FILE>;
close (FILE);
foreach my $line (@u) {
chomp $line;
}
return \@u;
}
my @l = ();
return \@l;
}
###
### regeneration_taskman_gauge_substitute
###
### Creates a new task manager job instead of displaying the gauge
###
sub regeneration_taskman_gauge_substitute {
my ($arg) = @_;
my @a = ($arg, 1);
dreq("dtaskman");
return taskman_create_job("regenerate_board", "fcn-regn", \@a);
}
###
### regeneration_resource_init
###
### Initializes resource tracking
###
sub regeneration_resource_init {
my @cpu = ('2', '3', '5', '9', '29');
my @mem = ('1.5', '3', '7', '15', '63');
my $memused = 150000; ## Estimated overhead, 150 kB
my $memindex = 2 + $GLOBAL_OPTIONS->{mem_usage};
my $cpuindex = 2 + $GLOBAL_OPTIONS->{cpu_usage};
my $memmax = 1000000 * $mem[$memindex]; ## Trigger for reset
my $cpumax = $cpu[$cpuindex] + time; ## Trigger for reset
my $oh = {};
$oh->{cpumax} = $cpumax;
$oh->{memmax} = $memmax;
$oh->{processed} = 0;
$oh->{memused} = 0;
return $oh;
}
###
### regeneration_resource_estimate
###
### Estimates the resources (CPU cycles and memory usage) of a regeneration operation
###
sub regeneration_resource_estimate {
my ($self, $processed, $len) = @_;
$self->{memused} += $len;
$self->{processed} += $processed;
return $self;
}
###
### regenerate_board
###
### Regenerates the entire board, or selected topics, optionally making some
### changes to each page being regenerated.
###
sub regenerate_board {
my ($arg, $taskman, $force_taskman_off) = @_;
my $flag = ($GLOBAL_OPTIONS->{discus_taskman} * $GLOBAL_OPTIONS->{taskman_regen} * (1 - $force_taskman_off));
if ($flag && ! $taskman) {
my @a = ($arg, 1);
dreq("dtaskman");
return taskman_create_job("regenerate_board", "fcn-regn", \@a);
}
if ($arg->{esc} == 1 && ! $taskman) {
my $H = { changefile => $arg->{changefile}, hold => $arg->{hold}, total => $arg->{total}, action => $arg->{action}, username => $arg->{username}, tempfile => $arg->{tempfile}, operation => $arg->{operation}, description => $arg->{description}, percent => 0 };
return regeneration_gauge($H);
}
if ($arg->{tempfile} eq "") {
my $topics = defined $arg->{topic} ? $arg->{topic} : undef;
my $i = incremental({ operation => "build", topic => $topics, changefile => $arg->{changefile} });
my $H = { changefile => $arg->{changefile}, hold => $arg->{hold}, total => $i->{count}, action => $arg->{action}, username => $arg->{username}, tempfile => $i->{tempfile}, operation => $arg->{operation}, description => $arg->{description}, percent => 0 };
return regeneration_taskman_gauge_substitute($H) if $taskman;
return regeneration_gauge($H);
}
if (defined $arg->{dbtime} && $arg->{dbtime} > 0) {
$PARAMS->{tree_db_name} = $arg->{dbtime};
$PARAMS->{tree_db_name} =~ s/\D//g;
}
dreq("fcn-usrp");
my $priv = read_topic_privilege_file(1);
my $i = incremental({ tempfile => $arg->{tempfile}, operation => "read" });
my $R = regeneration_resource_init();
my $last_topic_number = 0;
my $tree = undef;
my $changes = regeneration_get_saved_changes($arg->{changefile}) if $arg->{changefile} ne "";
my $tpc = 0;
my @mvp = ();
lock("*");
while (my $f = shift @{ $i->{data} }) {
chomp $f;
my ($topic, $page) = ($f =~ m|^(\d+)/(\d+)|);
if ($last_topic_number == 0) {
$last_topic_number = $topic;
$tpc = $topic;
$tpc = $changes->[3] if ref $changes eq 'ARRAY' && $changes->[0] eq "regen_move_page_functions";
$tree = defined $arg->{tree} ? $arg->{tree} : read_tree($tpc, { no_unlock => 1, no_lock => 1 });
} elsif ($last_topic_number != $topic) {
unshift(@{ $i->{data} }, "$f\n");
last;
}
my $pinfo = GetPage($topic, $page, { no_error => 1 });
next if $pinfo->{head}->{me_number} != $page;
$pinfo = regeneration_process_changes($pinfo, $changes);
$pinfo->{general}->{subtopic_raw} = 0;
$pinfo->{general}->{messages_raw} = 0;
if (ref $pinfo->{sublist} eq 'ARRAY' && scalar @{ $pinfo->{sublist} } > 0) {
$pinfo->{sublist} = expand_sublist($pinfo->{sublist}, $tpc, $tree);
}
if ($pinfo->{move_board_flag}) {
my $Z = SetPage($pinfo, { return_val => 1, privcache => $priv });
my $q = $pinfo->{move_board_flag};
$Z =~ s/$q/$DCONF->{html_url}/g;
my $filename = join("/", get_message_path($topic), "$page.$DCONF->{ext}");
writefile_binary($filename, $Z);
$pinfo->{general}->{'length'} *= 2;
} else {
SetPage($pinfo, {privcache => $priv});
}
push @mvp, @{$pinfo->{messages}};
$R = regeneration_resource_estimate($R, 1, $pinfo->{general}->{'length'});
last if regeneration_reset_trigger($R);
}
unlock("*");
if (ref $changes eq 'ARRAY' && $changes->[0] eq "regen_move_page_functions") {
if ($changes->[2] != $changes->[3]) {
dreq("fcn-logs");
update_entry_post_topic(\@mvp, $changes->[2], $changes->[3]);
}
}
my $iw = incremental({ operation => 3, data => $i->{data}, tempfile => $arg->{tempfile} });
if ($iw->{'continue'}) {
my $H = { dbtime => $PARAMS->{tree_db_name}, changefile => $arg->{changefile}, hold => $arg->{hold}, done => ($R->{processed} + $arg->{done}), total => $arg->{total}, action => $arg->{action}, username => $arg->{username}, tempfile => $i->{tempfile}, operation => $arg->{operation}, description => $arg->{description} };
return regeneration_taskman_gauge_substitute($H) if $flag && $taskman;
return regeneration_gauge($H);
}
unlink "$DCONF->{admin_dir}/backups/CHG$arg->{changefile}.TMP";
return 1;
}
###
### regeneration_create_change_process_file
###
### Creates a file to hold regeneration changes
###
sub regeneration_create_change_process_file {
my @z = map { join("", escape($_), "\n") } @_;
my $i = join("", $$, time, scalar(@z), length(join("", @z))); $i =~ s/\D//g;
$i += int(rand(10)) while -r "$DCONF->{admin_dir}/backups/CHG$i.TMP";
open (FILE, "> $DCONF->{admin_dir}/backups/CHG$i.TMP");
print FILE @z;
close (FILE);
return $i;
}
###
### regeneration_process_changes
###
### Applies changes to page info in accordance with changes
###
sub regeneration_process_changes {
my $self = shift;
my ($changes) = @_;
return $self if ref $changes ne 'ARRAY';
return $self if scalar(@{$changes}) == 0;
my @ch = map { if (ref $_ ne 'ARRAY') { chomp; unescape($_) } else { $_ } } @{$changes};
my $ch_sub = shift @ch;
return $self if $ch_sub eq "";
my $code = \&{$ch_sub};
return $code->($self, @ch);
}
###
### regeneration_reset_trigger
###
### Tests if the reset trigger has been reached (CPU or memory usage
### exceeded)
###
sub regeneration_reset_trigger {
my $R = shift @_;
my $memory_max = $R->{memmax};
my $cpu_max = $R->{cpumax};
my $memory_used = $R->{memused};
return 1 if $memory_max <= $memory_used;
return 1 if $cpu_max <= time;
return 0;
}
###
### regeneration_gauge
###
### Provides for gauge when regenerating board
###
sub regeneration_gauge {
my ($arg) = @_;
undef my $subst;
$subst->{'gauge'}->{'refresh_url'} = "$PARAMS->{cgiurl}?hold=" . escape($arg->{hold}) . "&dbtime=$arg->{dbtime}&action=$arg->{action}&username=$arg->{username}&tempfile=$arg->{tempfile}&total=$arg->{total}&done=$arg->{done}&changefile=$arg->{changefile}&operation=$arg->{operation}&description=$arg->{description}";
$subst->{'gauge'}->{'operation'} = $arg->{operation} ne "" ? $arg->{operation} : 2;
$subst->{'gauge'}->{'description'} = $arg->{description} ne "" ? $arg->{description} : 99;
$subst->{'gauge'}->{'total'} = (defined $arg->{total} ? $arg->{total} : 1);
$subst->{'gauge'}->{'done'} = (defined $arg->{done} ? $arg->{done} : 0);
$subst->{'gauge'}->{'percent'} = (defined $arg->{percent} ? $arg->{percent} : ($arg->{total} > 0 ? (int(100*$arg->{done}/$arg->{total})) : 0));
screen_out("gauge", $subst);
}
###
### incremental_descendants
###
### Gets files that are descendants of a particular page
###
sub incremental_descendants {
my ($topic, $start, $suffix, $tree, $catq, $l1, $tbco, $noarch) = @_;
if (! defined $tbco) {
dreq("fcn-tree");
my $tf = defined $tree ? $tree : read_tree($topic, { no_lock => 1, no_unlock => 1 });
my $cat = defined $catq ? $catq : tree_categorize($tf);
$tbco = tree_build_children_of($tf, $cat, $start);
}
my $tempfile = join("", $$, time, $suffix); $tempfile =~ s/\W//g;
my @u = tree_dump_into_array($tbco);
@u = grep($_->{islink} == 0, @u);
@u = grep($_->{param} =~ /Archive/, @u) if $noarch == 2;
@u = grep($_->{param} !~ /Archive/, @u) if $noarch == 1;
my @file = map { join("/", $topic, $_->{page}) } @u;
if (ref $l1 eq 'ARRAY') {
my @l1 = @{$l1};
@l1 = grep($_->{islink} == 0, @l1);
unshift @file, map { join("/", $_->{topic}, $_->{page}) } @l1;
}
writefile("$DCONF->{admin_dir}/backups/$tempfile.TMP", \@file, "incremental_descendants", { no_lock => 1, no_unlock => 1, no_backup => 1 });
return { data => \@file, tempfile => $tempfile, count => scalar(@file) };
}
###
### incremental
###
### Provides incremental operations (process only part of the files
### at once)
###
sub incremental {
my ($arg) = @_;
if ($arg->{operation} eq "build" || $arg->{operation} == 1) {
my $AT = {};
if (ref $arg->{topic} eq "HASH") {
$AT = $arg->{topic};
} elsif ($arg->{topic} !~ m|^\d+$|) {
my $tsin = board_topics();
foreach my $q (@{ $tsin }) {
$AT->{ $q->{number} } = 1 if $q->{type} == 1;
}
} else {
$AT->{$arg->{topic}} = 1;
}
if ($arg->{tempfile} eq "") {
$arg->{tempfile} = join("", $$, time, $arg->{suffix});
$arg->{tempfile} =~ s/\W//g;
}
undef my @file;
foreach my $tpc (keys(%{ $AT })) {
next if $tpc eq "";
my $dir = get_message_path($tpc);
my $ext = $DCONF->{ext};
if (opendir(DIR, $dir)) {
push @file, map {"$tpc/$_"} grep {/^\d+\.$ext$/} readdir DIR;
closedir(DIR);
}
}
writefile("$DCONF->{admin_dir}/backups/$arg->{tempfile}.TMP", \@file, "incremental", { no_lock => 1, no_unlock => 1, no_backup => 1 });
my $result = {};
$result->{'data'} = \@file;
$result->{'tempfile'} = $arg->{tempfile};
$result->{'count'} = scalar(@file);
return $result;
}
$arg->{tempfile} =~ s/[^\w\-]//g;
if ($arg->{operation} eq "read" || $arg->{operation} == 2) {
undef my $result;
$result->{data} = readfile("$DCONF->{admin_dir}/backups/$arg->{tempfile}.TMP", "incremental", { no_lock => 1, no_unlock => 1,zero_ok=>1});
$result->{tempfile} = $arg->{tempfile};
$result->{count} = scalar(@{ $result->{data} });
return $result;
}
if ($arg->{operation} eq "write" || $arg->{operation} == 3) {
if (scalar(@{ $arg->{data}})) {
writefile("$DCONF->{admin_dir}/backups/$arg->{tempfile}.TMP", $arg->{data}, "incremental", { no_lock => 1, no_unlock => 1, no_backup => 1 });
return { continue => 1 };
} else {
unlink("$DCONF->{admin_dir}/backups/$arg->{tempfile}.TMP");
return { continue => 0 };
}
}
}
1;