#/usr/bin/perl

package DistDir;

use strict;
use warnings;

use parent 'Exporter';

use ExtUtils::Manifest qw{ maniread manicopy };
use File::Find  qw{};
use File::pushd qw{ pushd };
use Path::Class qw{ dir file };

our @EXPORT_OK = qw{ clear copy };

# --------------------------------------------------------------------------------------------------
#
#   manidirs
#
#       my $manidirs = manidirs( $manifest );
#
#   Returns directories implicitly used in manifest.
#
sub manidirs($) {
    my ( $manifest ) = @_;
    my $manidirs = { '.' => '' };
    foreach my $file ( keys( %$manifest ) ) {
        #   Files in `MANIFEST` are listed using Unix notation regardless of current OS,
        #   so there is no need in using OS-specific file name handling. To get a directory name,
        #   just grab everything up to the last slash.
        while ( $file =~ m{^(.*)/} ) {
            $manidirs->{ $1 } = '';
            $file = $1;
        };
    };
    return $manidirs;
}; # sub manidirs


# --------------------------------------------------------------------------------------------------
#
#   check
#
#       check( $dir );
#
#
sub check($) {
    my ( $dir ) = @_;
    my $pwd = pushd( $dir );
    my $manifest = maniread( $ExtUtils::Manifest::MANIFEST );
    my $manidirs = manidirs( $manifest );
    my $check = {};
    File::Find::find(
        {
            no_chdir => 1,
            wanted => sub {
                my $entry = $_;
                my $name  = ExtUtils::Manifest::clean_up_filename( $entry );
                if ( -f $entry ) {
                    if ( not exists( $manifest->{ $name } ) ) {
                        push( @{ $check->{ extra }->{ files } }, $entry );
                    };
                } elsif ( -d $entry ) {
                    if ( not exists( $manidirs->{ $name } ) ) {
                        push( @{ $check->{ extra }->{ dirs } }, $entry );
                        $File::Find::prune = 1;
                    };
                } else {
                    die "Oops";
                };
            },
        },
        dir()       # Current directory.
    );
    return $check;
}; # sub check


# --------------------------------------------------------------------------------------------------
#
#   clear
#
#       clear( $dir );
#
#   Remove from the directory *everything* (including subdirs) not listed in the manifest.
#
sub clear($) {
    my ( $dir ) = @_;
    my $check = check( $dir );
    foreach my $file ( @{ $check->{ extra }->{ files } } ) {
        my $path = file( $dir, $file );
        STDOUT->print( "rm $path\n" );
        $path->remove() or die "Cannot delete file `$file': $!\n";
    };
    foreach my $subdir ( @{ $check->{ extra }->{ dirs } } ) {
        my $path = dir( $dir, $subdir );
        STDOUT->print( "rm -r $path\n" );
        $path->rmtree();
    };
}; # sub clear


# --------------------------------------------------------------------------------------------------
#
#   copy
#
#       copy( $src, $dst, $method );
#
#   Copy files listed in `MANIFEST` from $src directory to $dst directory. `MANIFEST` is expected
#   to be in $src directory too.
#
sub copy($$;$) {
    my ( $src, $dst, $method ) = @_;
    my $manifest = maniread( file( $src, $ExtUtils::Manifest::MANIFEST ) );
    my $dir = dir( $dst )->absolute;
    my $pwd = pushd( $src );
    #   If a file, listed in `MANIFEST` not found, `manicopy` prints a warning and continues.
    #   Let us convert warnings to errors.
    local $SIG{ __WARN__ } = sub{
        my ( $msg ) = @_;
        $msg =~ s{ at .*? line \d+\.\s*\z}{};
        die "$msg\n";
    };
    manicopy( $manifest, $dir,  $method );
}; # sub copy


1;

# end of file #
