Parent Directory
| 
Revision Log
Revision 1.2 - (view) (download) (as text)
| 1 : | parrello | 1.1 | #!/usr/bin/perl -w |
| 2 : | |||
| 3 : | # | ||
| 4 : | # Copyright (c) 2003-2006 University of Chicago and Fellowship | ||
| 5 : | # for Interpretations of Genomes. All Rights Reserved. | ||
| 6 : | # | ||
| 7 : | # This file is part of the SEED Toolkit. | ||
| 8 : | # | ||
| 9 : | # The SEED Toolkit is free software. You can redistribute | ||
| 10 : | # it and/or modify it under the terms of the SEED Toolkit | ||
| 11 : | # Public License. | ||
| 12 : | # | ||
| 13 : | # You should have received a copy of the SEED Toolkit Public License | ||
| 14 : | # along with this program; if not write to the University of Chicago | ||
| 15 : | # at info@ci.uchicago.edu or the Fellowship for Interpretation of | ||
| 16 : | # Genomes at veronika@thefig.info or download a copy from | ||
| 17 : | # http://www.theseed.org/LICENSE.TXT. | ||
| 18 : | # | ||
| 19 : | |||
| 20 : | use strict; | ||
| 21 : | use Tracer; | ||
| 22 : | use File::stat; | ||
| 23 : | use Stats; | ||
| 24 : | |||
| 25 : | |||
| 26 : | =head1 CleanUp Script | ||
| 27 : | |||
| 28 : | parrello | 1.2 | =head2 Introduction |
| 29 : | |||
| 30 : | parrello | 1.1 | CleanUp [options] |
| 31 : | |||
| 32 : | Delete old temporary files | ||
| 33 : | |||
| 34 : | This is a simple script that deletes old files from the temporary directories | ||
| 35 : | used by the NMPDR. | ||
| 36 : | |||
| 37 : | =head2 Command-Line Options | ||
| 38 : | |||
| 39 : | =over 4 | ||
| 40 : | |||
| 41 : | =item trace | ||
| 42 : | |||
| 43 : | Specifies the tracing level. The higher the tracing level, the more messages | ||
| 44 : | will appear in the trace log. Use E to specify emergency tracing. | ||
| 45 : | |||
| 46 : | =item age | ||
| 47 : | |||
| 48 : | Minimum file age for deletion, in hours. Files that have not been modified in | ||
| 49 : | the specified number of hours will be deleted. | ||
| 50 : | |||
| 51 : | =item sandbox | ||
| 52 : | |||
| 53 : | Path to the SEED/NMPDR sandbox (FIGdisk) to delete. The default is the current | ||
| 54 : | instance. | ||
| 55 : | |||
| 56 : | =item user | ||
| 57 : | |||
| 58 : | Name suffix to be used for log files. If omitted, the PID is used. | ||
| 59 : | |||
| 60 : | =item sql | ||
| 61 : | |||
| 62 : | If specified, turns on tracing of SQL activity. | ||
| 63 : | |||
| 64 : | =item background | ||
| 65 : | |||
| 66 : | Save the standard and error output to files. The files will be created | ||
| 67 : | in the FIG temporary directory and will be named C<err>I<User>C<.log> and | ||
| 68 : | C<out>I<User>C<.log>, respectively, where I<User> is the value of the | ||
| 69 : | B<user> option above. | ||
| 70 : | |||
| 71 : | =item help | ||
| 72 : | |||
| 73 : | Display this command's parameters and options. | ||
| 74 : | |||
| 75 : | =item warn | ||
| 76 : | |||
| 77 : | Create an event in the RSS feed when an error occurs. | ||
| 78 : | |||
| 79 : | =item phone | ||
| 80 : | |||
| 81 : | Phone number to message when the script is complete. | ||
| 82 : | |||
| 83 : | =back | ||
| 84 : | |||
| 85 : | =cut | ||
| 86 : | |||
| 87 : | # Get the command-line options and parameters. | ||
| 88 : | my ($options, @parameters) = StandardSetup([qw() ], | ||
| 89 : | { | ||
| 90 : | trace => [2, "tracing level"], | ||
| 91 : | age => [24, "minimum age in hours for files to be deleted"], | ||
| 92 : | sandbox => ["$FIG_Config::fig_disk", "sandbox whose temp files are to be deleted"], | ||
| 93 : | phone => ["", "phone number (international format) to call when load finishes"] | ||
| 94 : | }, | ||
| 95 : | "", | ||
| 96 : | @ARGV); | ||
| 97 : | # Set a variable to contain return type information. | ||
| 98 : | my $rtype; | ||
| 99 : | # Insure we catch errors. | ||
| 100 : | eval { | ||
| 101 : | # Create a statistics object. | ||
| 102 : | my $stats = Stats->new(qw(deleted directories locked processed bytes)); | ||
| 103 : | # Get the specified sandbox. | ||
| 104 : | my $root = $options->{sandbox}; | ||
| 105 : | if (! -d $root) { | ||
| 106 : | Trace("NMPDR/SEED instance \"$root\" not found.") if T(2); | ||
| 107 : | } else { | ||
| 108 : | # Compute the names of the directories to clean. | ||
| 109 : | my @dirs = ("$root/FIG/Tmp", "$root/FIG/WikiData/working/tmp"); | ||
| 110 : | # We're going to be doing recursive stuff, so we will treat the directory list | ||
| 111 : | # as a stack. | ||
| 112 : | while (my $dir = pop @dirs) { | ||
| 113 : | # Check for the directory. | ||
| 114 : | if (! -d $dir) { | ||
| 115 : | # Not found, so just skip it. | ||
| 116 : | Trace("Directory \"$dir\" does not exist and will be skipped.") if T(2); | ||
| 117 : | } else { | ||
| 118 : | # Open it for reading. We don't dare slurp it, because some of these | ||
| 119 : | # directories contain millions of files. | ||
| 120 : | my $okFlag = opendir(my $dh, $dir); | ||
| 121 : | if (! $okFlag) { | ||
| 122 : | Trace("Could not open \"$dir\": $!") if T(1); | ||
| 123 : | } else { | ||
| 124 : | $stats->Add(directories => 1); | ||
| 125 : | Trace("Processing $dir.") if T(2); | ||
| 126 : | # Loop through the directory files. | ||
| 127 : | while (my $fileTitle = readdir $dh) { | ||
| 128 : | # Only process if this is not a dot-marked file. | ||
| 129 : | if (substr($fileTitle, 0, 1) ne ".") { | ||
| 130 : | # Compute the absolute file name. | ||
| 131 : | my $fileName = "$dir/$fileTitle"; | ||
| 132 : | # Is it a subdirectory? | ||
| 133 : | if (-d $fileName) { | ||
| 134 : | # Yes, stack it. | ||
| 135 : | push @dirs, $fileName; | ||
| 136 : | } else { | ||
| 137 : | # No, so we have a real file. | ||
| 138 : | $stats->Add(processed => 1); | ||
| 139 : | my $fileData = stat $fileName; | ||
| 140 : | # Check its age. | ||
| 141 : | my $age = (time() - $fileData->mtime) / 3600; | ||
| 142 : | if ($age >= $options->{age}) { | ||
| 143 : | # It's old, so we want to delete it. Get its size | ||
| 144 : | # first, so we can track the bytes saved. | ||
| 145 : | my $byteSize = $fileData->blksize * $fileData->blocks; | ||
| 146 : | eval { $okFlag = unlink($fileName); }; | ||
| 147 : | if ($@) { | ||
| 148 : | Trace("Error deleting $fileName: $@") if T(3); | ||
| 149 : | $stats->Add(locked => 1); | ||
| 150 : | } elsif (! $okFlag) { | ||
| 151 : | # It failed, so count it as a lock. | ||
| 152 : | $stats->Add(locked => 1); | ||
| 153 : | } else { | ||
| 154 : | # It worked, so count it. | ||
| 155 : | $stats->Add(bytes => $byteSize); | ||
| 156 : | Trace($stats->Ask('bytes') . " bytes and " . $stats->Ask('deleted') . " files deleted.") if $stats->Check(deleted => 1000) && T(3); | ||
| 157 : | } | ||
| 158 : | } | ||
| 159 : | } | ||
| 160 : | } | ||
| 161 : | } | ||
| 162 : | } | ||
| 163 : | } | ||
| 164 : | } | ||
| 165 : | # We're done. | ||
| 166 : | Trace("Cleanup complete:\n" . $stats->Show()) if T(2); | ||
| 167 : | } | ||
| 168 : | }; | ||
| 169 : | if ($@) { | ||
| 170 : | Trace("Script failed with error: $@") if T(0); | ||
| 171 : | $rtype = "error"; | ||
| 172 : | } else { | ||
| 173 : | Trace("Script complete.") if T(2); | ||
| 174 : | $rtype = "no error"; | ||
| 175 : | } | ||
| 176 : | if ($options->{phone}) { | ||
| 177 : | my $msgID = Tracer::SendSMS($options->{phone}, "CleanUp terminated with $rtype."); | ||
| 178 : | if ($msgID) { | ||
| 179 : | Trace("Phone message sent with ID $msgID.") if T(2); | ||
| 180 : | } else { | ||
| 181 : | Trace("Phone message not sent.") if T(2); | ||
| 182 : | } | ||
| 183 : | } | ||
| 184 : | |||
| 185 : | 1; |
| MCS Webmaster | ViewVC Help |
| Powered by ViewVC 1.0.3 |