The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#
# This file is part of App-Magpie
#
# This software is copyright (c) 2011 by Jerome Quelin.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
use 5.012;
use strict;
use warnings;

package App::Magpie::Action::Sort;
# ABSTRACT: sort command implementation
$App::Magpie::Action::Sort::VERSION = '2.009';
use List::AllUtils qw{ part uniq };
use Moose;
use Path::Tiny;

use App::Magpie::Action::Sort::Package;
use App::Magpie::URPM;

with 'App::Magpie::Role::Logging';


# -- public methods


sub run {
    my ($self, $opts) = @_;

    # default input/output files
    my $in  = $opts->{input} eq "-"  ? *STDIN  : path($opts->{input})->openr;
    my $out = $opts->{output} eq "-" ? *STDOUT : path($opts->{output})->openw;

    # get list of packages to sort
    my @unsorted = $in->getlines;
    chomp( @unsorted );
    $self->log( scalar(@unsorted) . " packages to sort" );
    @unsorted = uniq @unsorted;
    $self->log( scalar(@unsorted) . " unique packages to sort" );

    # fetch list of all provides for the packages to be sorted
    my $urpm = App::Magpie::URPM->instance;
    my %provides;
    @provides{
        map { $_->provides_nosense }
        map { $urpm->packages($_) }
        @unsorted
    } = ();

    # create the package list
    $self->log( "fetching packages requires & provides" );
    my @packages;
    my %seen;
    foreach my $name ( @unsorted ) {
        next if $seen{$name}++;
        # create and store the package
        my @pkgs = $urpm->packages($name);
        my $pkg  = App::Magpie::Action::Sort::Package->new(name=>$name);
        push @packages, $pkg;

        # fetch package provides
        my %pkg_provides;
        @pkg_provides{ map { $_->provides_nosense } @pkgs } = ();
        $pkg->add_provides( keys %pkg_provides );
#        $self->log_debug( "$name provides: @{$pkg->provides}" );

        # fetch package requires
        my @requires = 
            grep { ! exists $pkg_provides{$_} }
            grep { exists $provides{$_} }
            map  { $_->requires_nosense }
            @pkgs;
#        $self->log_debug( "$name requires: @requires" );
        $pkg->add_requires(@requires);
    }

    # really sort the list by requires/provides this time
    my $iteration = 1;
    @packages = sort { $a->name cmp $b->name } @packages;
    while ( scalar(@packages) ) {
        # extract packages with no requires
        my ($remaining, $this_round) = part { $_->has_no_requires } @packages;

        # check if we're in a dead-lock
        if ( not defined $this_round ) {
            $self->log( "remaining packages: " . join ",", map {$_->name} @$remaining );
            $self->log_fatal(
                "no package available this round - aborting " .
                "(remaining: ". scalar(@$remaining) . ")"
            );
        }
        $self->log( "iteration $iteration: " .scalar(@$this_round) . " packages" );
        $out->print( "$_\n" ) for map { $_->name } @$this_round;

        $remaining //= [];
        @packages = @$remaining;
        $_->rm_requires( map { $_->provides } @$this_round ) for @$remaining;
        $iteration++;
    }
}



1;

__END__

=pod

=encoding UTF-8

=head1 NAME

App::Magpie::Action::Sort - sort command implementation

=head1 VERSION

version 2.009

=head1 SYNOPSIS

    my $sort = App::Magpie::Action::Sort->new;
    $sort->run;

=head1 DESCRIPTION

This module implements the C<sort> action. It's in a module of its own
to be able to be C<require>-d without loading all other actions.

=head1 METHODS

=head2 run

    $sort->run;

Re-order a list of packages to be rebuilt.

=head1 AUTHOR

Jerome Quelin <jquelin@gmail.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2011 by Jerome Quelin.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut