1 # Copyright (c) 2002-2009 Nokia Corporation and/or its subsidiary(-ies).

     2 # All rights reserved.

     3 # This component and the accompanying materials are made available

     4 # under the terms of the License "Eclipse Public License v1.0"

     5 # which accompanies this distribution, and is available

     6 # at the URL "http://www.eclipse.org/legal/epl-v10.html".

     7 # 

     8 # Initial Contributors:

     9 # Nokia Corporation - initial contribution.

    10 # 

    11 # Contributors:

    12 # 

    13 # Description:

    14 # 

    15 #

    16 

    17 use strict;

    18 use RelData;

    19 use File::Spec;

    20 

    21 package Cleaner;

    22 

    23 sub New {

    24   my $class = shift;

    25   my $iniData = shift;

    26   my $remote = shift;

    27   my $verbose = shift;

    28   my $reallyClean = shift;

    29   

    30   die "Cleaner didn't get an inidata" unless $iniData;

    31   die "Must tell Cleaner whether you want remote or local!!!" unless defined $remote;

    32   

    33   my $self = {

    34     iniData => $iniData,

    35     remote => $remote,

    36     verbose => $verbose,

    37     reallyClean => $reallyClean,

    38     force => 0,

    39     relsToClean => {},

    40     relsToKeep => {},

    41     envsToKeep => {},

    42     relsToKeepAfter => {},

    43     envsToKeepAfter => {},

    44     keepAfter => undef,

    45     cleanTo => undef,

    46     remoteSite => undef,

    47     cleaningSubroutine => undef,

    48     expunge_already_cleaned => undef

    49   };

    50 

    51   bless $self, (ref $class || $class);

    52 

    53   $self->{remoteSite} = $iniData->RemoteSite if ($self->{remote});

    54 

    55   return $self;

    56 }

    57 

    58 sub SetCleaningSubroutine {

    59   my $self = shift;

    60   my $cleaningsub = shift;

    61   $self->{cleaningSubroutine} = $cleaningsub;

    62 }

    63 

    64 sub SetFinishingSubroutine {

    65   my $self = shift;

    66   $self->{finishingSubroutine} = shift;

    67 }

    68 

    69 sub SetRevertingSubroutine {

    70   my $self = shift;

    71   $self->{revertingSubroutine} = shift;

    72 }

    73 

    74 sub ProcessDescriptionLine {

    75   my $self = shift;

    76   my $descriptionFile = shift;

    77   my $keyWord = shift;

    78   my @operand = @_;

    79 

    80   if ($keyWord =~ /^keep_env$/) {

    81     unless ($#operand == 1) {

    82       die "Error: Incorrect number of arguments to \'$keyWord\' keyword in \"$descriptionFile\"\nSyntax: keep_env <component> <version>\n";

    83     }

    84     my $comp = lc($operand[0]);

    85     my $ver = lc($operand[1]);

    86     if (exists $self->{envsToKeep}->{$comp}->{$ver}) {

    87       die "Error: Environment \"$comp $ver\" specified for keeping more than once\n";

    88     }

    89     $self->{envsToKeep}->{$comp}->{$ver} = 1;

    90   }

    91   elsif ($keyWord =~ /^keep_rel$/) {

    92     unless ($#operand == 1) {

    93       die "Error: Incorrect number of arguments to \'$keyWord\' keyword in \"$descriptionFile\"\nSyntax: keep_rel <component> <version>\n";

    94     }

    95     my $comp = lc($operand[0]);

    96     my $ver = lc($operand[1]);

    97     $self->{relsToKeep}->{$comp}->{$ver} = 1;

    98   }

    99   elsif ($keyWord eq "keep_recent_env") {

   100     unless ($#operand == 1) {

   101       die "Error: Incorrect number of arguments to \'$keyWord\' keyword in \"$descriptionFile\"\nSyntax: keep_recent_env <component> <num_days>\n";

   102     }

   103     my $comp = lc($operand[0]);

   104     

   105     my $time = $operand[1];

   106     

   107     if ($time !~ /^\d+$/) {

   108       die "Error: The <num_days> argument for the '$keyWord' keyword must be a positive number\n";

   109     }

   110     

   111     $time = time - ($time * 60 * 60 * 24);   

   112     

   113     if (exists $self->{envsToKeepAfter}->{$comp}) {

   114       die "Error: keep_recent_env called more than once on component \'$comp\' in \"$descriptionFile\"\n";

   115     }

   116     $self->{envsToKeepAfter}->{$comp} = $time;

   117   }

   118   elsif ($keyWord eq "keep_recent_rel") {

   119     if ($#operand == 0) {

   120       if (defined $self->{keepAfter}) {

   121         die "Error: \'$keyWord\' keyword used more than once with no component name in \"$descriptionFile\"\n";

   122       }

   123       else {

   124         my $keepAfter = $operand[0];

   125         

   126         if ($keepAfter !~ /^\d+$/) {

   127           die "Error: The <num_days> argument for the '$keyWord' keyword must be a positive number\n";

   128         }

   129 

   130         $self->{keepAfter} = time - ($keepAfter * 60 * 60 * 24);

   131       }

   132     }

   133     elsif ($#operand == 1) {

   134       my $comp = lc($operand[0]);

   135       my $time = $operand[1];

   136       

   137       if ($time !~ /^\d+$/) {

   138         die "Error: Error: The <num_days> argument for the '$keyWord' keyword must be a positive number\n";

   139       }

   140       

   141       $time = time - ($time * 60 * 60 * 24);

   142       if (exists $self->{relsToKeepAfter}->{$comp}) {

   143         die "Error: keep_recent_rel called more than once on component \'$comp\' in \"$descriptionFile\"\n";

   144       }

   145       $self->{relsToKeepAfter}->{$comp} = $time;

   146     }

   147     else {

   148       die "Error: Incorrect number of arguments to \'$keyWord\' keyword in \"$descriptionFile\"\nSyntax: keep_recent_rel [<component>] <num_days>\n";

   149     }

   150   } 

   151   elsif ($keyWord =~ /^keep_recent$/) {

   152     unless ($#operand == 0) {

   153       die "Error: Incorrect number of arguments to \'$keyWord\' keyword in \"$descriptionFile\"\nSyntax: keep_recent <num_days>\n";

   154     }

   155     if (defined $self->{keepAfter}) {

   156       die "Error: \'$keyWord\' keyword used more than once in \"$descriptionFile\"\n";

   157     }

   158     

   159     my $keepAfter = $operand[0];

   160     

   161     if ($keepAfter !~ /^\d+$/) {

   162       die "Error: The <num_days> argument for the '$keyWord' keyword must be a positive number\n";

   163     }

   164     

   165     $self->{keepAfter} = time - ($keepAfter * 60 * 60 * 24);  

   166     print "Warning: The 'keep_recent' keyword has been deprecated, as it\nresults in broken environments. You can use the 'keep_recent_rel' keyword\nwithout a component name instead if you really mean this, to get rid of this\nwarning.\n";

   167   } elsif ($keyWord =~ /^force$/) {

   168     if (@operand) {

   169       die "Error: Incorrect number of arguments to \'$keyWord\' keyword in \"$descriptionFile\"\nSyntax: force\n";

   170     }

   171     if ($self->{force}) {

   172       die "Error: \'$keyWord\' keyword used more than once in \"$descriptionFile\"\n";

   173     }

   174     $self->{force} = 1;

   175   }

   176   else {

   177     return 0;

   178     

   179   }

   180   return 1;

   181 }

   182 

   183 sub PrintEnvsToKeep {

   184   my $self = shift;

   185   print "Environments to keep:\n";

   186   $self->TablePrintHash($self->{envsToKeep});

   187 }

   188 

   189 # Reads {envsToKeep} and {envsToKeepAfter}, updates {envsToKeep}, and fills out {relsToKeep}.

   190 sub FindRelsToKeep {

   191   my $self = shift;

   192 

   193   # Convert envsToKeepAfter into a list of envsToKeep

   194   foreach my $keepEnv (keys %{$self->{envsToKeepAfter}}) {

   195     my $keepAfter = $self->{envsToKeepAfter}->{$keepEnv};

   196 

   197     foreach my $ver (keys %{$self->{archiveComponents}->{$keepEnv}}) {

   198       # Check reldata time

   199       my $timestamp;

   200       if ($self->{remote}) {

   201         my $file = $self->{iniData}->PathData->RemoteArchivePathForExistingComponent($keepEnv, $ver, $self->{iniData}->RemoteSite);

   202         die "Failed to find path for \"$keepEnv\" \"$ver\"\n" unless $file;

   203         $file .= "/$keepEnv$ver.zip";

   204         $timestamp = $self->{remoteSite}->FileModifiedTime($file);

   205         

   206       } elsif (-e File::Spec->catfile($self->GetPathForExistingComponent($keepEnv, $ver), 'reldata')) {

   207         my $relData = RelData->Open($self->{iniData}, $keepEnv, $ver, $self->{verbose});

   208         $timestamp = $relData->ReleaseTime();

   209       } else {

   210         next;

   211       }

   212 

   213       if ($timestamp >= $keepAfter) {

   214         $self->{envsToKeep}->{$keepEnv}->{$ver} = 1; # It's new; keep it

   215       }

   216     }

   217   }

   218 

   219   # Convert envsToKeep into a list of relsToKeep

   220   foreach my $thisComp (sort(keys %{$self->{envsToKeep}})) {

   221     foreach my $thisVer (sort(keys %{$self->{envsToKeep}->{$thisComp}})) {

   222       if ($self->{verbose}) { print "Reading release data from $thisComp $thisVer...\n"; }

   223    

   224       my $thisCompPath = $self->{iniData}->PathData->LocalArchivePathForExistingComponent($thisComp, $thisVer);

   225      

   226       if ($thisCompPath) {

   227         $thisCompPath = File::Spec->catfile($thisCompPath, 'reldata'); 

   228       } else {

   229         if ($self->{remote}) {

   230           die "Error: Unable to continue since cleanremote requires a corresponding version of '$thisComp $thisVer' in your local archive(s).  Please check that your CBR configuration file is in order and is pointing to the correct location for your local archive(s).  Failing this you will need to ensure you have a copy of '$thisComp $thisVer' in one of your configured local archives\n";      

   231         } else {

   232           die "Internal error:  Release not found in local archive when attempting to get environment for kept component\n";

   233         }

   234       }

   235       

   236       if (-e $thisCompPath) {  

   237         my $thisRelData = RelData->Open($self->{iniData}, $thisComp, $thisVer, $self->{verbose});

   238         my $thisRelEnv = $thisRelData->Environment();

   239    

   240         foreach my $compToKeep (keys %{$thisRelEnv}) {

   241           my $verToKeep = $thisRelEnv->{$compToKeep};

   242           $self->{relsToKeep}->{lc($compToKeep)}->{lc($verToKeep)} = 1;

   243           delete $self->{archiveComponents}->{$compToKeep}->{$verToKeep}; # saves time when finding components to remove

   244         }

   245       } elsif ($self->{remote}) {

   246         die "Error: Unable to continue because the environment for '$thisComp $thisVer' could not be identified (corrupt release; missing reldata file)\n";

   247       } else {

   248         print "Warning: Unable to identify the environment for '$thisComp $thisVer'. This may result in additional component releases being cleaned from the archive.  (Corrupt release; missing reldata file)\n";

   249       }

   250     }

   251   }

   252 }

   253 

   254 sub Clean {

   255   my $self = shift;

   256 

   257   # remoteSite may be defined, or it may not...

   258   # If not, then this will operate on the local archive  

   259   foreach my $archiveComponent (@{$self->{iniData}->PathData->ListComponents($self->{remoteSite})}) {

   260     map {$self->{archiveComponents}->{$archiveComponent}->{$_} = 1} $self->{iniData}->PathData->ListVersions($archiveComponent, $self->{remoteSite});

   261   }

   262 

   263   $self->FindRelsToKeep();

   264 

   265   if ($self->{verbose} > 1) {

   266     print "Releases to keep:\n";

   267     $self->TablePrintHash($self->{relsToKeep});

   268   }

   269 

   270   $self->FindRelsToClean();

   271   

   272   if (%{$self->{relsToClean}}) {

   273     print "About to clean the following releases:\n";

   274     $self->TablePrintHash($self->{relsToClean});

   275     if ($self->Query("Continue?")) {

   276       $self->CleanReleases();

   277     }

   278     else {

   279       print "Aborting...\n";

   280       exit;

   281     }

   282   }

   283   else {

   284     print "Nothing to clean\n";

   285   }

   286 }

   287 

   288 # Walks the archive, filling out %relsToClean with releases that are not present in %relsToKeep.

   289 sub FindRelsToClean {

   290   my $self = shift;

   291 

   292   select STDOUT; $|=1;

   293   

   294   foreach my $thisArchComp (keys %{$self->{archiveComponents}}) {

   295     foreach my $ver (keys %{$self->{archiveComponents}->{$thisArchComp}}) {

   296       $self->CheckComp($thisArchComp, $ver);

   297     }

   298   }

   299 }

   300 

   301 sub CheckComp {

   302   my $self = shift;

   303   my $comp = lc(shift);

   304   my $thisVer = shift;

   305 

   306   unless (exists $self->{relsToKeep}->{$comp}->{lc($thisVer)}) {

   307     my $timestamp;

   308     if ($self->{remote}) {

   309       my $file = $self->{iniData}->PathData->RemoteArchivePathForExistingComponent($comp, $thisVer, $self->{iniData}->RemoteSite);

   310       die "Failed to find path for \"$comp\" \"$thisVer\"\n" unless $file;

   311       $file .= "/$comp$thisVer.zip";

   312       $timestamp = $self->{remoteSite}->FileModifiedTime($file);

   313     } elsif (-e File::Spec->catfile($self->GetPathForExistingComponent($comp, $thisVer), 'reldata')) {

   314           my $relData = RelData->Open($self->{iniData}, $comp, $thisVer, $self->{verbose});

   315           $timestamp = $relData->ReleaseTime();

   316     } elsif (!$self->{reallyClean}) {

   317           print "Warning: $comp $thisVer is not a complete release in " . $self->GetPathForExistingComponent($comp, $thisVer) . '.' .

   318           "\nThe component may be in the process of being released into the archive or it may be corrupt." .

   319           "\nRe-run with the -r option to remove this release from the archive.\n";

   320           return;

   321     }

   322     else {

   323           $self->{relsToClean}->{$comp}->{lc($thisVer)} = $thisVer;

   324           return;

   325     }

   326          

   327     if ($self->{keepAfter} && $timestamp >= $self->{keepAfter}) {

   328       print "Not cleaning $comp $thisVer - too new\n";

   329       return;

   330     }

   331     if (exists($self->{relsToKeepAfter}->{$comp}) && $timestamp >= $self->{relsToKeepAfter}->{$comp}) {

   332       print "Not cleaning $comp $thisVer - too new\n";

   333       return;

   334     }

   335     $self->{relsToClean}->{$comp}->{lc($thisVer)} = $thisVer;

   336   }

   337 }

   338 

   339 sub TablePrintHash {

   340   my $self = shift;

   341   my $hash = shift;

   342   my @tableData;

   343   foreach my $thisComp (sort keys %{$hash}) {

   344     foreach my $thisVer (sort keys %{$hash->{$thisComp}}) {

   345       push (@tableData, [$thisComp, $thisVer]);

   346     }

   347   }

   348   $self->{iniData}->TableFormatter->PrintTable(\@tableData);

   349   print "\n";

   350 }

   351 

   352 sub CleanReleases {

   353   my $self = shift;

   354 

   355   my $cleaningsub = $self->{cleaningSubroutine};

   356   die "No execution sub provided" unless ref $cleaningsub;

   357 

   358   my $failed = 0;

   359   my $cleaned = {};

   360 

   361   print "Cleaning...\n";

   362 

   363   foreach my $thisComp (sort keys %{$self->{relsToClean}}) {

   364     foreach my $thisVer (sort values %{$self->{relsToClean}->{$thisComp}}) { # use values to get correct case

   365       my $path = $self->GetPathForExistingComponent($thisComp, $thisVer);

   366       if (!defined($path)) {

   367         print "Unable to get path for $thisComp $thisVer: possible disconnection of FTP site?\n";

   368         $failed = 1;

   369         last;

   370       }

   371       elsif (&$cleaningsub($thisComp, $thisVer, $path)) {

   372         # Cleaning worked

   373         $cleaned->{$thisComp}->{lc($thisVer)} = [$thisVer, $path];

   374       }

   375       else {

   376         print "Unable to delete $thisComp $thisVer from $path\n";

   377         $failed = 1;

   378         last;

   379       }

   380     }

   381     if ($failed) {

   382       last;

   383     }

   384   }

   385 

   386   if ($failed) {

   387     my $revertsub = $self->{revertingSubroutine};

   388     if (ref $revertsub) {

   389       # Attempt to roll back

   390       print "Warning: Cleaning failed. Rolling back...\n";

   391       $failed = 0;

   392       foreach my $undoComp (sort keys %$cleaned) {

   393 	my @vers = map( $_->[0], values %{$cleaned->{$undoComp}} );

   394         foreach my $undoVer (sort @vers) {

   395           my $path = $cleaned->{$undoComp}->{lc($undoVer)}->[1];

   396           if (!&$revertsub($undoComp, $undoVer, $path)) {

   397             $failed = 1;

   398 	  }

   399 	}

   400       }

   401       if ($failed) {

   402         die "Warning: Cleaning failed and rollback also failed - the archive may have been left in an indeterminate state\n";

   403       }

   404     }

   405     else {

   406       # No rollback routine

   407       die "Warning: Cleaning failed - the archive may have been left in an indeterminate state\n";

   408     }

   409   }

   410   else {

   411     my $finishingsub = $self->{finishingSubroutine};

   412     if (ref $finishingsub) {

   413       # Finish the job

   414       foreach my $thisComp (sort keys %{$cleaned}) {

   415 	my @vers = map( $_->[0], values %{$cleaned->{$thisComp}} );

   416         foreach my $thisVer (sort @vers) {

   417           my $path = $cleaned->{$thisComp}->{lc($thisVer)}->[1];

   418           if (!&$finishingsub($thisComp, $thisVer, $path)) {

   419             print "Warning: Failed to complete cleaning of $thisComp at version $thisVer\n";

   420             $failed = 1;

   421           }

   422         }

   423       }

   424     }

   425     if (!$failed) {

   426       print "Cleaning complete.\n";

   427     }

   428   }

   429 }

   430 

   431 sub GetPathForExistingComponent {

   432   my $self = shift;

   433   my $thisComp = shift;

   434   my $thisVer = shift;

   435   my $path;

   436   if ($self->{remote}) {

   437     $path = $self->{iniData}->PathData->RemoteArchivePathForExistingComponent($thisComp, $thisVer, $self->{remoteSite});

   438   } else {

   439     $path = $self->{iniData}->PathData->LocalArchivePathForExistingComponent($thisComp, $thisVer);

   440   }

   441   return $path;

   442 }

   443 

   444 sub Query {

   445   my $self = shift;

   446   my $msg = shift;

   447 

   448   if ($self->{force}) {

   449     print "Skipping question \"$msg\" because of \"force\" keyword - assuming \"yes\"\n" if ($self->{verbose});

   450     return 1;

   451   }

   452 

   453   print "$msg [yes/no] ";

   454   my $response = <STDIN>;

   455   chomp $response;

   456   return ($response =~ m/^y/i);

   457 }

   458 

   459 1;

   460 

   461 __END__

   462 

   463 =head1 NAME

   464 

   465 Cleaner.pm - A module to clean an archive

   466 

   467 =head1 DESCRIPTION

   468 

   469 A module to clean an archive. Supposed to implement the common bits between C<cleanlocalarch> and C<cleanremote>, but the first of those commands has been temporarily suspended. The basic plan is: let it process the lines of your cleaning description file, then give it a subroutine to operate on the releases that should be cleaned. It will do the intervening stages of working out what releases should be kept, and which should be clean.

   470 

   471 =head1 INTERFACE

   472 

   473 =head2 New

   474 

   475 Pass it an IniData object, and a 0 or 1 to indicate whether it should act locally or remotely. If it's acting remotely, it will get a RemoteSite object from the IniData object.

   476 

   477 =head2 SetCleaningSubroutine

   478 

   479 Pass in a reference to a subroutine to actually do the first phase of cleaning. The subroutine will be passed the component name, the version number and the path. If this phase passes, the optional finishing routine will be called next. If it fails at any point, the reverting routine (if defined) will be called on each component which was 'cleaned'.

   480 

   481 =head2 SetFinishingSubroutine

   482 

   483 Pass in a reference to a 'finishing' subroutine to complete the cleaning (see L<SetCleaningSubroutine|setcleaningsubroutine>). If this routine has not been called then no finishing routine will be set up, and the clean will be said to have completed once the first phase is done. The finishing subroutine will be passed the component name, the version number and the path.

   484 

   485 =head2 SetRevertingSubroutine

   486 

   487 Pass in a reference to a 'reverting' subroutine to undo any 'cleaned' components (see L<SetCleaningSubroutine|setcleaningsubroutine>). If this routine has not been called then the cleaner will not attempt to revert changes if cleaning fails. The reverting subroutine will be passed the component name, the version number and the (original) path.

   488 

   489 =head2 ProcessDescriptionLine

   490 

   491 This should be passed the name of the description file (for error messages only), then a keyword, then an array of operands. It will interpret lines keep_rel, keep_env, force, and keep_recent. If it understands a line it returns 1; otherwise it returns 0.

   492 

   493 =head2 PrintEnvsToKeep

   494 

   495 This just prints a list of the environments it is going to keep.

   496 

   497 =head2 Clean

   498 

   499 This actually does the cleaning. It first finds the releases to keep, then finds the releases to clean, then runs the cleaning subroutine for each one.

   500 

   501 =head1 KNOWN BUGS

   502 

   503 None.

   504 

   505 =head1 COPYRIGHT

   506 

   507  Copyright (c) 2000-2009 Nokia Corporation and/or its subsidiary(-ies).

   508  All rights reserved.

   509  This component and the accompanying materials are made available

   510  under the terms of the License "Eclipse Public License v1.0"

   511  which accompanies this distribution, and is available

   512  at the URL "http://www.eclipse.org/legal/epl-v10.html".

   513  

   514  Initial Contributors:

   515  Nokia Corporation - initial contribution.

   516  

   517  Contributors:

   518  

   519  Description:

   520  

   521 

   522 =cut