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;
  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     my $sev = new Lock ($param->{lockFile});
  66     if ($sev -> lock(LH_EXCL)) {
  67       my $forum = new Lock ($param->{forumFile});
  68       if ($forum -> lock (LH_EXCL)) {
  69         my (
  70           $threads,
  71           $last_thread,
  72           $last_message,
  73           $dtd,
  74           undef
  75         ) = get_all_threads ($forum->filename, KEEP_DELETED);
  76
  77         my $obsolete = get_obsolete_threads ({
  78           parsedThreads => $threads,
  79           adminDefault  => $param->{adminDefault}
  80         });
  81
  82         delete $threads->{$_} for (@$obsolete);
  83
  84         my $saved = save_file (
  85           $param -> {forumFile},
  86           create_forum_xml_string (
  87             $threads,
  88             { dtd         => $dtd,
  89               lastMessage => $last_message,
  90               lastThread  => $last_thread
  91             }
  92           )
  93         );
  94         if ($saved) {
  95           for (@$obsolete) {
  96             new Lock($param->{messagePath}."t$_.xml")->lock(LH_MASTER) or $failed{$_} = 'could not set master lock';
  97           }
  98         }
  99         $forum -> unlock;
 100
 101         if ($saved) {
 102           # now process thread files
 103           #
 104           my $sev_opt = ($param -> {adminDefault} -> {Severance} -> {severance} eq 'instant')
 105             ? $param -> {adminDefault} -> {Instant} -> {Severance}
 106             : ($param -> {adminDefault} -> {Severance});
 107
 108           my $cache = new Posting::Cache ($param->{cachePath});
 109
 110           if ($sev_opt->{exArchiving}) {
 111             # yes, we cut & archive
 112             #
 113             my $sum = $cache -> summary;
 114             if ($sum) {
 115               for my $tid (grep {not exists ($failed{$_})} @$obsolete) {
 116                 my $xml = parse_xml_file ($param->{messagePath}."t$tid.xml");
 117                 unless ($xml) {
 118                   $failed{$tid} = 'could not parse thread file.';
 119                 }
 120                 else {
 121                   my $tnode = $xml -> getElementsByTagName ('Thread') -> item(0);
 122                   my $msg = parse_single_thread ($tnode, KEEP_DELETED);
 123
 124                   if ($sev_opt->{archiving} eq 'UserVotings') {
 125                     # filter out the bad stuff
 126                     #
 127                     my $percent = $param->{adminDefault}->{Voting}->{Limit};
 128                     my ($oldlevel, @path, $z, %archive) = (0, 0);
 129
 130                     for $z (0..$#{$msg}) {
 131                       if ($msg -> [$z] -> {level} > $oldlevel) {
 132                         push @path => $z;
 133                         $oldlevel = $msg -> [$z] -> {level};
 134                       }
 135                       elsif ($msg -> [$z] -> {level} < $oldlevel) {
 136                         splice @path, $msg -> [$z] -> {level};
 137                         push @path => $z;
 138                         $oldlevel = $msg -> [$z] -> {level};
 139                       }
 140                       else {
 141                         $path[-1] = $z;
 142                       }
 143
 144                       if (defined $msg->[$z]->{archive}) {
 145                         if ($msg->[$z]->{archive}) {
 146                           $archive{$msg->[$_]->{mid}} = 1 for (@path);
 147                         }
 148                       }
 149                       unless ($msg->[$z]->{archive} or $msg->[$z]->{deleted}) {
 150                         my $key = $sum->{$tid}->{$msg->[$z]->{mid}};
 151                         if ($percent == 0 or ($key->{views} and ($key->{votings} * 100 / $key->{views}) >= $percent)) {
 152                           $archive{$msg->[$_]->{mid}} = 1 for (@path);
 153                         }
 154                       }
 155                     }
 156
 157                     # now filter out
 158                     #
 159                     for (reverse grep {!$archive{$_->{mid}}} @$msg) {
 160                       my $h = get_message_node($xml, "t$tid", 'm'.$_->{mid});
 161                       $h -> getParentNode -> removeChild ($h);
 162
 163                       $h = get_body_node($xml, 'm'.$_->{mid});
 164                       $h -> getParentNode -> removeChild ($h);
 165                     }
 166                   }
 167                     # save back xml file (into archive)
 168                     #
 169                     if ($tnode -> hasChildNodes) {
 170                       # insert views and votings counter
 171                       #
 172                       for ($tnode -> getElementsByTagName ('Message')) {
 173                         my ($id) = $_ -> getAttribute ('id') =~ /(\d+)/;
 174                         $_ -> setAttribute ('views'   => $sum->{$tid}->{$id}->{views});
 175                         $_ -> setAttribute ('votings' => $sum->{$tid}->{$id}->{votings});
 176                       }
 177
 178                       my ($month, $year) = (localtime ($msg->[0]->{time}))[4,5];
 179                       $month++; $year+=1900;
 180                       my $yeardir  = $param -> {archivePath} . $year;
 181                       my $yearpath = $yeardir . '/';
 182                       my $monthdir = $yearpath . $month;
 183                       my $monthpath = $monthdir . '/';
 184                       my $file = $monthpath . "t$tid.xml";
 185
 186                       mkdir $yeardir unless (-d $yeardir);
 187                       if (-d $yeardir) {
 188                         mkdir $monthdir unless (-d $monthdir);
 189                         if (-d $monthdir) {
 190                           save_file (
 191                             $file,
 192                             \($xml -> toString)
 193                           ) or $failed{$tid} = "could not save '$file'";
 194                         }
 195                         else {
 196                           $failed{$tid} = "could not create directory '$monthdir'";
 197                         }
 198                       }
 199                       else {
 200                         $failed{$tid} = "could not create directory '$yeardir'";
 201                       }
 202                     }
 203
 204                 }
 205               }
 206             }
 207             else {
 208               @failed{@$obsolete} = 'could not load summary';
 209             }
 210           }
 211           # delete processed files
 212           #
 213           for (grep {not exists($failed{$_})} @$obsolete) {
 214             unlink ($param->{messagePath}."t$_.xml") or $failed{$_} = 'could not delete thread file';
 215             #file_removed ($param->{messagePath}."t$_.xml");
 216           }
 217           $cache -> delete_threads (@$obsolete);
 218           $cache -> garbage_collection;
 219         }
 220       }
 221       $sev -> unlock;
 222     }
 223   }
 224
 225   # return
 226   \%failed;
 227 }
 228
 229 # keep 'require' happy
 230 1;
 231
 232 #
 233 #
 234 ### end of Arc::Archive ########################################################