view release on metacpan or  search on metacpan

t/07.fs.t  view on Meta::CPAN

    'str'   => 'I am a string.',
    'true'  => 1,
    'false' => 0,
    'undef' => undef,
    'empty' => "",
    'hash'  => {
        'nested' => {
            zop => 'bar',
        },
        'array' => [qw(a b c 42)],
    },
    'utf8' => "I \xe2\x99\xa5 Perl",    # (utf8 bytes)
    'int'  => int(42.42),
    'abs'  => abs(42.42),
};

my $yaml_cont = q{--- 
"abs": '42.42'
"empty": ''
"false": 0
"hash": 
  "array": 
    - 'a'
    - 'b'
    - 'c'
    - 42
  "nested": 
    "zop": 'bar'
"int": 42
"str": 'I am a string.'
"true": 1
"undef": ~
"utf8": 'I ♥ Perl'
};

#### YAML ##

ok( $app->fs->yaml_write( $yaml_file, $my_data ), 'yaml_write returns true on success' );
is( $app->fs->read_file($yaml_file), $yaml_cont, 'yaml_write had expected content written' );

my $data = $app->fs->yaml_read($yaml_file);
is_deeply( $data, $my_data, 'yaml_read loads expected data' );

ok( $app->fs->yaml_write( $yaml_file, $data ), 'yaml_write returns true on success again' );
is( $app->fs->read_file($yaml_file), $yaml_cont, 'yaml_write had expected content written' );

$data = $app->fs->yaml_read($yaml_file);
is_deeply( $data, $my_data, 'yaml_read loads expected data again' );

$app->fs->yaml_write( $yaml_file, { 'unistr' => "I \x{2665} Unicode" } );
is( $app->fs->read_file($yaml_file), qq{--- \n"unistr": 'I ♥ Unicode'\n}, 'yaml_write does unicode string as bytes (i.e. a utf8 string)' );
$data = $app->fs->yaml_read($yaml_file);
is_deeply( $data, { 'unistr' => "I \xe2\x99\xa5 Unicode" }, 'yaml_read reads previously unicode string written as bytes string as bytes' );

dies_ok { $app->fs->yaml_write($hack_dir) } 'yaml_write dies on failure';
dies_ok { $app->fs->yaml_read( $$ . 'asfvadfvdfva' . time ) } 'yaml_read dies on failure';

#### JSON ##

ok( $app->fs->json_write( $json_file, $my_data ), 'json_write returns true on success' );
like( $app->fs->read_file($json_file), qr/"utf8": "I \xe2\x99\xa5 Perl"/, 'json_write had expected content written' );    # string can change, no way to SortKeys like w/ YAML::Syck, so just make sure utf8 not written in escape syntax

$data = $app->fs->json_read($json_file);
is_deeply( $data, $my_data, 'json_read loads expected data' );

ok( $app->fs->json_write( $json_file, $data ), 'json_write returns true on success again' );
like( $app->fs->read_file($json_file), qr/"utf8": "I ♥ Perl"/, 'json_write had expected content written' );             # string can change, no way to SortKeys like w/ YAML::Syck, so just make sure utf8 not written in escape syntax

$data = $app->fs->json_read($json_file);
is_deeply( $data, $my_data, 'json_read loads expected data again' );

$app->fs->json_write( $json_file, { 'unistr' => "I \x{2665} Unicode" } );
is( $app->fs->read_file($json_file), '{"unistr": "I ♥ Unicode"}' . "\n", 'json_write does unicode string as bytes (i.e. a utf8 string)' );
$data = $app->fs->json_read($json_file);
is_deeply( $data, { 'unistr' => "I \xe2\x99\xa5 Unicode" }, 'json_read reads previsouly unicode string written as bytes string as bytes' );

dies_ok { $app->fs->json_write($hack_dir) } 'json_write dies on failure';
dies_ok { $app->fs->json_read( $$ . 'asfvadfvdfva' . time ) } 'json_read dies on failure';

################
#### appdir() ##
################

is( $app->fs->appdir, $app->fs->spec->catdir( $app->fs->bindir(), '.' . $app->str->prefix() . '.d' ), 'appdir() returns expected string' );
my $curprfx = $app->str->prefix;
$app->str->prefix("yabba");
is( $app->fs->appdir, $app->fs->spec->catdir( $app->fs->bindir(), '.yabba.d' ), 'appdir() returns expected string each time (e.g. when prefix changes)' );
$app->str->prefix($curprfx);

#####################################
#### is_safe_part() is_safe_path() ##
#####################################

is_deeply( [ $app->fs->is_safe_part() ],           [], 'is_safe_part no arg' );
is_deeply( [ $app->fs->is_safe_part(undef) ],      [], 'is_safe_part undef' );
is_deeply( [ $app->fs->is_safe_part('') ],         [], 'is_safe_part no empty' );
is_deeply( [ $app->fs->is_safe_part("\x{2665}") ], [], 'is_safe_part no unicode' );
is_deeply( [ $app->fs->is_safe_part("foo/bar") ],  [], 'is_safe_part path' );

is_deeply( [ $app->fs->is_safe_path() ],               [], 'is_safe_path no arg' );
is_deeply( [ $app->fs->is_safe_path(undef) ],          [], 'is_safe_path undef' );
is_deeply( [ $app->fs->is_safe_path('') ],             [], 'is_safe_path no empty' );
is_deeply( [ $app->fs->is_safe_path("\x{2665}/foo") ], [], 'is_safe_path no unicode' );

is_deeply( [ $app->fs->is_safe_path('/foo/bar') ],  [], 'is_safe_path abs' );
is_deeply( [ $app->fs->is_safe_path("foo/bar/") ],  [], 'is_safe_path trailing' );
is_deeply( [ $app->fs->is_safe_path('/foo/bar/') ], [], 'is_safe_path abs and trailing' );

is( $app->fs->is_safe_path( '/foo/bar', 1 ), 1, 'is_safe_path abs ok' );
is( $app->fs->is_safe_path( "foo/bar/",  0, 1 ), 1, 'is_safe_path trailing ok' );
is( $app->fs->is_safe_path( "/foo/bar/", 1, 1 ), 1, 'is_safe_path abd and trailing ok' );

ok( $app->fs->is_safe_part("foo"),     "is_safe_part() path part OK" );
ok( $app->fs->is_safe_path("foo/bar"), "is_safe_path() path OK" );

done_testing;