1 #!perl -w

     2 #

     3 # remove_old_builds.pl

     4 #

     5 # usage:

     6 # perl remove_old_builds.pl current_build_number build-directory required-free-space

     7 #

     8 use strict;

     9 

    10 sub usage

    11     {

    12   print <<USAGE_EOF;

    13 

    14 Usage: perl remove_old_builds.pl current_build build-directory required-bytes

    15 

    16 where: current_build   = the number of the current build (e.g 00924_Symbian_OS_v9.1)

    17        build-directory = the top level directory containing the various builds

    18        required-bytes  = the free disk space required.

    19 

    20 USAGE_EOF

    21     exit 1;

    22     }

    23 

    24 sub freespace

    25     {

    26     my $dir = shift;

    27     open FDIR, "dir /-c $dir |" or die "Cannot open FDIR $dir";    # /-c = suppress thousand separators (commas)

    28     my $s= -1;      # Signifying "ERROR"

    29     while (<FDIR>)

    30         {

    31         if (/\s+(\d+) bytes free/) { $s=$1;}

    32         }

    33     return $s;

    34     }

    35 

    36 my $current_build=$ARGV[0];

    37 my $bld_dir=$ARGV[1];

    38 my $space=$ARGV[2];

    39 

    40 unless ($space) { usage() };    # Must have all three args. So check for last one only.

    41 

    42 open DIRS, "dir /b /ad /od $bld_dir |" or die "Cannot open DIRS $bld_dir";     # /b = "bare output"  /ad = directories only   /od = sort by date

    43 while (my $name = <DIRS>)

    44     {

    45        if (freespace($bld_dir) >= $space)

    46        { last; }

    47        chomp $name;

    48        chomp $current_build;

    49            

    50        if(($name =~ /^((D|T|M|MSF|TB|E|(\d{2,3}_))?(\d+))(([a-z]\.\d+)|([a-z])|(\.\d+))?/) && ($name ne $current_build))

    51        {

    52                 print "Removing $bld_dir\\$name\n";

    53                 if (system("rmdir /s /q $bld_dir\\$name"))

    54                 {

    55                     print "ERROR: Failed to remove: $bld_dir\\$name\n";

    56                 }

    57        }

    58     }

    59 close DIRS;

    60 

    61 if (freespace($bld_dir) < $space)

    62     {

    63     print "ERROR: Cannot create $space free bytes in $bld_dir\n";

    64     exit 1;

    65     }

    66 

    67 exit 0;

    68 

    69 

    70 

    71