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

# As of version 2.73 the .ini files generated on Microsoft Windows did not
# contain carriage returns (CRs). This is a regression test for that.

# Thanks to Ben Johnson for reporting this and for a preliminary test
# script.

use strict;
use warnings;

use lib "./t/lib";
use Config::IniFiles::Slurp qw( bin_slurp );

use Test::More;

if ( $^O !~ m/\AMSWin/ )
{
    plan skip_all => 'Test is only relevant for Microsoft Windows';
}
else
{
    plan tests => 1;
}

use Config::IniFiles;
use File::Spec;

my $config_filename =
    File::Spec->catdir( File::Spec->curdir(), "t", "testConfig.ini" );

writeNewUserIni($config_filename);

for my $s ( 1 .. 4 )
{
    print "s = $s\n";
    for my $p ( 1 .. 4 )
    {
        print "p = $p\n";
        writeIni( $config_filename, "Section$s", "Param$p", "Value$p" );
    }
}

# TEST
unlike(
    scalar( bin_slurp($config_filename) ),
    qr/[^\x0D]\x0A/,    # \x0D is CR ; \x0A is LF. See "man ascii".
    "Checking that all line feeds are preceded by carriage returns",
);

sub writeNewUserIni
{
    my ($config_fn) = @_;

    open my $fh, '>', $config_fn
        or die "Cannot open $config_fn for writing. - $!";
    print {$fh} "[UserConfigFile]\n";
    close($fh);

    return;
}

sub writeIni
{
    my ( $userConfig_fn, $section, $param, $value ) = @_;

    my $usrCfg = Config::IniFiles->new( -file => $userConfig_fn )
        or die
"Failed! Could not open $userConfig_fn with error @Config::IniFiles::errors\n";

    $usrCfg->newval( $section, $param, $value )
        or die
        "Could not set newval in writeIni for $section, $param -> $value\n";

    my $c = 0;

    while ( $c < 6 )
    {
        if ( $usrCfg->RewriteConfig() )
        {
            $c = 6;
            print "Writing [$section] $param -> $value\n";
        }
        else
        {
            warn "Error: could not write $param=$value to $userConfig_fn\n";
            sleep 1;
            $c++;
            print "c = $c\n";
        }
    }

    return;
}