scripts/optware-autoclean.pl

   1
   2 #
   3 # for usage information, run "perl optware-autoclean.pl --help"
   4 #
   5 # Copyright (c) 2005 Josh Parsons <jbparsons@ucdavis.edu>
   6 #
   7 # This program is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 2 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # This program is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  15 # General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program; if not, write to the Free Software
  19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  20 #
  21
  22 use Cwd;
  23 use File::stat;
  24 use Getopt::Long;
  25
  26 $optware_dir=undef;
  27 $dry_run=0;
  28 $verbose=0;
  29 $need_help=0;
  30
  31 @out_of_date_packages=();
  32
  33 %uploaded_version=();
  34 %uploaded_maintainer=();
  35 %package_version=();
  36
  37 @blacklist=();
  38 %blacklist=();
  39
  40 GetOptions("optware-dir=s" => \$optware_dir,
  41            "C=s" => \$optware_dir,
  42            "b=s" => \@blacklist,
  43            "blacklist=s" => \@blacklist,
  44            "n" => \$dry_run,
  45            "dry-run" => \$dry_run,
  46            "h" => \$need_help,
  47            "--help" => \$need_help,
  48            "v" => \$verbose,
  49            "verbose" => \$verbose);
  50
  51 ### turn the blacklist into a hash
  52 foreach my $i (@blacklist)
  53 {
  54     $blacklist{$i}=1;
  55 }
  56
  57 ### find optware packages
  58 if(defined($optware_dir))
  59 {
  60 }
  61 elsif(-r "./Makefile")
  62 {
  63     $optware_dir=".";
  64 }
  65 elsif(-r "/home/slug/optware/nslu2/packages/Makefile")
  66 {
  67     $optware_dir="/home/slug/optware/nslu2/packages";
  68 }
  69 elsif(-r "/home/slug/optware/wl500g/packages/Makefile")
  70 {
  71     $optware_dir="/home/slug/optware/wl500g/packages";
  72 }
  73
  74
  75 ### a wrapper for system()
  76 sub invoke
  77 {
  78     my $cmd=shift ||die;
  79     my $dir=shift;
  80     my $cwd=getcwd();
  81
  82     chdir $dir if defined($dir);
  83     print "(in $dir) " if defined($dir);
  84     print "$cmd\n";
  85     system($cmd);
  86     chdir $cwd if defined($dir);
  87
  88     die $! if($?==-1);
  89     die "Interrupted." if($?&127);
  90
  91     return $?==0;
  92 }
  93
  94 ### slurp a file
  95 sub slurp
  96 {
  97     my $fn=shift ||die;
  98     local $/;
  99     open(SLURP,"<$fn") ||return undef;
 100     my $slurped=<SLURP>;
 101     close(SLURP);
 102     return $slurped;
 103 }
 104
 105 ### parse a Packages file
 106 sub parse_Packages
 107 {
 108     local $_;
 109     my $fn=shift || "$optware_dir/packages/Packages";
 110
 111     open(IN,"<$fn") ||die "$! opening $fn";
 112     while(<IN>) {
 113         my $doclean=0;
 114         my $pkg_fn;
 115
 116         chomp;
 117         next unless /^Package: (.*)/;
 118         my $p=$1;
 119         while(<IN>) {
 120             chomp;
 121             last if /^$/;
 122             $uploaded_version{$p}=$1 if /^Version: (.*)/;
 123             $uploaded_maintainer{$p}=$1 if /^Maintainer: (.*)/;
 124             $pkg_fn="$optware_dir/builds/$1" if /^Filename: (.*)/;
 125         }
 126
 127         my $mk_fn="$optware_dir/make/$p.mk";
 128         next unless -r $mk_fn;
 129         my $dot_mk=slurp($mk_fn);
 130         my $mk_stat=stat($mk_fn);
 131         my $pkg_stat=stat($pkg_fn);
 132
 133         if($blacklist{$p}) {}
 134         elsif($pkg_stat && $pkg_stat->mtime<$mk_stat->mtime) {
 135                 print STDERR "$p package is older than makefile\n" if $verbose;
 136                 $doclean=1;
 137         }
 138         elsif(defined($dot_mk)) {
 139
 140             # try to figure out what the uppercased version of the
 141             # package name is.
 142             my $p_pattern="\U$p";
 143             my $P="\U$p";
 144             $p_pattern=~s/\+/\\\+/g;
 145             $p_pattern=~s/_/.?/g;
 146             $p_pattern=~s/-/.?/g;
 147             $P=$1 if $dot_mk=~/(${p_pattern})_VERSION/m;
 148
 149             # try to extract version quickly
 150             my $v1="";
 151             my $v2="";
 152             $v1=$1 if $dot_mk=~/^\s*${p_pattern}_VERSION\s*:?=\s*(\S*)/m;
 153             $v2=$1 if $dot_mk=~/^\s*${p_pattern}_IPK_VERSION\s*:?=\s*(\S*)/m;
 154             my $v="$v1-$v2";
 155
 156             # if it seems to have failed, slow check with make query
 157             unless($uploaded_version{$p} eq $v) {
 158                 my $ipk=`MAKEFLAGS="" make -C $optware_dir -s query-${P}_IPK`;
 159                 chomp $ipk;
 160                 $v=$1 if $ipk=~/\L${p_pattern}_(.*?)_\w+\.ipk$/i;
 161             }
 162
 163             $package_version{$p}=$v;
 164
 165             unless($uploaded_version{$p} eq $v) {
 166                 print STDERR "$p is out of date. Feed=".$uploaded_version{$p}." .mk=$v\n" if $verbose;
 167                 $doclean=1;
 168             }
 169         }
 170
 171         if($doclean) {
 172             my @to_rm = ("builds/${p}");
 173             my $vglob = '*';
 174             # rm only necessary .ipk if version string is simple
 175             if ($uploaded_version{$p} =~ /^[\d\.-]+$/) { $vglob = '[0-9.-]*'; }
 176             push @to_rm, "builds/${p}_${vglob}.ipk", "builds/${p}-${vglob}.ipk";
 177             push @to_rm, "packages/${p}_${vglob}.ipk", "packages/${p}-${vglob}.ipk";
 178             foreach (`grep '"Package: *[a-zA-Z0-9_-]* *" *>>' make/$p.mk`) {
 179                 my $subp = (split)[2]; chop $subp;
 180                 push @to_rm, "builds/${subp}_*.ipk", "packages/${subp}_*.ipk" unless $subp eq $p;
 181             }
 182             invoke("rm -rf " . join(" ", @to_rm), $optware_dir) unless $dry_run;
 183             push @out_of_date_packages,$p;
 184         }
 185     }
 186     close(IN);
 187 }
 188
 189 sub help
 190 {
 191     print <<EOF;
 192 optware-autoclean.pl - clean updated packages from the optware buildroot
 193
 194 This script reads the Packages file and makefiles from the optware
 195 build system, and cleans packages whose version numbers do not match
 196 the version numbers stored in their makefile.
 197
 198 Usage: perl optware-autoclean.pl [options]
 199
 200 Options include:
 201   -v / --verbose
 202   -n / --dry-run (do not clean anything, just say what needs cleaning)
 203   -C<dir> / --optware-dir=<dir> (set the directory of the optware buildroot)
 204
 205 EOF
 206 }
 207
 208 ###
 209 ###
 210 ###
 211
 212 if($need_help)
 213 {
 214     help();
 215     exit(0);
 216 }
 217
 218 unless(-r "$optware_dir/Makefile")
 219 {
 220     help();
 221     print "I can't find optware: trying using the -C option.\n";
 222     exit(2);
 223 };
 224
 225 unless(-r "$optware_dir/packages/Packages")
 226 {
 227     print "No Packages file found. I presume no cleaning is needed.\n" if $verbose;
 228     exit(0);
 229 };
 230
 231 parse_Packages;