view release on metacpan or  search on metacpan

t/BaseData.t  view on Meta::CPAN

#!/usr/bin/env perl
use strict;

use Test::More tests => 38;

use File::Path qw(rmtree);
use File::Spec::Functions qw(catdir catfile rel2abs splitdir);

#----------------------------------------------------------------------
# Load package

my @path = splitdir(rel2abs($0));
pop(@path);
pop(@path);

my $lib = catdir(@path, 'lib');
unshift(@INC, $lib);

$lib = catdir(@path, 't');
unshift(@INC, $lib);

require App::Followme::BaseData;

my $test_dir = catdir(@path, 'test');

rmtree($test_dir, 0, 1) if -e $test_dir;
mkdir($test_dir) unless -e $test_dir;
 

#----------------------------------------------------------------------
# Create object

my %configuration = (top_directory => $test_dir,
                     base_directory => $test_dir,
                    );

my $obj = App::Followme::BaseData->new(%configuration);

isa_ok($obj, "App::Followme::BaseData"); # test 1
can_ok($obj, qw(new build)); # test 2

#----------------------------------------------------------------------
# Check split name

do {
    my ($sigil, $name) = $obj->split_name('$is_first');
    is($sigil, '$', 'split scalar variable sigil'); # test 3
    is($name, 'is_first', 'split scalar variable name'); # test 4

    ($sigil, $name) = $obj->split_name('@loop');
    is($sigil, '@', 'split array variable sigil'); # test 5
    is($name, 'loop', 'split array variable name'); # test 6

    ($sigil, $name) = $obj->split_name('loop');
    is($sigil, '', 'split module variable sigil'); # test 7
    is($name, 'loop', 'split module variable name'); # test 8

};

#----------------------------------------------------------------------
# Check ref value

do {
    my $value;
    my $ok_value = '';
    my $ref_value = $obj->ref_value($value, '$', 'is_first');
    is_deeply($ref_value, \$ok_value, 'ref value of scalar undef'); # test 9

    $value = 1;
    $ok_value = $value;
    $ref_value = $obj->ref_value($value, '$', 'is_first');
    is_deeply($ref_value, \$ok_value, 'ref value of scalar value'); # test 10

    $value = \1;
    $ok_value = $value;
    $ref_value = $obj->ref_value($value, '$', 'is_first');
    is ($ref_value, $ok_value, 'ref value of scalar reference'); # test 11
};

#----------------------------------------------------------------------
# Check coerce_data

do {
    my $name = 'test';
    my @data = ();

    my %data = $obj->coerce_data($name, @data);
    is_deeply(\%data, {}, "Coerce data with no argument"); # test 12

   push(@data, 'foo');
   %data = $obj->coerce_data($name, @data);
   is_deeply(\%data, {test => 'foo'}, "Coerce data with one argument"); # test 13

   push(@data, 'bar');
   %data = $obj->coerce_data($name, @data);
   is_deeply(\%data, {'foo' => 'bar'}, "Coerce data with two arguments"); # test 14
};

#----------------------------------------------------------------------
# Check sort and format

do {

    my $data = {
        name => [qw(one two three four)],
    };

    my $sorted_ok = {
        name => [qw(four one three two)],
    };

    my $sorted_data = $obj->sort($data, 'name');
    is_deeply($sorted_data, $sorted_ok, "Sort data by name"); # test 15

    my $formatted_data = $obj->format(0, $data);
    is_deeply($formatted_data, $data, "Format data (noop)") # test 16