Annotation of loncom/debugging_tools/check_authoring_spaces.pl, revision 1.1
1.1 ! raeburn 1: #!/usr/bin/perl
! 2: #
! 3: # The LearningOnline Network
! 4: #
! 5: # Compare last modification dates for files in Authoring Space with last
! 6: # modification dates for corresponding files in Resource Space.
! 7: # If file in Authoring Space is older than file in Resource Space, and
! 8: # file is not a binary file, check if files are the same.
! 9: # If files are not the same include in list for potentially overwriting
! 10: # file in Authoring space with file in Resource space.
! 11: #
! 12: # $Id: check_authoring_spaces.pl,v 1.1 2017/10/02 23:10:00 raeburn Exp $
! 13: #
! 14: # Copyright Michigan State University Board of Trustees
! 15: #
! 16: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
! 17: #
! 18: # LON-CAPA is free software; you can redistribute it and/or modify
! 19: # it under the terms of the GNU General Public License as published by
! 20: # the Free Software Foundation; either version 2 of the License, or
! 21: # (at your option) any later version.
! 22: #
! 23: # LON-CAPA is distributed in the hope that it will be useful,
! 24: # but WITHOUT ANY WARRANTY; without even the implied warranty of
! 25: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! 26: # GNU General Public License for more details.
! 27: #
! 28: # You should have received a copy of the GNU General Public License
! 29: # along with LON-CAPA; if not, write to the Free Software
! 30: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
! 31: #
! 32: # /home/httpd/html/adm/gpl.txt
! 33: #
! 34: # http://www.lon-capa.org/
! 35: #
! 36: #################################################
! 37:
! 38: use strict;
! 39: use lib '/home/httpd/lib/perl/';
! 40: use LONCAPA::Configuration;
! 41: use LONCAPA qw(:DEFAULT :match);
! 42: use Apache::lonlocal;
! 43: use File::Compare;
! 44: use File::Copy;
! 45:
! 46: my ($lonusersdir,$londocroot,$londaemons);
! 47:
! 48: BEGIN {
! 49: my $perlvar=&LONCAPA::Configuration::read_conf();
! 50: if (ref($perlvar) eq 'HASH') {
! 51: $lonusersdir = $perlvar->{'lonUsersDir'};
! 52: $londocroot = $perlvar->{'lonDocRoot'};
! 53: $londaemons = $perlvar->{'lonDaemons'};
! 54: }
! 55: undef($perlvar);
! 56: }
! 57:
! 58: my $lang = &Apache::lonlocal::choose_language();
! 59: &Apache::lonlocal::get_language_handle(undef,$lang);
! 60:
! 61: if ($< != 0) {
! 62: print &mt('You must be root in order to check Authoring Spaces.')."\n".
! 63: &mt('Stopping')."\n";
! 64: exit;
! 65: }
! 66:
! 67: if ($lonusersdir eq '') {
! 68: print &mt('Could not determine location of [_1] directory.',"'lonUsersDir'")."\n".
! 69: &mt('Stopping')."\n";
! 70: exit;
! 71: }
! 72:
! 73: if ($londocroot eq '') {
! 74: print &mt('Could not determine location of [_1] directory.',"'lonDocRoot'")."\n".
! 75: &mt('Stopping')."\n";
! 76: exit;
! 77: }
! 78:
! 79: if ($londaemons eq '') {
! 80: print &mt('Could not determine location of [_1] directory.',"'lonDaemons'")."\n".
! 81: &mt('Stopping')."\n";
! 82: exit;
! 83: }
! 84:
! 85: # Abort if more than one argument.
! 86:
! 87: my $parameter=$ARGV[0];
! 88: $parameter =~ s/^\s+//;
! 89: $parameter =~ s/\s+$//;
! 90:
! 91: my (undef,undef,$uid,$gid) = getpwnam('www');
! 92:
! 93: if ((@ARGV > 1) || (($parameter ne '') && ($parameter !~ /^(copy|undo)$/))) {
! 94: print &mt('usage: [_1]','check_authoring_spaces.pl [copy|undo]')."\n\n".
! 95: &mt('You should enter either no arguments, or just one argument -- either copy or undo.')."\n".
! 96: &mt("copy - to copy files from Resources Space [_1] to Authoring Space [_2]",
! 97: "'$londocroot/res/'","'$londocroot/priv/'")."\n".
! 98: &mt('undo - to reverse those changes and restore overwritten files in Authoring Space back from: [_1] to [_2].',
! 99: "'/home/httpd/overwritten","'$londocroot/priv'")."\n".
! 100: &mt('no argument to do a dry run of the copy option, without actually copying anything.')."\n";
! 101: exit;
! 102: }
! 103:
! 104: print "\n".&mt("Comparing last modification date for files in published authors' Authoring Spaces with files in Resource Space.")."\n".
! 105: "--------------------------------------------------------------------------------------------------------------\n\n".
! 106: &mt('If run without an argument, the script will report what it would do when copying Resource Space files to Authoring Space, i.e., from [_1] to [_2], for which: (a) the last modification time for the file in /priv predates the last modification time for the corresponding file in /res, and (b) the contents of the files differ, and (c) the file is not a binary file.',
! 107: "'$londocroot/res'","'$londocroot/priv/'")."\n\n";
! 108:
! 109: my (undef,undef,$uid,$gid) = getpwnam('www');
! 110: my ($action) = ($parameter=~/^(copy|undo)$/);
! 111: if ($action eq '') {
! 112: $action = 'dryrun';
! 113: }
! 114:
! 115: if ($action eq 'dryrun') {
! 116: print "\n\n".
! 117: &mt('Running in exploratory mode ...')."\n\n".
! 118: &mt('Run with argument [_1] to actually copy files from Resource Space ([_2]) to Authoring Space ([_3]), i.e., [_4]',
! 119: "'copy'","'$londocroot/res'","'$londocroot/priv'","\n\nperl check_authoring_spaces.pl copy")."\n\n\n".
! 120: &mt('Run with argument [_1] to restore previously overwritten Authoring Spaces back to [_2], i.e., [_3]',
! 121: "'undo'","'$londocroot/priv'","\n\nperl check_authoring_spaces.pl undo")."\n\n\n".
! 122: &mt('Continue? ~[y/N~] ');
! 123: if (!&get_user_selection()) {
! 124: exit;
! 125: } else {
! 126: print "\n";
! 127: }
! 128: } else {
! 129: print "\n *** ".&mt('Running in a mode where changes will be made.')." ***\n";
! 130: if ($action eq 'copy') {
! 131: print "\n".
! 132: &mt('Mode is [_1] -- files will be copied to [_2].',
! 133: "'$action'","'$londocroot/priv'")."\n";
! 134: } else {
! 135: print "\n".
! 136: &mt('Mode is [_1] -- files will be copied back to [_2].',
! 137: "'$action'","'$londocroot/priv'")."\n";
! 138: }
! 139: print &mt('Continue? ~[y/N~] ');
! 140: if (!&get_user_selection()) {
! 141: exit;
! 142: } else {
! 143: print "\n";
! 144: }
! 145: }
! 146:
! 147: my $logfh;
! 148: if ($action ne 'dryrun') {
! 149: if (!open($logfh,">>$londaemons/logs/check_authoring_spaces.log")) {
! 150: print &mt('Could not open log file: [_1] for writing.',
! 151: "'$londaemons/logs/check_authoring_spaces.log'")."\n".
! 152: &mt('Stopping.')."\n";
! 153: exit;
! 154: } else {
! 155: &start_logging($logfh,$action);
! 156: }
! 157: }
! 158:
! 159: # Authors hosted on this server
! 160: my %allauthors;
! 161: my %pubusers;
! 162: my @allskipped;
! 163:
! 164: my @machinedoms;
! 165: my ($dir,$output);
! 166:
! 167: if ($lonusersdir) {
! 168: if (opendir($dir,$lonusersdir)) {
! 169: my @contents = (grep(!/^\.{1,2}$/,readdir($dir)));
! 170: closedir($dir);
! 171: foreach my $item (@contents) {
! 172: if (-d "$lonusersdir/$item") {
! 173: if ($item =~ /^$match_domain$/) {
! 174: my $domain = $item;
! 175: unless (grep(/^\Q$domain\E$/,@machinedoms)) {
! 176: push(@machinedoms,$domain);
! 177: }
! 178: }
! 179: }
! 180: }
! 181: } else {
! 182: $output = &mt('Could not open [_1].',"'$lonusersdir'")."\n";
! 183: print $output;
! 184: unless ($action eq 'dryrun') {
! 185: &stop_logging($logfh,$output);
! 186: }
! 187: print &mt('Stopping')."\n";
! 188: exit;
! 189: }
! 190: }
! 191:
! 192: if ($action eq 'undo') {
! 193: my (%allcopied,@allskipped);
! 194: if (-d "$londaemons/logs/checked_authoring_spaces") {
! 195: if (opendir($dir,"$londaemons/logs/checked_authoring_spaces")) {
! 196: my @contents = (grep(!/^\.{1,2}$/,readdir($dir)));
! 197: closedir($dir);
! 198: foreach my $dom (@contents) {
! 199: if ((grep(/^\Q$dom\E/,@machinedoms)) && (-d "$londaemons/logs/checked_authoring_spaces/$dom")) {
! 200: my $domdir;
! 201: if (opendir($domdir,"$londaemons/logs/checked_authoring_spaces/$dom")) {
! 202: my @unames = (grep(!/^\.{1,2}$/,readdir($domdir)));
! 203: closedir($domdir);
! 204: foreach my $uname (@unames) {
! 205: my %oldfiles;
! 206: my $skipped;
! 207: &descend_preserved_tree('',$londaemons,$dom,$uname,\%oldfiles);
! 208: print &mt('User: [_1], in domain: [_2] has [quant,_3,file].',$uname,$dom,scalar(keys(%oldfiles)))."\n".
! 209: &mt('Continue? ~[y/N~] ');
! 210: if (!&get_user_selection()) {
! 211: print &mt('Enter [_1] to skip this user.','1')."\n".
! 212: &mt('Enter [_1] to stop.','2')."\n".
! 213: &mt('Your input: ');
! 214: my $choice=<STDIN>;
! 215: chomp($choice);
! 216: $choice =~ s/^\s+//;
! 217: $choice =~ s/\s+$//;
! 218: if ($choice == 1) {
! 219: my $output = &mt('Skipping user: [_1].',"'$uname'")."\n";
! 220: print $output;
! 221: print $logfh $output;
! 222: push(@allskipped,$uname);
! 223: next;
! 224: }
! 225: if ($choice == 2) {
! 226: print &mt('Stopped.')."\n";
! 227: my $output = &mt('Stopped at user: [_1].',"'$uname'")."\n";
! 228: &stop_logging($logfh,$output);
! 229: exit;
! 230: } else {
! 231: print &mt('Invalid response:')." $choice\n";
! 232: my $output = &mt('Skipping user: [_1].',"'$uname'")."\n";
! 233: print $output;
! 234: print $logfh $output;
! 235: push(@allskipped,$uname);
! 236: next;
! 237: }
! 238: }
! 239: foreach my $key (sort(keys(%oldfiles))) {
! 240: my $output;
! 241: unless ($key eq '') {
! 242: my $source_path="$londaemons/logs/checked_authoring_spaces/$dom/$uname/$key";
! 243: my $target_path="$londocroot/priv/$dom/$uname/$key";
! 244: if (-e $source_path) {
! 245: if (File::Copy::copy($source_path,$target_path)) {
! 246: chown($uid,$gid,$target_path);
! 247: system("touch -r $source_path $target_path");
! 248: $output .= &mt('Copied [_1] to [_2].',
! 249: "'$source_path'","'$target_path'")."\n";
! 250: push(@{$allcopied{$dom}{$uname}},$key);
! 251: my $logfile;
! 252: my $logname = $target_path.'.log';
! 253: if (-e $logname) {
! 254: if (open($logfile,">>$logname")) {
! 255: print $logfile
! 256: "\n\n================= Retrieve ".localtime()." ================\n".
! 257: "Version: new\nSource: $source_path\nTarget: $target_path\n".
! 258: "Copied sucessfully.\n\n";
! 259: close($logfile);
! 260: } else {
! 261: $output .= &mt('Could not open logfile [_1] to log retrieval.',$logname)."\n";
! 262: }
! 263: } else {
! 264: $output .= &mt('Logfile [_1] does not exist.',$logname)."\n";
! 265: }
! 266: }
! 267: } else {
! 268: $output .= &mt('Source file [_1] does not exist.',$source_path)."\n";
! 269: }
! 270: }
! 271: print $logfh $output;
! 272: }
! 273: }
! 274: }
! 275: }
! 276: }
! 277: }
! 278: } else {
! 279: print &mt('Directory: [_1] does not exist',"$londaemons/logs/checked_authoring_spaces");
! 280: }
! 281: my ($copyinfo,$skipcount);
! 282: if (keys(%allcopied) == 0) {
! 283: $copyinfo = &mt('None')."\n";
! 284: } else {
! 285: foreach my $dom (sort(keys(%allcopied))) {
! 286: if (ref($allcopied{$dom}) eq 'HASH') {
! 287: $copyinfo .= "\n ".&mt('Domain: [_1], number of authors: [_2]',
! 288: "'$dom'",scalar(keys(%{$allcopied{$dom}})));
! 289: }
! 290: }
! 291: }
! 292:
! 293: $skipcount = scalar(@allskipped);
! 294:
! 295: print "\n";
! 296: my $output;
! 297: if ($skipcount) {
! 298: $output = &mt('You skipped: [_1].',$skipcount)."\n".
! 299: join("\n",sort(@allskipped))."\n\n";
! 300: }
! 301: $output .= &mt('Copied back ... [_1]',$copyinfo)."\n";
! 302: print $output;
! 303: print "\n".&mt('Done.')."\n";
! 304: print $logfh $output;
! 305: &stop_logging($logfh);
! 306: exit;
! 307: } elsif (($londocroot ne '') && (-d "$londocroot/res")) {
! 308: if (-d "$londocroot/res") {
! 309: my ($dir,$domdir);
! 310: if (opendir($dir,"$londocroot/res")) {
! 311: my @contents = (grep(!/^\.{1,2}$/,readdir($dir)));
! 312: closedir($dir);
! 313: foreach my $dom (@contents) {
! 314: if ((grep(/^\Q$dom\E/,@machinedoms)) && (-d "$londocroot/res/$dom")) {
! 315: if (opendir($domdir,"$londocroot/res/$dom")) {
! 316: my @unames = (grep(!/^\.{1,2}$/,readdir($domdir)));
! 317: closedir($domdir);
! 318: foreach my $uname (@unames) {
! 319: if ($uname =~ /^$match_username$/) {
! 320: push(@{$pubusers{$uname}},$dom);
! 321: }
! 322: }
! 323: }
! 324: }
! 325: }
! 326: }
! 327: }
! 328:
! 329: my %allcopied;
! 330:
! 331: # Iterate over directories in /home/httpd/html/res
! 332: foreach my $uname (sort(keys(%pubusers))) {
! 333: if (ref($pubusers{$uname}) eq 'ARRAY') {
! 334: foreach my $dom (@{$pubusers{$uname}}) {
! 335: my %allfiles;
! 336: &descend_res_tree('',$londocroot,$dom,$uname,\%allfiles);
! 337: if (keys(%allfiles)) {
! 338: print &mt('User: [_1], in domain: [_2] has [quant,_3,file].',$uname,$dom,scalar(keys(%allfiles)))."\n".
! 339: &mt('Continue? ~[y/N~] ');
! 340: if (!&get_user_selection()) {
! 341: print &mt('Enter [_1] to skip this user.','1')."\n".
! 342: &mt('Enter [_1] to stop.','2')."\n".
! 343: &mt('Your input: ');
! 344: my $choice=<STDIN>;
! 345: chomp($choice);
! 346: $choice =~ s/^\s+//;
! 347: $choice =~ s/\s+$//;
! 348: if ($choice == 1) {
! 349: my $output = &mt('Skipping user: [_1].',"'$uname:$dom'")."\n";
! 350: print $output;
! 351: unless ($action eq 'dryrun') {
! 352: print $logfh $output;
! 353: }
! 354: push(@allskipped,"$uname:$dom");
! 355: next;
! 356: }
! 357: if ($choice == 2) {
! 358: print &mt('Stopped.')."\n";
! 359: my $output = &mt('Stopped at user: [_1].',"'$uname'")."\n";
! 360: &stop_logging($logfh,$output);
! 361: exit;
! 362: } else {
! 363: print &mt('Invalid response:')." $choice\n";
! 364: my $output = &mt('Skipping user: [_1].',"'$uname:$dom'")."\n";
! 365: print $output;
! 366: unless ($action eq 'dryrun') {
! 367: print $logfh $output;
! 368: }
! 369: push(@allskipped,$uname);
! 370: next;
! 371: }
! 372: }
! 373: foreach my $key (sort(keys(%allfiles))) {
! 374: if ($key ne '') {
! 375: my $source_path="$londocroot/res/$dom/$uname/$key";
! 376: my $target_path="$londocroot/priv/$dom/$uname/$key";
! 377: if ($action eq 'copy') {
! 378: my $output;
! 379: if (!-e "$londaemons/logs/checked_authoring_spaces") {
! 380: mkdir("$londaemons/logs/checked_authoring_spaces",0755);
! 381: chown($uid,$gid,"$londaemons/logs/checked_authoring_spaces");
! 382: }
! 383: if (!-e "$londaemons/logs/checked_authoring_spaces/$dom") {
! 384: mkdir("$londaemons/logs/checked_authoring_spaces/$dom",0755);
! 385: chown($uid,$gid,"$londaemons/logs/checked_authoring_spaces/$dom");
! 386: }
! 387: if (!-e "$londaemons/logs/checked_authoring_spaces/$dom/$uname") {
! 388: mkdir("$londaemons/logs/checked_authoring_spaces/$dom/$uname",0755);
! 389: chown($uid,$gid,"$londaemons/logs/checked_authoring_spaces/$dom/$uname");
! 390: }
! 391: if (-e "$londaemons/logs/checked_authoring_spaces/$dom/$uname") {
! 392: my $saveold_path = "$londaemons/logs/checked_authoring_spaces/$dom/$uname/$key";
! 393: if ($key =~ m{/}) {
! 394: my @subdirs = split(/\//,$key);
! 395: my $file = pop(@subdirs);
! 396: my $path = "$londaemons/logs/checked_authoring_spaces/$dom/$uname";
! 397: while (@subdirs) {
! 398: my $dir = pop(@subdirs);
! 399: $path .= '/'.$dir;
! 400: if (!-e $path) {
! 401: mkdir($path,0755);
! 402: chown($uid,$gid,$path);
! 403: }
! 404: }
! 405: }
! 406: if (-e $target_path) {
! 407: if (File::Copy::copy($target_path,$saveold_path)) {
! 408: chown($uid,$gid,$saveold_path);
! 409: system("touch -r $target_path $saveold_path");
! 410: $output .= &mt('Copied [_1] to [_2].',
! 411: "'$target_path'","'$saveold_path'")."\n";
! 412: if (-e $source_path) {
! 413: if (File::Copy::copy($source_path,$target_path)) {
! 414: chown($uid,$gid,$target_path);
! 415: system("touch -r $source_path $target_path");
! 416: $output .= &mt('Copied [_1] to [_2].',
! 417: "'$source_path'","'$target_path'")."\n";
! 418: push(@{$allcopied{$dom}{$uname}},$key);
! 419: my $logfile;
! 420: my $logname = $target_path.'.log';
! 421: if (-e $logname) {
! 422: if (open($logfile,">>$logname")) {
! 423: print $logfile
! 424: "\n\n================= Retrieve ".localtime()." ================\n".
! 425: "Version: new\nSource: $source_path\nTarget: $target_path\n".
! 426: "Copied sucessfully.\n\n";
! 427: close($logfile);
! 428: } else {
! 429: $output .= &mt('Could not open logfile [_1] to log retrieval.',$logname)."\n";
! 430: }
! 431: } else {
! 432: $output .= &mt('Logfile [_1] does not exist.',$logname)."\n";
! 433: }
! 434: } else {
! 435: $output .= &mt('Failed to copy [_1] to [_2].',
! 436: "'$source_path'","'$target_path'")."\n";
! 437: }
! 438: } else {
! 439: $output .= &mt('Source file [_1] does not exist.',$source_path),"\n";
! 440: }
! 441: } else {
! 442: $output .= &mt('Failed to copy [_1] to [_2].',
! 443: "'$target_path'","'$saveold_path'")."\n";
! 444: }
! 445: } else {
! 446: $output .= &mt('Target file [_1] does not exist.',$target_path);
! 447: }
! 448: } else {
! 449: $output .= &mt('Directory needed to preserve pre-dated file from Authoring Space (prior to overwriting) not available.')."\n";
! 450: }
! 451: print $output;
! 452: print $logfh $output;
! 453: } elsif ($action eq 'dryrun') {
! 454: push(@{$allcopied{$dom}{$uname}},$key);
! 455: print &mt('Would copy [_1] to [_2].',"'$source_path'","'$target_path'")."\n";
! 456: }
! 457: }
! 458: }
! 459: }
! 460: }
! 461: }
! 462: }
! 463:
! 464: my ($copyinfo,$skipcount);
! 465: if (keys(%allcopied) == 0) {
! 466: $copyinfo = &mt('None')."\n";
! 467: } else {
! 468: foreach my $dom (sort(keys(%allcopied))) {
! 469: if (ref($allcopied{$dom}) eq 'HASH') {
! 470: $copyinfo .= "\n ".&mt('Domain: [_1], number of authors: [_2]',
! 471: "'$dom'",scalar(keys(%{$allcopied{$dom}})));
! 472: }
! 473: }
! 474: }
! 475:
! 476: $skipcount = scalar(@allskipped);
! 477:
! 478: print "\n";
! 479: if ($action ne 'dryrun') {
! 480: my $output = &mt('You skipped: [_1].',$skipcount)."\n".
! 481: join("\n",sort(@allskipped))."\n\n".
! 482: &mt('Copied ... [_1]',$copyinfo)."\n";
! 483: print $output;
! 484: print $logfh $output;
! 485: &stop_logging($logfh);
! 486: } else {
! 487: if ($skipcount) {
! 488: print &mt('You would have skipped: [_1].',$skipcount)."\n".
! 489: join("\n",sort(@allskipped))."\n\n";
! 490: }
! 491: print &mt('You would have copied ... [_1]',$copyinfo);
! 492: }
! 493: print "\n\n".&mt('Done.')."\n";
! 494: }
! 495:
! 496: sub get_user_selection {
! 497: my ($defaultrun) = @_;
! 498: my $do_action = 0;
! 499: my $choice = <STDIN>;
! 500: chomp($choice);
! 501: $choice =~ s/(^\s+|\s+$)//g;
! 502: my $yes = &mt('y');
! 503: if ($defaultrun) {
! 504: if (($choice eq '') || ($choice =~ /^\Q$yes\E/i)) {
! 505: $do_action = 1;
! 506: }
! 507: } else {
! 508: if ($choice =~ /^\Q$yes\E/i) {
! 509: $do_action = 1;
! 510: }
! 511: }
! 512: return $do_action;
! 513: }
! 514:
! 515: sub start_logging {
! 516: my ($fh,$action) = @_;
! 517: my $start = localtime(time);
! 518: print $fh "*****************************************************\n".
! 519: &mt('[_1] - mode is [_2].',
! 520: 'check_authoring_spaces.pl',"'$action'")."\n".
! 521: &mt('Started -- time: [_1]',$start)."\n".
! 522: "*****************************************************\n\n";
! 523: return;
! 524: }
! 525:
! 526: sub stop_logging {
! 527: my ($fh) = @_;
! 528: my $end = localtime(time);
! 529: print $fh "*****************************************************\n".
! 530: &mt('Ended -- time: [_1]',$end)."\n".
! 531: "*****************************************************\n\n\n";
! 532: close($fh);
! 533: return;
! 534: }
! 535:
! 536: sub descend_res_tree {
! 537: my ($dir,$londocroot,$dom,$uname,$allfiles) = @_;
! 538: my $path = "$londocroot/res/$dom/$uname";
! 539: if ($dir ne '') {
! 540: $path .= "/$dir";
! 541: }
! 542: if (-d $path) {
! 543: opendir(DIR,"$path");
! 544: my @contents = grep(!/^\./,readdir(DIR));
! 545: closedir(DIR);
! 546: foreach my $item (@contents) {
! 547: if (-d "$path/$item") {
! 548: my $newdir;
! 549: if ($dir eq '') {
! 550: $newdir = $item;
! 551: } else {
! 552: $newdir = $dir.'/'.$item;
! 553: }
! 554: &descend_res_tree($newdir,$londocroot,$dom,$uname,$allfiles);
! 555: } else {
! 556: my $newpath;
! 557: if ($dir eq '') {
! 558: $newpath = $item;
! 559: } else {
! 560: $newpath = "$dir/$item";
! 561: }
! 562: if (-f "$londocroot/res/$dom/$uname/$newpath") {
! 563: next if ($item =~ /\.(tmp|subscription|meta)$/);
! 564: next if (-B "$londocroot/res/$dom/$uname/$newpath");
! 565: my $resfile = "$londocroot/res/$dom/$uname/$newpath";
! 566: my $cstrfile = "$londocroot/priv/$dom/$uname/$newpath";
! 567: if (-f $cstrfile) {
! 568: my $lastmodres = (stat($resfile))[9];
! 569: my $lastmodcstr = (stat($cstrfile))[9];
! 570: my $delta = $lastmodres - $lastmodcstr;
! 571: if ($delta > 0) {
! 572: if (&File::Compare::compare($resfile,$cstrfile)) {
! 573: $allfiles->{$newpath} = $delta;
! 574: }
! 575: }
! 576: }
! 577: }
! 578: }
! 579: }
! 580: }
! 581: }
! 582:
! 583: sub descend_preserved_tree {
! 584: my ($dir,$londaemons,$dom,$uname,$allfiles) = @_;
! 585: my $path = "$londaemons/logs/checked_authoring_spaces/$dom/$uname";
! 586: if ($dir ne '') {
! 587: $path .= "/$dir";
! 588: }
! 589: if (-d $path) {
! 590: opendir(DIR,"$path");
! 591: my @contents = grep(!/^\./,readdir(DIR));
! 592: closedir(DIR);
! 593: foreach my $item (@contents) {
! 594: if (-d "$path/$item") {
! 595: my $newdir;
! 596: if ($dir eq '') {
! 597: $newdir = $item;
! 598: } else {
! 599: $newdir = $dir.'/'.$item;
! 600: }
! 601: &descend_preserved_tree($newdir,$londaemons,$dom,$uname,$allfiles);
! 602: } elsif (-f "$path/$item") {
! 603: my $newpath;
! 604: if ($dir eq '') {
! 605: $newpath = $item;
! 606: } else {
! 607: $newpath = "$dir/$item";
! 608: }
! 609: $allfiles->{$newpath} = 1;
! 610: }
! 611: }
! 612: }
! 613: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to check_authoring_spaces.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / debugging_tools