The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl -T

use strict;
use warnings;
use Test::More;

use lib 't';
use Util;

use File::Next;

use File::Temp qw( tempdir );
use File::Copy;

if ( ! eval { symlink('',''); 1 } ) {
    plan skip_all => 'System does not support symlinks.';
}

plan tests => 6;


# Files to copy out of the swamp into the tempdir.
my @samplefiles = qw(
    0
    c-header.h
    c-source.c
    javascript.js
    Makefile
);

# Create a mini-swamp in the temp directory.
my $tempdir = tempdir( CLEANUP => 1 );
diag "t/follow.t is working with temp directory $tempdir";
mkdir "$tempdir/dir" or die;
for my $filename ( qw( a1 a2 ) ) {
    my $tempfilename = "$tempdir/dir/$filename";
    open( my $fh, '>', $tempfilename ) or die "$tempfilename: $!";
    close $fh or die $!;
    push( @samplefiles, "dir/$filename" );
}

my @realfiles;
for my $file ( @samplefiles ) {
    my $tempfile = "$tempdir/$file";
    copy( "t/swamp/$file", $tempfile );
    push( @realfiles, $tempfile );
}

my %links = (
    "$tempdir/linkfile" => "$tempdir/Makefile",
    "$tempdir/linkdir"  => "$tempdir/dir",
);

for my $link ( sort keys %links ) {
    my $file = $links{$link};
    unlink( $link );
    symlink( $file, $link ) or die "Unable to create symlink $file: $!";
}

my @symlinkage = (
    "$tempdir/linkfile",
    "$tempdir/linkdir/a1",
    "$tempdir/linkdir/a2",
);

DEFAULT: {
    my $iter = File::Next::files( $tempdir );
    isa_ok( $iter, 'CODE' );

    my @actual = slurp( $iter );
    my @expected = ( @realfiles, @symlinkage );

    sets_match( \@actual, \@expected, 'DEFAULT' );
}

NO_FOLLOW: {
    my $iter = File::Next::files( { follow_symlinks => 0 }, $tempdir );
    isa_ok( $iter, 'CODE' );

    my @actual = slurp( $iter );
    my @expected = ( @realfiles );

    sets_match( \@actual, \@expected, 'NO_FOLLOW' );
}

NO_FOLLOW_STARTING_WITH_A_SYMLINK: {
    my $iter = File::Next::files( { follow_symlinks => 0 }, "$tempdir/linkdir" );
    isa_ok( $iter, 'CODE' );

    my @actual = slurp( $iter );
    my @expected = grep { /linkdir/ } @symlinkage;

    sets_match( \@actual, \@expected, 'NO_FOLLOW_STARTING_WITH_A_SYMLINK' );
}

END {
    unlink( keys %links );
}