view release on metacpan or  search on metacpan

t/make_ini.pm  view on Meta::CPAN

## ----------------------------------------------------------------------------
#  t/make_ini.pm
# -----------------------------------------------------------------------------
# Mastering programmed by YAMASHINA Hio
#
# Copyright YMIRLINK, Inc.
# -----------------------------------------------------------------------------
# $Id$
# -----------------------------------------------------------------------------
package t::make_ini;
use strict;
use warnings;

our $USER;
our $INI_FILE;
our @cleanup;
our $NOCLEAN = $ENV{TL_TEST_NOCLEAN};

&setup;

1;

# -----------------------------------------------------------------------------
# $pkg->import({ ini => \%ini, });
# $pkg->import({ ini => sub{\%ini}, cleanup=>[qw(..)]);
# use t::make_ini \%opts;
# -----------------------------------------------------------------------------
sub import
{
	my $pkg  = shift;
	my $opts = shift;
	
	my $ini = $opts->{ini};
	$ini or die "no ini";
	ref($ini) eq 'CODE' and $ini = $ini->();
	write_ini($ini);
	
	if( $opts->{clean} )
	{
		push(@cleanup, @{$opts->{clean}});
	}
}

# -----------------------------------------------------------------------------
# setup.
# -----------------------------------------------------------------------------
sub setup
{
	$USER = eval{getpwuid($<)} || $ENV{USERNAME};
	$USER && $USER=~/^(\w+)\z/ or $USER = 'guest';
	
	$INI_FILE = "tmp$$.ini";
	-d "t" and $INI_FILE = "t/$INI_FILE";
}

# -----------------------------------------------------------------------------
# tear down.
# -----------------------------------------------------------------------------
END
{
	$NOCLEAN or unlink @cleanup;
}

# -----------------------------------------------------------------------------
# write_ini(%ini);
# write ini on $t::make_ini::INI_FILE;
# -----------------------------------------------------------------------------
sub write_ini {
    my $groups = shift;

    if (ref($groups) eq 'HASH') {
        $groups = [
            map {
                $_ => $groups->{$_};
              }
              keys %$groups
           ];
    }

    open my $fh, '>', $INI_FILE
      or
        die "could not create file [$INI_FILE]: $!";

    my $is_first = 1;
    for (my $i = 0; $i < @$groups; $i += 2) {
        my $group = $groups->[$i  ];
        my $pairs = $groups->[$i+1];

        if (ref($pairs) eq 'HASH') {
            $pairs = [
                map {
                    $_ => $pairs->{$_}
                  }
                  keys %$pairs
               ];
        }

        if ($is_first) {
            $is_first = undef;
        }
        else {
            print {$fh} "\n";
        }

        print {$fh} "[$group]\n";
        for (my $j = 0; $j < @$pairs; $j += 2) {
            my $key   = $pairs->[$j  ];
            my $value = $pairs->[$j+1];