--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/releasing/cbrtools/perl/cleanremote Wed Jun 30 11:35:58 2010 +0800
@@ -0,0 +1,330 @@
+#!perl
+# Copyright (c) 2001-2009 Nokia Corporation and/or its subsidiary(-ies).
+# All rights reserved.
+# This component and the accompanying materials are made available
+# under the terms of the License "Eclipse Public License v1.0"
+# which accompanies this distribution, and is available
+# at the URL "http://www.eclipse.org/legal/epl-v10.html".
+#
+# Initial Contributors:
+# Nokia Corporation - initial contribution.
+#
+# Contributors:
+#
+# Description:
+#
+#
+
+use strict;
+use FindBin;
+use lib "$FindBin::Bin";
+use Getopt::Long;
+use IniData;
+use RelData;
+use CommandController;
+use Cleaner;
+use Utils;
+
+
+#
+# Globals.
+#
+
+my $verbose = 0;
+my $dummyRun = 0;
+my $descriptionFile;
+my $iniData = IniData->New();
+my $commandController = CommandController->New($iniData, 'CleanRemote');
+my $keepAfter;
+my %envsToKeep;
+my %relsToKeep;
+my %relsToClean;
+my @filesToDelete;
+my $remoteSite = $iniData->RemoteSite;
+my $cleaner;
+my $doall = 0; # skips prompting
+my $skipWarnings;
+
+#
+# Main.
+#
+ProcessCommandLine();
+$cleaner = Cleaner->New($iniData, 1, $verbose, 0); # 1 = remote
+$cleaner->SetCleaningSubroutine(\&CleaningSubroutine);
+ParseDescriptionFile($descriptionFile);
+$cleaner->Clean();
+
+#
+# Subs.
+#
+
+sub ProcessCommandLine {
+ Getopt::Long::Configure ("bundling");
+ my $help;
+ GetOptions('h' => \$help, 'd' => \$dummyRun, 'v+' => \$verbose, 'f' => \$skipWarnings);
+
+ if ($help) {
+ Usage(0);
+ }
+
+ $descriptionFile = shift @ARGV;
+
+ unless ($descriptionFile) {
+ print "Error: Archive cleaning description file not specified\n";
+ Usage(1);
+ }
+
+ unless ($#ARGV == -1) {
+ print "Error: Invalid number of arguments\n";
+ Usage(1);
+ }
+
+ if ($dummyRun and not $verbose) {
+ $verbose = 1;
+ }
+}
+
+sub Usage {
+ my $exitCode = shift;
+
+ Utils::PrintDeathMessage($exitCode, "\nUsage: cleanremote [options] <description_file>
+
+options:
+
+-h help
+-d dummy run (don't do anything) - assumes -v
+-f (deprecated)
+-v verbose output (-vv very verbose).\n");
+
+}
+
+sub ParseDescriptionFile {
+ if ($verbose) { print "Parsing \"$descriptionFile\"...\n"; }
+ open (DES, $descriptionFile) or die "Unable to open \"$descriptionFile\" for reading: $!\n";
+
+ while (my $line = <DES>) {
+ # Remove line feed, white space and comments.
+ chomp($line);
+ $line =~ s/^\s*$//;
+ $line =~ s/#.*//;
+ if ($line eq '') {
+ # Nothing left.
+ next;
+ }
+
+ my $keyWord;
+ my @operand;
+ if ($line =~ /^(\w+)\s+(.*)/) {
+ $keyWord = $1;
+ @operand = ();
+ if ($2) {
+ @operand = split /\s+/, $2;
+ }
+ } else {
+ $keyWord = $line;
+ }
+
+ unless (defined $keyWord) {
+ die "Error: Invalid line in \"$descriptionFile\":\n$line\n";
+ next;
+ }
+
+ if ($cleaner->ProcessDescriptionLine($descriptionFile, $keyWord, @operand)) {
+ # We're happy because Cleaner.pm knows what to do with this line
+ }
+ elsif ($keyWord =~ /^(?:no_prompt)$/ ) {
+ $doall = 1;
+ } elsif ($keyWord =~ /^(?:clean_to|expunge)$/ ) {
+ my $msg = "You have accidentally left a \"$keyWord\" keyword in your configuration file. That's appropriate for cleaning local archives, but cleanremote just completely deletes stuff. Do you want to continue?";
+ die unless $cleaner->Query($msg);
+ }
+ else {
+ die "Error: Unknown keyword \'$keyWord\' in \"$descriptionFile\"\n";
+ }
+ }
+
+ close (DES);
+
+ if ($verbose > 1) {
+ $cleaner->PrintEnvsToKeep();
+ }
+}
+
+sub CleaningSubroutine {
+ # This actually gets run by Cleaner.pm (it's a callback)
+ my $thisComp = shift;
+ my $thisVer = shift;
+ my $relDir = shift;
+ print "Cleaning $thisComp $thisVer from $relDir...\n" if ($verbose);
+ unless ($doall) {
+ print "Do it?\n";
+ my $ans = <STDIN>;
+ die "Not doing" unless $ans =~ m/[ay]/i;
+ $doall = 1 if $ans =~ m/a/i;
+ }
+ die "Couldn't delete $relDir because it didn't exist" unless $remoteSite->DirExists($relDir);
+ my $fullfile = "$relDir/$thisComp$thisVer.zip";
+ print "Actually deleting release file $fullfile\n";
+ DeleteFile($fullfile);
+ my @files = @{$remoteSite->DirList($relDir) || []};
+ foreach my $fullfile (@files) {
+ if ($fullfile =~ m/lpdrt\d{5}\.tmp$/) {
+ # Remove temp files older than $keepAfter time
+ my $modifiedTime = $remoteSite->FileModifiedTime($fullfile);
+ my $keepAfter = $cleaner->{keepAfter};
+ if ($modifiedTime and (not defined $keepAfter or $modifiedTime <= $keepAfter)) {
+ print "Actually deleting temp file $fullfile\n";
+ DeleteFile($fullfile);
+ } else {
+ print "Not deleting temp file $fullfile because too new\n";
+ }
+ }
+ }
+ if (!$dummyRun) {
+ # Now check the directory is empty and delete the directory if so
+ @files = @{$remoteSite->DirList($relDir) || []};
+ @files = map { m/.*\/(.*?)$/; $1 } @files;
+ print "Wanting to remove directory $relDir - @files files left in it\n" if ($verbose);
+ DeleteFile($relDir) unless @files;
+ }
+
+ return 1; # This cleaner doesn't currently support returning of any errors
+}
+
+sub DeleteFile {
+ my $file = shift;
+ print "Deleting \"$file\"\n" if ($verbose);
+ eval {
+ $remoteSite->DeleteFile($file) unless ($dummyRun);
+ };
+ if ($@) {
+ print "Warning: Couldn't delete \"$file\" because \"$@\"\n";
+ # Usually because $file is a directory, which turns out not to be
+ # empty.
+ }
+}
+
+__END__
+
+=head1 NAME
+
+CleanRemote - Cleans unwanted releases and files from a remote archive.
+
+=head1 SYNOPSIS
+
+ cleanremote [options] <description_file>
+
+options:
+
+ -h help
+ -d dummy run (don't do anything) - assumes -v
+ -f (deprecated)
+ -v verbose output (-vv very verbose)
+
+=head1 DESCRIPTION
+
+C<cleanremote> allows releases to be cleaned out of a remote archive. This may be useful if a remote archive is consuming a large amount of disk space and there are old releases present that are no longer required.
+
+B<Warning: C<cleanremote> has the potential to seriously alter the state of a remote archive, and hence seriously damage productivity of all users of the remote archive. Be very careful using it.>
+
+Before using C<cleanremote> you must write a plain text file that describes which releases you want to keep etc. The following keywords are supported:
+
+=over 4
+
+=item keep_env <component> <version>
+
+Instructs C<cleanremote> to keep all the component versions in the environment from which the specified component was released. This keyword may be used multiple times.
+
+=item keep_rel <component> <version>
+
+Instructs C<cleanremote> to keep a specific component release. This keyword may be used multiple times.
+
+=item keep_recent_env <component> <num_days>
+
+Instructs C<cleanremote> to keep all named component releases, including their environments, where the component release has been exported within the specified number of days (since the current time) (note: the export time, rather than release time is used).
+
+It should be noted that for this keyword to work, an accessible local archive must contain copies of the same component releases as are identified on the remote server as ones to keep.
+
+This keyword may be used multiple times provided it is used for different components each time.
+
+=item keep_recent_rel [component] <num_days>
+
+Instructs C<cleanremote> to keep any component releases exported within the specified number of days (since the current time). If a component name is specified, C<cleanremote> will only keep component releases which match that name (and are sufficiently recent). Please note that the time is taken from time of export, not time of release.
+
+This keyword may be used multiple times if the command is used for different components.
+
+=item keep_recent <num_days>
+
+B<Depricated:> Equivalent to keep_recent_rel without a component name entered.
+
+=item no_prompt
+
+Instructs C<cleanremote> to not prompt the user to delete every component. This is equivalent to typing 'a' (all) at the first component prompt.
+
+=back
+
+For example:
+
+ keep_env pixie alpha
+ keep_env pixie beta
+ keep_rel comp1 rel1
+ keep_recent 10
+
+C<cleanremote> will work out which component releases need to be kept in order to satisfy the specified keep criteria. All other component releases found in the archive will be deleted (along with temporary files used during FTP uploads). B<It is therefore extremely important that the list of environments to keep is complete>. It is recommended that this file be controlled using a configuration management tool. It is also recommended that each project has only one description file, and that all users of C<cleanremote> know where to find it.
+
+Recommended procedure for using C<cleanremote>:
+
+=over 4
+
+=item 1
+
+Inform all users of the archive that a clean is about to be performed, and that the archive will be unavailable whilst this is happening.
+
+=item 2
+
+Take the archive off-line or alter permissions such that you are the only person that can access it.
+
+=item 3
+
+Backup the archive.
+
+=item 4
+
+Run C<cleanremote> and carefully check the list of components that are about to be cleaned. If you are happy, type 'yes' to continue, otherwise type 'no', modify your description file and re-run C<cleanremote>.
+
+=item 5
+
+Bring the archive back on-line.
+
+=item 6
+
+Inform all users of the archive that it is available for use once more.
+
+=back
+
+=head1 STATUS
+
+Supported. If you find a problem, please report it to us.
+
+=head1 KNOWN BUGS
+
+None.
+
+=head1 COPYRIGHT
+
+ Copyright (c) 2001-2009 Nokia Corporation and/or its subsidiary(-ies).
+ All rights reserved.
+ This component and the accompanying materials are made available
+ under the terms of the License "Eclipse Public License v1.0"
+ which accompanies this distribution, and is available
+ at the URL "http://www.eclipse.org/legal/epl-v10.html".
+
+ Initial Contributors:
+ Nokia Corporation - initial contribution.
+
+ Contributors:
+
+ Description:
+
+
+=cut