On Fri, May 23, 2014 at 05:38:28PM +0200, Agustin Martin wrote:
> I have been wondering for some time if there is a simpler way to handle all
> this sorting without using explicit tsort.
>
> I have been playing for some time with a proof of concept of a perl-only
> method to handle this, and tried today to put it into emacsen-common lib.pl.
> I am attaching current incarnation of it, both as a plain lib.pl and as a
> git diff. I have tested in my system and it seems to work well, but consider
> it highly experimental code.
Hi, Rob
Noticed some problems with my previous sort function, related to
auto-vivification in deep perl hashes of hashes when deep keys are tested
and parent key does not exist.
I think this is fixed now, so I am attaching yet another version of lib.pl.
It also uses a simpler dependencies hash and properly names function
`generate_add_on_install_list' instead of `generate_add_on_install_list_new'.
Needs further testing, but apparently works.
Attached is also the file I am using to test that ./lib.pl.
Hope it helps,
--
Agustin
#!/usr/bin/perl -w
use strict;
use Cwd;
my $debug++ if $ENV{'EMACSEN_COMMON_DEBUG'};
# depends on: dpkg, tsort, perl
my $lib_dir = "/usr/lib/emacsen-common";
my $var_dir = "/var/lib/emacsen-common";
$::installed_package_state_dir = "${var_dir}/state/package/installed";
$::installed_flavor_state_dir = "${var_dir}/state/flavor/installed";
sub ex
{
my(@cmd) = @_;
if(system(@cmd) != 0)
{
die join(" ", @cmd) . " failed";
}
}
sub glob_in_dir
{
my ($dir, $pattern) = @_;
my $oldir = getcwd;
chdir($dir) or die "chdir $dir: $!";
my @files = glob("*[!~]");
chdir($oldir);
return \@files;
}
sub validate_add_on_pkg
{
my ($pkg, $script, $old_invocation_style) = @_;
if($old_invocation_style)
{
if(-e "$lib_dir/packages/compat/$pkg")
{
print STDERR "ERROR: $pkg is broken - called $script as an old-style add-on, but has compat file.\n";
#exit(1);
}
}
else # New invocation style.
{
unless(-e "$lib_dir/packages/compat/$pkg")
{
print STDERR "ERROR: $pkg is broken - called $script as a new-style add-on, but has no compat file.\n";
#exit(1);
}
}
}
sub get_installed_add_on_packages
{
# Return all of the old format packages, plus all of the new-format
# packages that are ready (i.e. have a state/installed file). In
# this case ready means ready for compilation.
my $all_pkgs = glob_in_dir("$lib_dir/packages/install", '*[!~]');
my $new_format_pkgs = glob_in_dir("$lib_dir/packages/compat", '*[!~]');
my %ready_pkgs = map { $_ => 1 } @$all_pkgs;
for my $p (@$new_format_pkgs)
{
delete $ready_pkgs{$p} unless (-e "$::installed_package_state_dir/$p");
}
return \%ready_pkgs;
}
sub get_installed_flavors
{
my $flavors = glob_in_dir($::installed_flavor_state_dir, '*[!~]');
return @$flavors;
}
# ------------------------------------------------------------
sub generate_add_on_install_list {
# ------------------------------------------------------------
# generate_add_on_install_list \@packages_to_sort
# generate_add_on_install_list \%packages_to_sort
# ------------------------------------------------------------
my $packages_to_sort = shift;
my $installed_add_ons = get_installed_add_on_packages;
my %depends_hash = ();
return unless $packages_to_sort;
my $packages_to_sort_string = join(' ',@$packages_to_sort);
my $dpkg_query_output = `dpkg-query -W -f='package:\${Package}, \${Depends}\n' $packages_to_sort_string`;
die 'emacsen-common: dpkg-query invocation failed' unless ($? == 0);
if ( $debug ){
print "------------------------------------------------------------------------------\n";
print "Packages to sort:\n$packages_to_sort_string\n";
print "-------------------------------------------------------------\n";
print "dpkg-query output:\n---\n$dpkg_query_output---\n";
print "-------------------------------------------------------------\n";
print "Installed add-ons:\n", join(', ',sort keys %{$installed_add_ons}), "\n";
print "-------------------------------------------------------------\n";
}
foreach my $dpkg_query_line ( split("\n", $dpkg_query_output) ){
my @package_depends = split(/[,|]/, $dpkg_query_line);
my $package = shift @package_depends;
# Remove consistency string or ignore line if missing.
next unless $package =~ s/^package://;
# Filter out all the "noise" (version number dependencies, etc)
@package_depends = map { /\s*(\S+)/o; $1; } @package_depends;
foreach my $dependency ( @package_depends ){
# dpkg-query regexp above will result in empty dependency for
# packages with no dependencies at all. Discard if so.
next unless $dependency;
# Filter out dependencies on non-add-on packages.
next unless ( defined $installed_add_ons->{"$dependency"} );
# Populate the dependencies hash for this package
$depends_hash{$package}{$dependency}++;
}
}
if ( $debug ){
# Show packages without dependencies
foreach my $pkg ( sort @$packages_to_sort ){
next if defined $depends_hash{$pkg};
print "- \"$pkg\" has no dependencies.\n";
}
# Show packages with dependencies
foreach my $pkg ( sort keys %depends_hash ){
print "+ \"$pkg\" dependencies: [",
join(', ',sort keys $depends_hash{$pkg} ),
"].\n";
}
}
# Sort add-on packages to byte-compile
my @sorted_add_ons = sort {
# Sort emacsen-common first if is to be byte-compiled
$b =~ m/emacsen-common/ <=> $a =~ m/emacsen-common/
||
# Then sort add-ons without dependencies first
( defined $depends_hash{$a} ) <=> ( defined $depends_hash{$b} )
||
# Then sort add-ons depending on another add-on after it.
# Need to check first for $depends_hash{$a} to avoid its
# auto-vivification when checking $depends_hash{$a}{$b}
# with non existant $depends_hash{$a}.
( defined $depends_hash{$a} && defined $depends_hash{$a}{$b} )
<=> ( defined $depends_hash{$b} && defined $depends_hash{$b}{$a} )
||
# Sort rest alphabetically.
$a cmp $b;
} @$packages_to_sort;
# More debugging code
# Show a list of sorted packages
if ( $debug) {
print "--------------------------------------------\n",
"Sorted packages:\n",
join(', ',@sorted_add_ons),
"\n",
"--------------------------------------------\n";
}
return @sorted_add_ons;
}
# To make require happy...
1;
#!/usr/bin/perl -w
use strict;
require "./lib.pl";
# Get all the packages $pkg depends on, dependency sorted.
my $installed_add_on_packages = get_installed_add_on_packages();
my @installed_add_ons = keys %$installed_add_on_packages;
my @pkgs_to_handle = generate_add_on_install_list(\@installed_add_ons);
print "----------\nSorted add-on packages:\n----------\n",
join(', ',@pkgs_to_handle), "\n";
# Show installed flavors
my @installed_flavors = get_installed_flavors();
print "----------\nInstalled flavors:\n----------\n",
join(', ',@installed_flavors), "\n";
