1 #! perl

     2 

     3 # Copyright (c) 2010 Symbian Foundation Ltd

     4 # This component and the accompanying materials are made available

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

     6 # which accompanies this distribution, and is available

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

     8 #

     9 # Initial Contributors:

    10 # Symbian Foundation Ltd - initial contribution.

    11 # 

    12 # Contributors:

    13 #

    14 # Description:

    15 # Delete a directory full of builds, making space as quickly as possible by

    16 # deleting known regions of massive files first

    17 

    18 use strict;

    19 

    20 # List directory subtrees containing mostly big files, biggest first

    21 my @rich_pickings = (

    22   'output/zips',

    23   'output/logs',

    24   'epoc32/release/winscw/udeb'

    25   );

    26   

    27 if (scalar @ARGV == 0)

    28   {

    29   print <<'EOF';

    30 Usage: perl delete_builds.pl dir1 [dir2 ...]

    31 

    32 Delete one or more builds, making free space as quickly as possible

    33 by deleting a few selected directories first

    34 

    35 You can use wildcards in the directory names, and they can be either

    36 individual builds or directories of builds. A build is identified by

    37 the present of an "output" subdirectory. 

    38 EOF

    39   exit(1);

    40   }

    41 

    42 my @builds = ();

    43 

    44 @ARGV = map {glob} @ARGV;

    45 foreach my $dir (@ARGV)

    46   {

    47   $dir =~ s/\\/\//g;  # unix separators

    48   $dir =~ s/\/+$//;   # remove trailing /

    49   if (!-d $dir)

    50     {

    51     print "Ignoring $dir - not a directory\n";

    52     next;

    53     }

    54   if (!-d "$dir/output")

    55     {

    56     print "Ignoring $dir - not a build\n";

    57     next;

    58     }

    59   push @builds, $dir;

    60   }

    61 

    62 foreach my $subdir (@rich_pickings)

    63   {

    64   foreach my $build (@builds)

    65     {

    66     my $victim = "$build/$subdir";

    67     next if (!-d $victim);  # nothing to delete

    68     $victim =~ s/\//\\/g;   # windows separators again (sigh!)

    69     print "* rmdir /s/q $victim\n";

    70     system("rmdir","/s/q",$victim);

    71     }

    72   }

    73 

    74 foreach my $build (@builds)

    75   {

    76   $build =~ s/\//\\/g;

    77   print "* rmdir /s/q $build";

    78   system("rmdir","/s/q",$build);   

    79   }