git.maemo.org Git - celltowerinfo/blob - debian/maemo-optify

   1 #! /usr/bin/perl -w
   2
   3 use strict;
   4 use Cwd 'getcwd';
   5 use File::Find;
   6 use File::Basename;
   7 use File::Path;
   8
   9 my $debug = 0;
  10 my $verbose = 0;
  11
  12 my $total_count;
  13 my $total_saved;
  14
  15 my $package_name;
  16
  17 if ($#ARGV == 1 && $ARGV[0] eq "--raw") {
  18     exit (optify_raw ($ARGV[1]));
  19 } elsif ($#ARGV >= 0) {
  20     my $pkg = $ARGV[0];
  21     my $dir;
  22
  23     if ($#ARGV >= 1) {
  24         $dir = $ARGV[1];
  25     } else {
  26         $dir = "debian/" . $pkg;
  27     }
  28
  29     optify_dir ($dir, $pkg);
  30 } else {
  31     foreach (list_packages ()) {
  32         optify_package ($_);
  33     }
  34 }
  35
  36 sub dbg {
  37     if ($debug) {
  38         print STDERR @_;
  39     }
  40 }
  41
  42 sub vrb {
  43     if ($debug || $verbose) {
  44         print STDERR @_;
  45     }
  46 }
  47
  48 sub du {
  49     my ($dir) = @_;
  50
  51     my $size = 0;
  52     find(sub { $size += -s if -f $_ }, $dir);
  53     return $size;
  54 }
  55
  56 sub optify_entry {
  57     my ($entry) = @_;
  58
  59     $entry =~ s,^\./,,;
  60
  61     my $opt_entry = "opt/maemo/" . $entry;
  62     vrb "$entry -> $opt_entry\n";
  63
  64     # mkpath seems to fail when the directory already exists, weird.
  65     my $dir = dirname ($opt_entry);
  66     if (! -d $dir) {
  67         mkpath ($dir) || die $!;
  68     }
  69     rename ($entry, $opt_entry) || die $!;
  70     symlink ("/" . $opt_entry, $entry) || die $!;
  71 }
  72
  73 sub blacklisted {
  74     my ($entry) = @_;
  75
  76     if (-f $entry) {
  77         # Files in /usr are always ok, but others are not.
  78         return ! $entry =~ /^\/usr\//;
  79     }
  80
  81     if (basename ($entry) eq $package_name) {
  82         # Directories are OK if they are named after the package.
  83         # But be extra extra careful here and check some well-known names
  84         # that we positively never ever want to optify.
  85         return $package_name eq "bin"
  86             || $package_name eq "sbin"
  87             || $package_name eq "lib"
  88             || $package_name eq "libexec"
  89             || $package_name eq "var"
  90             || $package_name eq "share"
  91             || $package_name eq "X11R6"
  92             || $package_name eq "games"
  93             || $package_name eq "local"
  94             || $package_name eq "src"
  95             || $package_name eq "etc"
  96             || $package_name eq "boot"
  97             || $package_name eq "dev"
  98             || $package_name eq "home"
  99             || $package_name eq "media"
 100             || $package_name eq "mnt"
 101             || $package_name eq "opt"
 102             || $package_name eq "proc"
 103             || $package_name eq "root"
 104             || $package_name eq "srv"
 105             || $package_name eq "sys"
 106             || $package_name eq "syspart"
 107             || $package_name eq "tmp";
 108     } else {
 109         return 1;
 110     }
 111 }
 112
 113 sub consider_entry {
 114     my ($entry) = @_;
 115
 116     dbg "$entry: ";
 117
 118     my $size = du ($entry);
 119
 120     if (-l $entry) {
 121         dbg "link, nope\n";
 122     } elsif ($entry =~ /^.\/opt\//) {
 123         dbg "in /opt, nope\n";
 124     } elsif ($entry =~ /^.\/DEBIAN\//) {
 125         dbg "in /DEBIAN, nope\n";
 126     } elsif ($size >= 2048) {
 127         if (!blacklisted ($entry)) {
 128             dbg "yes, saved $size bytes\n";
 129             $total_count += 1;
 130             $total_saved += $size;
 131             optify_entry ($entry);
 132         } elsif (-d $entry) {
 133             dbg "not ours, recursing\n";
 134             local(*DIR);
 135             opendir(DIR, $entry);
 136             while ($_ = readdir (DIR)) {
 137                 next if ($_ eq "." || $_ eq "..");
 138                 consider_entry ($entry . "/" . $_);
 139             }
 140             closedir(DIR);
 141         }
 142     } else {
 143         dbg "only $size bytes, nope\n";
 144     }
 145 }
 146
 147 sub optify_dir {
 148     my ($dir, $pkg) = @_;
 149
 150     $package_name = $pkg;
 151     $total_count = 0;
 152     $total_saved = 0;
 153
 154     dbg "package: $package_name\n";
 155
 156     my $olddir = getcwd();
 157     chdir ($dir) || die "Cannot chdir to $dir\n";
 158
 159     if (-d "opt") {
 160         print "$pkg: /opt exists already, not optifying further.\n";
 161         return 77;
 162     }
 163
 164     consider_entry (".");
 165
 166     my $total_kb_saved = int ($total_saved / 1024);
 167     print "$pkg: optified $total_count entries, saving about $total_kb_saved kB.\n";
 168
 169     chdir ($olddir) || die "Can't chdir back to $olddir";
 170
 171     return 0;
 172 }
 173
 174 sub optify_raw {
 175      my ($dir) = @_;
 176
 177      chdir ($dir) || die "Cannot chdir to $dir\n";
 178
 179      my $pkg = basename (getcwd ());
 180      $pkg =~ s/_.*$//;
 181
 182      optify_dir (".", $pkg);
 183 }
 184
 185 sub list_packages {
 186     # XXX - Use some debhelper module for this maybe.
 187     my @packages = ();
 188
 189     open IN, "<", "debian/control" or die "Can't read debian/control";
 190     while (<IN>) {
 191         if (/^Package: +(.*)\n/) {
 192             push (@packages, $1);
 193         }
 194     }
 195     close IN;
 196     return @packages;
 197 }
 198
 199 sub optify_package {
 200     my ($pkg) = @_;
 201
 202     optify_dir ("debian/" . $pkg, $pkg);
 203 }