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-regn.pl < prev    next >
Text File  |  2009-11-06  |  18KB  |  554 lines
  1. # FILE: fcn-regn.pl
  2. # DESCRIPTION: Regeneration of board/incremental processing
  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. ### REGEN_admin
  20. ###
  21. ### Administration interface to regeneration
  22. ###
  23.  
  24. sub REGEN_admin {
  25.     my ($FORMref) = @_;
  26.     my $result = check_password($FORMref->{username}, undef, { type_required => 'moderator' }, $FORMref->{'COOKIE'});
  27.     bad_login({ username => 1}) if ! scalar(@{ $result });
  28.     my $pid = undef;
  29.     if ($FORMref->{action} eq "regen6" && $DCONF->{pro}) {
  30.         dreq("fcn-msg-PRO");
  31.         $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} });
  32.     } elsif ($FORMref->{action} eq "appear_regen" && $FORMref->{chgurl}) {
  33.         error_message("Old URL invalid", "You did not specify a valid old URL for your board!", 0, 1) if $FORMref->{oldurl} !~ m%^https?://%;
  34.         my $chgfile = regeneration_create_change_process_file("regen_board_url_change", trim($FORMref->{oldurl}));
  35.         $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 });
  36.     } else {
  37.         $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} });
  38.     }
  39.     return regeneration_set_screen($FORMref, $pid);
  40. }
  41.  
  42. ###
  43. ### regen_level_change
  44. ###
  45. ### Changes a specified level's name (renaming subtopics)
  46. ###
  47.  
  48. sub regen_level_change {
  49.     my ($self, $levelnum, $newname) = @_;
  50.     $self->{head}->{levels}->[$levelnum]->{level_name} = $newname;
  51.     return $self;
  52. }
  53.  
  54. ###
  55. ### regen_board_url_change
  56. ###
  57. ### Changes the URL for the entire board
  58. ###
  59.  
  60. sub regen_board_url_change {
  61.     my ($self, $oldurl) = @_;
  62.     $self->{move_board_flag} = quotemeta($oldurl);
  63.     return $self;
  64. }
  65.  
  66.  
  67. ###
  68. ### regen_topic_name_change
  69. ###
  70. ### Changes a topic name
  71. ###
  72.  
  73. sub regen_topic_name_change {
  74.     my ($self, $newname) = @_;
  75.     $self->{head}->{topic_name} = $newname;
  76.     return $self;
  77. }
  78.  
  79. ###
  80. ### regen_meta_tag_change
  81. ###
  82. ### Change META tags
  83. ###
  84.  
  85. sub regen_meta_tag_change {
  86.     my ($self, $descr, $keywords, $robots) = @_;
  87.     $self->{meta_description} = $descr;
  88.     $self->{meta_keywords} = $keywords;
  89.     $self->{meta_robots} = $robots;
  90.     return $self;
  91. }
  92.  
  93. ###
  94. ### regen_open_close
  95. ###
  96. ### Open and close subtopics/message pages
  97. ###
  98.  
  99. sub regen_open_close {
  100.     dreq("fcn-msg-PRO");
  101.     return regen_open_close_pro(@_);
  102. }
  103.  
  104.  
  105. ###
  106. ### regen_move_page_functions
  107. ###
  108. ### Rewrites the header to reflect a new page location (moving pages)
  109. ###
  110.  
  111. sub regen_move_page_functions {
  112.     my $self = shift @_;
  113.     my %trig = map { $_, 1 } split(/,/, shift @_);
  114.     my $old_topic = shift @_;
  115.     $self->{head}->{topic_number} = shift @_;
  116.     $self->{head}->{topic_name} = shift @_;
  117.     my @l = ();
  118.     my $parent = $self->{head}->{topic_number};
  119.     while (my @j = splice @_, 0, 2) {
  120.         push @l, { level_number => $j[0], level_name => $j[1] };
  121.     }
  122.     my $flag = 0;
  123.     foreach my $q (@{ $self->{head}->{levels} }) {
  124.         $flag = 1 if $trig{$q->{level_number}};
  125.         push @l, $q if $flag == 1;
  126.     }
  127.     $self->{head}->{levels} = \@l;
  128.     if (scalar(@l) > 1) {
  129.         $parent = $l[scalar(@l)-2]->{level_number};
  130.     }
  131.     $self->{head}->{parent} = $parent;
  132.     if ($old_topic != $self->{head}->{topic_number}) {
  133.         my $new_topic = $self->{head}->{topic_number};
  134.         my $att = attachment_scan($self->{messages});
  135.         my $sdir = get_message_path($old_topic);
  136.         if (ref $att eq 'ARRAY' && scalar(@{$att})) {
  137.             my $ddir = get_message_path($new_topic);
  138.             foreach my $Z (@{$att}) {
  139.                 $self->{messages}->[$Z->{counter}]->{text} =~ s%/$old_topic/$Z->{filename}%/$new_topic/$Z->{filename}%gi;
  140.                 writefile_binary("$ddir/$Z->{filename}", readfile_binary("$sdir/$Z->{filename}")) && unlink "$sdir/$Z->{filename}";
  141.             }
  142.             $self->{general}->{messages_raw} = 0;
  143.         }
  144.         unlink "$sdir/$self->{head}->{me_number}.$DCONF->{ext}";
  145.     }
  146.     return $self;
  147. }
  148.  
  149. ###
  150. ### regeneration_set_screen
  151. ###
  152. ### Sets you back to the "done" screen based on action
  153. ###
  154.  
  155. sub regeneration_set_screen {
  156.     my ($FORMref, $tinfo) = @_;
  157.     $FORMref->{action} =~ m|^regen(\d+)|;
  158.     my $a = $1;
  159.     if ($a == 1) {
  160.         dreq("adm-accs");
  161.         $FORMref->{action} = "access_mgr_2";
  162.         $FORMref->{topic} = (regeneration_parse_hold($FORMref->{hold}))->{topic};
  163.         ACCESS_admin($FORMref);
  164.     }
  165.     if ($a == 3 || $a == 4) {
  166.         dreq("adm-page");
  167.         hash_merge($FORMref, regeneration_parse_hold($FORMref->{hold}), 1);
  168.         $FORMref->{menu} = 2;
  169.         $FORMref->{action} = "pm-page_editor";
  170.         PAGE_admin($FORMref);
  171.     }
  172.     if ($a == 6) {
  173.         dreq("adm-page");
  174.         hash_merge($FORMref, regeneration_parse_hold($FORMref->{hold}), 1);
  175.         $FORMref->{menu} = 5;
  176.         $FORMref->{action} = "pm-page_editor";
  177.         PAGE_admin($FORMref);
  178.     }
  179.     if ($a == 5) {
  180.         dreq("adm-tpc");
  181.         $FORMref->{menu} = 0;
  182.         $FORMref->{action} = "topic_mgmt";
  183.         $FORMref->{SELECTION_who} = (regeneration_parse_hold($FORMref->{hold}))->{topic};
  184.         $FORMref->{SELECTION_action} = "p";
  185.         $FORMref->{renamed} = "1" if (regeneration_parse_hold($FORMref->{hold}))->{action} eq "rename";
  186.         $FORMref->{metasave} = "1" if (regeneration_parse_hold($FORMref->{hold}))->{action} eq "meta";
  187.         TOPIC_admin($FORMref);
  188.     }
  189.     if ($a == 7) {
  190.         dreq("adm-dr");
  191.         $FORMref->{menu} = 1;
  192.         $FORMref->{action} = "data_recovery";
  193.         DR_admin($FORMref);
  194.     }
  195.     dreq("topic-pg");
  196.     regenerate_topic_page();
  197.     return $tinfo;
  198. }
  199.  
  200. ###
  201. ### regeneration_parse_hold
  202. ###
  203. ### Gets data for "held" variables
  204. ###
  205.  
  206. sub regeneration_parse_hold {
  207.     my ($hold) = @_;
  208.     my @u = split(/&/, unescape($hold));
  209.     my $i = {};
  210.     foreach my $k (@u) {
  211.         if ($k =~ m|^(\w+)=(.*)|) {
  212.             $i->{$1} = $2;
  213.         }
  214.     }
  215.     return $i;
  216. }
  217.  
  218. ###
  219. ### regeneration_create_hold
  220. ###
  221. ### Create string for held variables
  222. ###
  223.  
  224. sub regeneration_create_hold {
  225.     my ($hold_hash) = @_;
  226.     my @j = ();
  227.     foreach my $k (keys(%{ $hold_hash })) {
  228.         push @j, join('=', $k, escape($hold_hash->{$k}));
  229.     }
  230.     return join('&',@j);
  231. }
  232.  
  233. ###
  234. ### regeneration_get_saved_changes
  235. ###
  236. ### Figures out what the changes are that you saved, between regenerations
  237. ###
  238.  
  239. sub regeneration_get_saved_changes {
  240.     my ($chgfile) = @_;
  241.     $chgfile =~ s/\D//g;
  242.     if (-e "$DCONF->{admin_dir}/backups/CHG$chgfile.TMP") {
  243.         open (FILE, "< $DCONF->{admin_dir}/backups/CHG$chgfile.TMP");
  244.         my @u = <FILE>;
  245.         close (FILE);
  246.         foreach my $line (@u) {
  247.             chomp $line;
  248.         }
  249.         return \@u;
  250.     }
  251.     my @l = ();
  252.     return \@l;
  253. }
  254.  
  255. ###
  256. ### regeneration_taskman_gauge_substitute
  257. ###
  258. ### Creates a new task manager job instead of displaying the gauge
  259. ###
  260.  
  261. sub regeneration_taskman_gauge_substitute {
  262.     my ($arg) = @_;
  263.     my @a = ($arg, 1);
  264.     dreq("dtaskman");
  265.     return taskman_create_job("regenerate_board", "fcn-regn", \@a);
  266. }
  267.  
  268. ###
  269. ### regeneration_resource_init
  270. ###
  271. ### Initializes resource tracking
  272. ###
  273.  
  274. sub regeneration_resource_init {
  275.     my @cpu = ('2', '3', '5', '9', '29');
  276.     my @mem = ('1.5', '3', '7', '15', '63');
  277.     my $memused = 150000;                                ## Estimated overhead, 150 kB
  278.     my $memindex = 2 + $GLOBAL_OPTIONS->{mem_usage};
  279.     my $cpuindex = 2 + $GLOBAL_OPTIONS->{cpu_usage};
  280.     my $memmax = 1000000 * $mem[$memindex];                ## Trigger for reset
  281.     my $cpumax = $cpu[$cpuindex] + time;                ## Trigger for reset
  282.     my $oh = {};
  283.     $oh->{cpumax} = $cpumax;
  284.     $oh->{memmax} = $memmax;
  285.     $oh->{processed} = 0;
  286.     $oh->{memused} = 0;
  287.     return $oh;
  288. }
  289.  
  290. ###
  291. ### regeneration_resource_estimate
  292. ###
  293. ### Estimates the resources (CPU cycles and memory usage) of a regeneration operation
  294. ###
  295.  
  296. sub regeneration_resource_estimate {
  297.     my ($self, $processed, $len) = @_;
  298.     $self->{memused} += $len;
  299.     $self->{processed} += $processed;
  300.     return $self;
  301. }
  302.  
  303. ###
  304. ### regenerate_board
  305. ###
  306. ### Regenerates the entire board, or selected topics, optionally making some
  307. ### changes to each page being regenerated.
  308. ###
  309.  
  310. sub regenerate_board {
  311.     my ($arg, $taskman, $force_taskman_off) = @_;
  312.     my $flag = ($GLOBAL_OPTIONS->{discus_taskman} * $GLOBAL_OPTIONS->{taskman_regen} * (1 - $force_taskman_off));
  313.     if ($flag && ! $taskman) {
  314.         my @a = ($arg, 1);
  315.         dreq("dtaskman");
  316.         return taskman_create_job("regenerate_board", "fcn-regn", \@a);
  317.     }
  318.     if ($arg->{esc} == 1 && ! $taskman) {
  319.         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 };
  320.         return regeneration_gauge($H);
  321.     }
  322.     if ($arg->{tempfile} eq "") {
  323.         my $topics = defined $arg->{topic} ? $arg->{topic} : undef;
  324.         my $i = incremental({ operation => "build", topic => $topics, changefile => $arg->{changefile} });
  325.         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 };
  326.         return regeneration_taskman_gauge_substitute($H) if $taskman;
  327.         return regeneration_gauge($H);
  328.     }
  329.     if (defined $arg->{dbtime} && $arg->{dbtime} > 0) {
  330.         $PARAMS->{tree_db_name} = $arg->{dbtime};
  331.         $PARAMS->{tree_db_name} =~ s/\D//g;
  332.     }
  333.     dreq("fcn-usrp");
  334.     my $priv = read_topic_privilege_file(1);
  335.     my $i = incremental({ tempfile => $arg->{tempfile}, operation => "read" });
  336.     my $R = regeneration_resource_init();
  337.     my $last_topic_number = 0;
  338.     my $tree = undef;
  339.     my $changes = regeneration_get_saved_changes($arg->{changefile}) if $arg->{changefile} ne "";
  340.     my $tpc = 0;
  341.     my @mvp = ();
  342.     lock("*");
  343.     while (my $f = shift @{ $i->{data} }) {
  344.         chomp $f;
  345.         my ($topic, $page) = ($f =~ m|^(\d+)/(\d+)|);
  346.         if ($last_topic_number == 0) {
  347.             $last_topic_number = $topic;
  348.             $tpc = $topic;
  349.             $tpc = $changes->[3] if ref $changes eq 'ARRAY' && $changes->[0] eq "regen_move_page_functions";
  350.             $tree = defined $arg->{tree} ? $arg->{tree} : read_tree($tpc, { no_unlock => 1, no_lock => 1 });
  351.         } elsif ($last_topic_number != $topic) {
  352.             unshift(@{ $i->{data} }, "$f\n");
  353.             last;
  354.         }
  355.         my $pinfo = GetPage($topic, $page, { no_error => 1 });
  356.         next if $pinfo->{head}->{me_number} != $page;
  357.         $pinfo = regeneration_process_changes($pinfo, $changes);
  358.         $pinfo->{general}->{subtopic_raw} = 0;
  359.         $pinfo->{general}->{messages_raw} = 0;
  360.         if (ref $pinfo->{sublist} eq 'ARRAY' && scalar @{ $pinfo->{sublist} } > 0) {
  361.             $pinfo->{sublist} = expand_sublist($pinfo->{sublist}, $tpc, $tree);
  362.         }
  363.         if ($pinfo->{move_board_flag}) {
  364.             my $Z = SetPage($pinfo, { return_val => 1, privcache => $priv });
  365.             my $q = $pinfo->{move_board_flag};
  366.             $Z =~ s/$q/$DCONF->{html_url}/g;
  367.             my $filename = join("/", get_message_path($topic), "$page.$DCONF->{ext}");
  368.             writefile_binary($filename, $Z);
  369.             $pinfo->{general}->{'length'} *= 2;
  370.         } else {
  371.             SetPage($pinfo, {privcache => $priv});
  372.         }
  373.         push @mvp, @{$pinfo->{messages}};
  374.         $R = regeneration_resource_estimate($R, 1, $pinfo->{general}->{'length'});
  375.         last if regeneration_reset_trigger($R);
  376.     }
  377.     unlock("*");
  378.     if (ref $changes eq 'ARRAY' && $changes->[0] eq "regen_move_page_functions") {
  379.         if ($changes->[2] != $changes->[3]) {
  380.             dreq("fcn-logs");
  381.             update_entry_post_topic(\@mvp, $changes->[2], $changes->[3]);
  382.         }
  383.     }
  384.     my $iw = incremental({ operation => 3, data => $i->{data}, tempfile => $arg->{tempfile} });
  385.     if ($iw->{'continue'}) {
  386.         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} };
  387.         return regeneration_taskman_gauge_substitute($H) if $flag && $taskman;
  388.         return regeneration_gauge($H);
  389.     }
  390.     unlink "$DCONF->{admin_dir}/backups/CHG$arg->{changefile}.TMP";
  391.     return 1;
  392. }
  393.  
  394. ###
  395. ### regeneration_create_change_process_file
  396. ###
  397. ### Creates a file to hold regeneration changes
  398. ###
  399.  
  400. sub regeneration_create_change_process_file {
  401.     my @z = map { join("", escape($_), "\n") } @_;
  402.     my $i = join("", $$, time, scalar(@z), length(join("", @z))); $i =~ s/\D//g;
  403.     $i += int(rand(10)) while -r "$DCONF->{admin_dir}/backups/CHG$i.TMP";
  404.     open (FILE, "> $DCONF->{admin_dir}/backups/CHG$i.TMP");
  405.     print FILE @z;
  406.     close (FILE);
  407.     return $i;
  408. }
  409.  
  410. ###
  411. ### regeneration_process_changes
  412. ###
  413. ### Applies changes to page info in accordance with changes
  414. ###
  415.  
  416. sub regeneration_process_changes {
  417.     my $self = shift;
  418.     my ($changes) = @_;
  419.     return $self if ref $changes ne 'ARRAY';
  420.     return $self if scalar(@{$changes}) == 0;
  421.     my @ch = map { if (ref $_ ne 'ARRAY') { chomp; unescape($_) } else { $_ } } @{$changes};
  422.     my $ch_sub = shift @ch;
  423.     return $self if $ch_sub eq "";
  424.     my $code = \&{$ch_sub};
  425.     return $code->($self, @ch);
  426. }
  427.  
  428. ###
  429. ### regeneration_reset_trigger
  430. ###
  431. ### Tests if the reset trigger has been reached (CPU or memory usage
  432. ### exceeded)
  433. ###
  434.  
  435. sub regeneration_reset_trigger {
  436.     my $R = shift @_;
  437.     my $memory_max = $R->{memmax};
  438.     my $cpu_max = $R->{cpumax};
  439.     my $memory_used = $R->{memused};
  440.     return 1 if $memory_max <= $memory_used;
  441.     return 1 if $cpu_max <= time;
  442.     return 0;
  443. }
  444.  
  445. ###
  446. ### regeneration_gauge
  447. ###
  448. ### Provides for gauge when regenerating board
  449. ###
  450.  
  451. sub regeneration_gauge {
  452.     my ($arg) = @_;
  453.     undef my $subst;
  454.     $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}";
  455.     $subst->{'gauge'}->{'operation'} = $arg->{operation} ne "" ? $arg->{operation} : 2;
  456.     $subst->{'gauge'}->{'description'} = $arg->{description} ne "" ? $arg->{description} : 99;
  457.     $subst->{'gauge'}->{'total'} = (defined $arg->{total} ? $arg->{total} : 1);
  458.     $subst->{'gauge'}->{'done'} = (defined $arg->{done} ? $arg->{done} : 0);
  459.     $subst->{'gauge'}->{'percent'} = (defined $arg->{percent} ? $arg->{percent} : ($arg->{total} > 0 ? (int(100*$arg->{done}/$arg->{total})) : 0));
  460.     screen_out("gauge", $subst);
  461. }
  462.  
  463. ###
  464. ### incremental_descendants
  465. ###
  466. ### Gets files that are descendants of a particular page
  467. ###
  468.  
  469. sub incremental_descendants {
  470.     my ($topic, $start, $suffix, $tree, $catq, $l1, $tbco, $noarch) = @_;
  471.     if (! defined $tbco) {
  472.         dreq("fcn-tree");
  473.         my $tf = defined $tree ? $tree : read_tree($topic, { no_lock => 1, no_unlock => 1 });
  474.         my $cat = defined $catq ? $catq : tree_categorize($tf);
  475.         $tbco = tree_build_children_of($tf, $cat, $start);
  476.     }
  477.     my $tempfile = join("", $$, time, $suffix); $tempfile =~ s/\W//g;
  478.     my @u = tree_dump_into_array($tbco);
  479.     @u = grep($_->{islink} == 0, @u);
  480.     @u = grep($_->{param} =~ /Archive/, @u) if $noarch == 2;
  481.     @u = grep($_->{param} !~ /Archive/, @u) if $noarch == 1;
  482.     my @file = map { join("/", $topic, $_->{page}) } @u;
  483.     if (ref $l1 eq 'ARRAY') {
  484.         my @l1 = @{$l1};
  485.         @l1 = grep($_->{islink} == 0, @l1);
  486.         unshift @file, map { join("/", $_->{topic}, $_->{page}) } @l1;
  487.     }
  488.     writefile("$DCONF->{admin_dir}/backups/$tempfile.TMP", \@file, "incremental_descendants", { no_lock => 1, no_unlock => 1, no_backup => 1 });
  489.     return { data => \@file, tempfile => $tempfile, count => scalar(@file) };
  490. }
  491.  
  492. ###
  493. ### incremental
  494. ###
  495. ### Provides incremental operations (process only part of the files
  496. ### at once)
  497. ###
  498.  
  499. sub incremental {
  500.     my ($arg) = @_;
  501.     if ($arg->{operation} eq "build" || $arg->{operation} == 1) {
  502.         my $AT = {};
  503.         if (ref $arg->{topic} eq "HASH") {
  504.             $AT = $arg->{topic};
  505.         } elsif ($arg->{topic} !~ m|^\d+$|) {
  506.             my $tsin = board_topics();
  507.             foreach my $q (@{ $tsin }) {
  508.                 $AT->{ $q->{number} } = 1 if $q->{type} == 1;
  509.             }
  510.         } else {
  511.             $AT->{$arg->{topic}} = 1;
  512.         }
  513.         if ($arg->{tempfile} eq "") {
  514.             $arg->{tempfile} = join("", $$, time, $arg->{suffix});
  515.             $arg->{tempfile} =~ s/\W//g;
  516.         }
  517.         undef my @file;
  518.         foreach my $tpc (keys(%{ $AT })) {
  519.             next if $tpc eq "";
  520.             my $dir = get_message_path($tpc);
  521.             my $ext = $DCONF->{ext};
  522.             if (opendir(DIR, $dir)) {
  523.                 push @file, map {"$tpc/$_"} grep {/^\d+\.$ext$/} readdir DIR;
  524.                 closedir(DIR);
  525.             }
  526.         }
  527.         writefile("$DCONF->{admin_dir}/backups/$arg->{tempfile}.TMP", \@file, "incremental", { no_lock => 1, no_unlock => 1, no_backup => 1 });
  528.         my $result = {};
  529.         $result->{'data'} = \@file;
  530.         $result->{'tempfile'} = $arg->{tempfile};
  531.         $result->{'count'} = scalar(@file);
  532.         return $result;
  533.     }
  534.     $arg->{tempfile} =~ s/[^\w\-]//g;
  535.     if ($arg->{operation} eq "read" || $arg->{operation} == 2) {
  536.         undef my $result;
  537.         $result->{data} = readfile("$DCONF->{admin_dir}/backups/$arg->{tempfile}.TMP", "incremental", { no_lock => 1, no_unlock => 1,zero_ok=>1});
  538.         $result->{tempfile} = $arg->{tempfile};
  539.         $result->{count} = scalar(@{ $result->{data} });
  540.         return $result;
  541.     }
  542.     if ($arg->{operation} eq "write" || $arg->{operation} == 3) {
  543.         if (scalar(@{ $arg->{data}})) {
  544.             writefile("$DCONF->{admin_dir}/backups/$arg->{tempfile}.TMP", $arg->{data}, "incremental", { no_lock => 1, no_unlock => 1, no_backup => 1 });
  545.             return { continue => 1 };
  546.         } else {
  547.             unlink("$DCONF->{admin_dir}/backups/$arg->{tempfile}.TMP");
  548.             return { continue => 0 };
  549.         }
  550.     }
  551. }
  552.  
  553. 1;
  554.