The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Shipwright::Script::Requires;

use strict;
use warnings;

use base qw/App::CLI::Command Shipwright::Base Shipwright::Script/;
__PACKAGE__->mk_accessors(
    qw/skip skip_recommends skip_all_recommends version as_graph min_perl_version
      include_dual_lifed/
);

use Shipwright;
use Shipwright::Util;
use File::Spec::Functions qw/catfile catdir/;

sub options {
    (
        'skip=s'              => 'skip',
        'skip-recommends=s'   => 'skip_recommends',
        'skip-all-recommends' => 'skip_all_recommends',
        'version=s'           => 'version',
        'as-graph'            => 'as_graph',
        'min-perl-version=s'  => 'min_perl_version',
        'include-dual-lifed'  => 'include_dual_lifed',
    );
}

sub run {
    my $self   = shift;
    my $source = shift;
    confess_or_die "we need source arg\n" unless $source;

    $self->skip( { map { $_ => 1 } split /\s*,\s*/, $self->skip || '' } );
    $self->skip_recommends(
        { map { $_ => 1 } split /\s*,\s*/, $self->skip_recommends || '' } );

    my $deps       = {};
    my $shipwright = Shipwright->new(
        source              => $source,
        skip_all_recommends => $self->skip_all_recommends,
        min_perl_version    => $self->min_perl_version,
        include_dual_lifed  => $self->include_dual_lifed,
        skip                => $self->skip,
        version             => $self->version,
        skip_recommends     => $self->skip_recommends,
    );
    my $name = $source;
    $name =~ s/^cpan://;
    $source = $shipwright->source->run();

    next
      unless $source;    # if running the source returned undef, we should skip

    $self->_requires( $source, $deps, $name );

    my $out;
    if ( $self->as_graph ) {
        $out = 'digraph g {
        graph [ overlap = scale, rankdir= LR ];
        node [ fontsize = "18", shape = record, fontsize = 18 ];
    ';

        for my $module ( keys %$deps ) {
            $out .=
qq{ "$module" [shape = record, fontsize = 18, label = "$module" ];\n};
            for my $dep ( keys %{ $deps->{$module} } ) {
                $out .= qq{"$module" -> "$dep";\n};
            }
        }
        $out .= "\n};";
    }
    else {
        $out = dump_yaml($deps);
    }
    $self->log->fatal($out);
}

# _import_req: import required dists for a dist

sub _requires {
    my $self   = shift;
    my $source = shift;
    my $deps   = shift;
    my $name   = shift;

    my $dir = parent_dir($source);
    my $map_file    = catfile( $dir, 'map.yml' );
    my $map         = load_yaml_file($map_file);
    my $reverse_map = { reverse %$map };

    opendir my ($d), $dir;
    my @sources = readdir $d;
    close $d;

    my $require_file = catfile( $source, '__require.yml' );
    if ( -e $require_file ) {
        my $d = load_yaml_file($require_file);
        for my $type ( keys %$d ) {
            for my $dep ( keys %{ $d->{$type} } ) {
                my $dep_source = catdir( $dir, $dep );
                my $dep_module = $reverse_map->{$dep} || $dep;

                $deps->{$name} ||= {};
                if ( exists $deps->{$name}{$dep_module} ) {
                    my $old = $deps->{$name}{$dep_module};
                    my $new = $d->{$type}{$dep}{version};

                    my $old_v = version->new($old);
                    my $new_v = version->new($new);
                    
                    if ( $new_v->numify > $old_v->numify ) {
                        $deps->{$name}{$dep_module} =
                          $d->{$type}{$dep}{version};
                    }
                }
                else {
                    $deps->{$name}{$dep_module} = $d->{$type}{$dep}{version};
                }

                next if $deps->{$dep_module};
                $self->_requires( $dep_source, $deps, $dep_module );
            }
        }
    }
    else {
        $self->log->warn("failed to find requirments of $source");
    }

}

1;

__END__

=head1 NAME

Shipwright::Script::Requires - list CPAN modules the source depends on

=head1 SYNOPSIS

 requires cpan:Jifty

=head1 OPTIONS

 --version                      : specify the source's version
 --skip                         : specify a list of modules/dist names of
                                  which we don't want to show
 --skip-recommends              : specify a list of modules/dist names of
                                  which recommends we don't want to show
 --skip-all-recommends          : skip all the recommends to show
 --min-perl-version             : minimal perl version (default is the same as
                                  the one which runs this command)
 --include-dual-lifed           : include modules which live both in the perl core 
                                  and on CPAN
 --as-graph                     : output a graph source suitable for rendering
                                  by dot (http://graphviz.org) 
 
=head1 DESCRIPTION

The requires command only show the requirements of a source, it doesn't
create or import at all.

=head1 GLOBAL OPTIONS

 -r [--repository] REPOSITORY   : specify the repository uri of our shipyard
 -l [--log-level] LOGLEVEL      : specify the log level
                                  (info, debug, warn, error, or fatal)
 --log-file FILENAME            : specify the log file

=head1 AUTHORS

sunnavy  C<< <sunnavy@bestpractical.com> >>

=head1 LICENCE AND COPYRIGHT

Shipwright is Copyright 2007-2012 Best Practical Solutions, LLC.

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