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