selfforum-cgi/shared/Arc/Archive.pm

   1 package Arc::Archive;
   2
   3 ################################################################################
   4 #                                                                              #
   5 # File:        shared/Arc/Archive.pm                                           #
   6 #                                                                              #
   7 # Authors:     Andre Malo       <nd@o3media.de>, 2001-06-16                    #
   8 #                                                                              #
   9 # Description: Severance of Threads and archiving                              #
  10 #                                                                              #
  11 ################################################################################
  12
  13 use strict;
  14 use vars qw(
  15   @EXPORT
  16   $VERSION
  17 );
  18
  19 use Arc::Test;
  20 use Lock          qw(:ALL);
  21 use Posting::_lib qw(
  22   get_all_threads
  23   create_forum_xml_string
  24   parse_xml_file
  25   parse_single_thread
  26   get_message_node
  27   get_body_node
  28   save_file
  29   KEEP_DELETED
  30 );
  31 use Posting::Cache;
  32
  33 use XML::DOM;
  34
  35 ################################################################################
  36 #
  37 # Version check
  38 #
  39 $VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
  40
  41 ################################################################################
  42 #
  43 # Export
  44 #
  45 use base qw(Exporter);
  46 @EXPORT = qw(cut_tail);
  47
  48 ### sub cut_tail ($) ###########################################################
  49 #
  50 # shorten the main file and archive, if necessary
  51 #
  52 # Params: $param - hash reference
  53 #                  (forumFile, messagePath, archivePath, lockFile, adminDefault,
  54 #                   cachePath)
  55 #
  56 # Return: hash reference - empty if all right done
  57 #
  58 sub cut_tail ($) {
  59   my $param = shift;
  60   my %failed;
  61
  62   if ( $param->{adminDefault}->{Severance}->{severance} ne 'instant'
  63     or $param->{adminDefault}->{Instant}->{execute}
  64   ) {
  65     if (write_lock_file($param->{lockFile}, 1)) {
  66       if (write_lock_file ($param->{forumFile})) {
  67         my (
  68           $threads,
  69           $last_thread,
  70           $last_message,
  71           $dtd,
  72           undef
  73         ) = get_all_threads ($param->{forumFile}, KEEP_DELETED);
  74
  75         my $obsolete = get_obsolete_threads ({
  76           parsedThreads => $threads,
  77           adminDefault  => $param->{adminDefault}
  78         });
  79
  80         delete $threads->{$_} for (@$obsolete);
  81
  82         my $saved = save_file (
  83           $param -> {forumFile},
  84           create_forum_xml_string (
  85             $threads,
  86             { dtd         => $dtd,
  87               lastMessage => $last_message,
  88               lastThread  => $last_thread
  89             }
  90           )
  91         );
  92         if ($saved) {
  93           for (@$obsolete) {
  94             set_master_lock ($param->{messagePath}."t$_.xml") or $failed{$_} = 'could not set master lock';
  95           }
  96         }
  97         violent_unlock_file ($param->{forumFile}) unless (write_unlock_file ($param->{forumFile}));
  98
  99         if ($saved) {
 100           # now process thread files
 101           #
 102           my $sev_opt = ($param -> {adminDefault} -> {Severance} -> {severance} eq 'instant')
 103             ? $param -> {adminDefault} -> {Instant} -> {Severance}
 104             : ($param -> {adminDefault} -> {Severance});
 105
 106           my $cache = new Posting::Cache ($param->{cachePath});
 107
 108           if ($sev_opt->{exArchiving}) {
 109             # yes, we cut & archive
 110             #
 111             my $sum = $cache -> summary;
 112             if ($sum) {
 113               for my $tid (grep {not exists ($failed{$_})} @$obsolete) {
 114                 my $xml = parse_xml_file ($param->{messagePath}."t$tid.xml");
 115                 unless ($xml) {
 116                   $failed{$tid} = 'could not parse thread file.';
 117                 }
 118                 else {
 119                   my $tnode = $xml -> getElementsByTagName ('Thread') -> item(0);
 120                   my $msg = parse_single_thread ($tnode, KEEP_DELETED);
 121
 122                   if ($sev_opt->{archiving} eq 'UserVotings') {
 123                     # filter out the bad stuff
 124                     #
 125                     my $percent = $param->{adminDefault}->{Voting}->{Limit};
 126                     my ($oldlevel, @path, $z, %archive) = (0, 0);
 127
 128                     for $z (0..$#{$msg}) {
 129                       if ($msg -> [$z] -> {level} > $oldlevel) {
 130                         push @path => $z;
 131                         $oldlevel = $msg -> [$z] -> {level};
 132                       }
 133                       elsif ($msg -> [$z] -> {level} < $oldlevel) {
 134                         splice @path, $msg -> [$z] -> {level};
 135                         push @path => $z;
 136                         $oldlevel = $msg -> [$z] -> {level};
 137                       }
 138                       else {
 139                         $path[-1] = $z;
 140                       }
 141
 142                       if (defined $msg->[$z]->{archive}) {
 143                         if ($msg->[$z]->{archive}) {
 144                           $archive{$msg->[$_]->{mid}} = 1 for (@path);
 145                         }
 146                       }
 147                       unless ($msg->[$z]->{archive} or $msg->[$z]->{deleted}) {
 148                         my $key = $sum->{$tid}->{$msg->[$z]->{mid}};
 149                         if ($percent == 0 or ($key->{views} and ($key->{votings} * 100 / $key->{views}) >= $percent)) {
 150                           $archive{$msg->[$_]->{mid}} = 1 for (@path);
 151                         }
 152                       }
 153                     }
 154
 155                     # now filter out
 156                     #
 157                     for (reverse grep {!$archive{$_->{mid}}} @$msg) {
 158                       my $h = get_message_node($xml, "t$tid", 'm'.$_->{mid});
 159                       $h -> getParentNode -> removeChild ($h);
 160
 161                       $h = get_body_node($xml, 'm'.$_->{mid});
 162                       $h -> getParentNode -> removeChild ($h);
 163                     }
 164                   }
 165                     # save back xml file (into archive)
 166                     #
 167                     if ($tnode -> hasChildNodes) {
 168                       # insert views and votings counter
 169                       #
 170                       for ($tnode -> getElementsByTagName ('Message')) {
 171                         my ($id) = $_ -> getAttribute ('id') =~ /(\d+)/;
 172                         $_ -> setAttribute ('views'   => $sum->{$tid}->{$id}->{views});
 173                         $_ -> setAttribute ('votings' => $sum->{$tid}->{$id}->{votings});
 174                       }
 175
 176                       my ($month, $year) = (localtime ($msg->[0]->{time}))[4,5];
 177                       $month++; $year+=1900;
 178                       my $yeardir  = $param -> {archivePath} . $year;
 179                       my $yearpath = $yeardir . '/';
 180                       my $monthdir = $yearpath . $month;
 181                       my $monthpath = $monthdir . '/';
 182                       my $file = $monthpath . "t$tid.xml";
 183
 184                       mkdir $yeardir, 0777 unless (-d $yeardir);
 185                       if (-d $yeardir) {
 186                         mkdir $monthdir, 0777 unless (-d $monthdir);
 187                         if (-d $monthdir) {
 188                           save_file (
 189                             $file,
 190                             \($xml -> toString)
 191                           ) or $failed{$tid} = "could not save '$file'";
 192                         }
 193                         else {
 194                           $failed{$tid} = "could not create directory '$monthdir'";
 195                         }
 196                       }
 197                       else {
 198                         $failed{$tid} = "could not create directory '$yeardir'";
 199                       }
 200                     }
 201
 202                 }
 203               }
 204             }
 205             else {
 206               @failed{@$obsolete} = 'could not load summary';
 207             }
 208           }
 209           # delete processed files
 210           #
 211           for (grep {not exists($failed{$_})} @$obsolete) {
 212             unlink ($param->{messagePath}."t$_.xml") or $failed{$_} = 'could not delete thread file';
 213             file_removed ($param->{messagePath}."t$_.xml");
 214           }
 215           $cache -> delete_threads (@$obsolete);
 216           $cache -> garbage_collection;
 217         }
 218       }
 219       else {
 220         violent_unlock_file ($param->{forumFile});
 221       }
 222       violent_unlock_file ($param->{lockFile}) unless (write_unlock_file ($param->{lockFile}));
 223     }
 224     else {
 225       violent_unlock_file ($param->{lockFile});
 226     }
 227   }
 228
 229   # return
 230   \%failed;
 231 }
 232
 233 # keep 'require' happy
 234 1;
 235
 236 #
 237 #
 238 ### end of Arc::Archive ########################################################