use strict;
use YAML qw[LoadFile Dump];
use File::Basename qw[basename];
use Data::Dumper;
use Cwd;
BEGIN {
use lib qw[bin];
require '_inc.pl';
protoconf->import();
}
@ARGV or die 'Need at least one package';
my %indexed = map { $_->{package} => $_ } LoadFile( $Repoindex );
for my $pkg (@ARGV ) {
### in case there's more than one package matching,
### sort by highest version
### XXX this should be a policy decision
my @metas = sort { $b->{version} cmp $a->{version} }
map { $_->[1] }
grep { package_prefix( $_->[1]->{package} ) . '-' .
package_name( $_->[1]->{package} ) eq $pkg }
map { [ $_, $indexed{$_} ] }
keys %indexed;
if( scalar @metas > 1 ) {
warn "More than one result found, using highest versioned\n";
}
my $found = $metas[0];
my @to_install = _recurse_resolve( list_dependencies( $found, 1 ) );
print "Installing:\n";
for my $obj (@to_install) {
print "\t$obj->{package}\n";
}
}
sub _recurse_resolve {
my @deps = @_;
### we need at least the deps provided, plus whatever /they/ need
my @rv = @deps;
for my $dep ( @deps ) {
### unshift, as they are prereqs for THIS dependency, so they
### must be installed first
unshift @rv, _recurse_resolve( list_dependencies( $dep, 1 ) );
}
return @rv;
}
__END__
### XXX can be custom file & nicer object & error checking
my $struct = LoadFile( "$srcdir/$Pms/$Metafile" )
or die "Could not read $Metafile";
my $deps = $struct->{depends};
print "Translating:\n";
print Dump( $deps );
print "\n\nTo:\n";
print join " AND ", map { pp_deps( $_ ) } @$deps;
print $/ . $/;
}
sub pp_deps {
my $deps = shift;
my $str = '';
return $str unless $deps;
if( ! ref $deps ) {
$str .= "$deps";
} elsif ( UNIVERSAL::isa( $deps, 'ARRAY' ) ) {
$str .= join " OR ", map { pp_deps( $_ ) } @$deps;
} elsif ( UNIVERSAL::isa( $deps, 'REF' ) ) {
$str .= '(' . pp_deps( $$deps ) . ')';
} elsif ( UNIVERSAL::isa( $deps, 'HASH' ) ) {
while (my($k,$v) = each %$deps) {
my ($ver,$op) = reverse split /\s+/, $v;
$op ||= '>=';
$str .= "$k $op $ver";
}
} else {
die "Illegal token: $deps\n";
}
return $str;
}