#! /usr/bin/perl -w use strict; use Cwd 'getcwd'; use File::Find; use File::Basename; use File::Path; my $debug = 0; my $verbose = 0; my $total_count; my $total_saved; my $package_name; if ($#ARGV == 1 && $ARGV[0] eq "--raw") { exit (optify_raw ($ARGV[1])); } elsif ($#ARGV >= 0) { my $pkg = $ARGV[0]; my $dir; if ($#ARGV >= 1) { $dir = $ARGV[1]; } else { $dir = "debian/" . $pkg; } optify_dir ($dir, $pkg); } else { foreach (list_packages ()) { optify_package ($_); } } sub dbg { if ($debug) { print STDERR @_; } } sub vrb { if ($debug || $verbose) { print STDERR @_; } } sub du { my ($dir) = @_; my $size = 0; find(sub { $size += -s if -f $_ }, $dir); return $size; } sub optify_entry { my ($entry) = @_; $entry =~ s,^\./,,; my $opt_entry = "opt/maemo/" . $entry; vrb "$entry -> $opt_entry\n"; # mkpath seems to fail when the directory already exists, weird. my $dir = dirname ($opt_entry); if (! -d $dir) { mkpath ($dir) || die $!; } rename ($entry, $opt_entry) || die $!; symlink ("/" . $opt_entry, $entry) || die $!; } sub blacklisted { my ($entry) = @_; if (-f $entry) { # Files in /usr are always ok, but others are not. return ! $entry =~ /^\/usr\//; } if (basename ($entry) eq $package_name) { # Directories are OK if they are named after the package. # But be extra extra careful here and check some well-known names # that we positively never ever want to optify. return $package_name eq "bin" || $package_name eq "sbin" || $package_name eq "lib" || $package_name eq "libexec" || $package_name eq "var" || $package_name eq "share" || $package_name eq "X11R6" || $package_name eq "games" || $package_name eq "local" || $package_name eq "src" || $package_name eq "etc" || $package_name eq "boot" || $package_name eq "dev" || $package_name eq "home" || $package_name eq "media" || $package_name eq "mnt" || $package_name eq "opt" || $package_name eq "proc" || $package_name eq "root" || $package_name eq "srv" || $package_name eq "sys" || $package_name eq "syspart" || $package_name eq "tmp"; } else { return 1; } } sub consider_entry { my ($entry) = @_; dbg "$entry: "; my $size = du ($entry); if (-l $entry) { dbg "link, nope\n"; } elsif ($entry =~ /^.\/opt\//) { dbg "in /opt, nope\n"; } elsif ($entry =~ /^.\/DEBIAN\//) { dbg "in /DEBIAN, nope\n"; } elsif ($size >= 2048) { if (!blacklisted ($entry)) { dbg "yes, saved $size bytes\n"; $total_count += 1; $total_saved += $size; optify_entry ($entry); } elsif (-d $entry) { dbg "not ours, recursing\n"; local(*DIR); opendir(DIR, $entry); while ($_ = readdir (DIR)) { next if ($_ eq "." || $_ eq ".."); consider_entry ($entry . "/" . $_); } closedir(DIR); } } else { dbg "only $size bytes, nope\n"; } } sub optify_dir { my ($dir, $pkg) = @_; $package_name = $pkg; $total_count = 0; $total_saved = 0; dbg "package: $package_name\n"; my $olddir = getcwd(); chdir ($dir) || die "Cannot chdir to $dir\n"; if (-d "opt") { print "$pkg: /opt exists already, not optifying further.\n"; return 77; } consider_entry ("."); my $total_kb_saved = int ($total_saved / 1024); print "$pkg: optified $total_count entries, saving about $total_kb_saved kB.\n"; chdir ($olddir) || die "Can't chdir back to $olddir"; return 0; } sub optify_raw { my ($dir) = @_; chdir ($dir) || die "Cannot chdir to $dir\n"; my $pkg = basename (getcwd ()); $pkg =~ s/_.*$//; optify_dir (".", $pkg); } sub list_packages { # XXX - Use some debhelper module for this maybe. my @packages = (); open IN, "<", "debian/control" or die "Can't read debian/control"; while () { if (/^Package: +(.*)\n/) { push (@packages, $1); } } close IN; return @packages; } sub optify_package { my ($pkg) = @_; optify_dir ("debian/" . $pkg, $pkg); }