The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
# -*- cperl -*-

use ExtUtils::testlib;
use Test::More ;
use Path::Class ;

use Test::Memory::Cycle;
use Config::Model;
use Config;
# Config::Model::FuseUI is loaded later within an eval

if ($Config{osname} ne 'linux') {
    plan skip_all => "Not a Linux system" ;
}

my @lsmod = eval { `lsmod` ;} ;

if ($@) {
      plan skip_all => "Cannot check is fuse module is loaded: $@" ;
}

if (not grep (/fuse/, @lsmod)) {
      plan skip_all => "fuse module is not loaded" ;
}

if (not grep (m!/! , `bash -c 'type fusermount'`) ) {
      plan skip_all => "fusermount not found" ;
}

my $umount_str = `bash -c 'umount --version'` ;
my ($umount_v) = $umount_str =~ / (\d+\.\d+)/ ;
if ( $umount_v + 0 < 2.18 ) {
      plan skip_all => "Did not find umount with version >= 2.18" ;
}


eval { require Config::Model::FuseUI ;} ;
if ( $@ ) {
    plan skip_all => "Config::Model::FuseUI or Fuse is not installed";
}
else {
    plan tests => 16;
}

use warnings FATAL => qw(all);
use strict;

# required to handle warnings in forked process
local $SIG{__WARN__} = sub { die $_[0] };

use Data::Dumper;
use POSIX ":sys_wait_h";

my $arg = shift || '';
my $log = 0;

my $trace = $arg =~ /t/ ? 1 : 0 ;
my $fuse_debug = $arg =~ /f/ ? 1 : 0 ;
$::debug            = 1 if $arg =~ /d/;
$log                = 1 if $arg =~ /l/;
Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;

use Log::Log4perl qw(:easy) ;
my $home = $ENV{HOME} || "";
my $log4perl_user_conf_file = "$home/.log4config-model";

if ($log and -e $log4perl_user_conf_file ) {
    Log::Log4perl::init($log4perl_user_conf_file);
}
else {
    Log::Log4perl->easy_init($WARN);
}

ok(1,"Compilation done");

# pseudo root where config files are written by config-model
my $wr_root = dir('wr_root');

# cleanup before tests
$wr_root->rmtree;
$wr_root->mkpath( { mode => 0755 }) ;

my $fused = $wr_root->subdir('fused') ;
$fused->mkpath( { mode => 0755 }) ;

my $model = Config::Model -> new(legacy => 'ignore')  ;

$model->load(Master => 't/big_model.pm') ;


$model->augment_config_class(
    name => 'Master',
    element => [ 
        'a_boolean' => { type => 'leaf', value_type => 'boolean', default => 0  } ,
    ],
);

my $inst = $model->instance (root_class_name => 'Master');
ok($inst,"created dummy instance") ;

my $root = $inst -> config_root ;

my $step = 'std_id:ab X=Bv - std_id:bc X=Av - std_id:"a/c" X=Av - a_string="toto tata"';
ok( $root->load( step => $step, experience => 'advanced' ),
  "set up data in tree with '$step'");

my $ui = Config::Model::FuseUI->new(
    root => $root , 
    mountpoint => "$fused",
    dir_char_mockup => '\\' ,
);
my $dir_char_mockup = $ui->dir_char_mockup ;

ok($ui,"Created ui (dir mockup is $dir_char_mockup)") ;

# now fork 
my $pid = fork ;

if (defined $pid and $pid == 0) {
    # child process, just run fuse and wait for exit
    $ui->run_loop(debug => $fuse_debug) ;
    exit ;
}

# WARNING: the child process has its own copy of the config tree
# there's no use in modifying the tree on the parent process.

# wait for fuse to do its job
sleep 1;

# child process, continue tests
my @content = sort map { $_->relative($fused) ; } $fused->children ;
is_deeply( \@content ,[sort $root->get_element_name() ],"check $fused content");

my $std_id = $fused->subdir('std_id') ;
@content = sort map { $_->relative($std_id) ; } $std_id-> children ;
my @std_id_elements = sort $root->fetch_element('std_id')->fetch_all_indexes() ;
map { s(/){$dir_char_mockup}g; } @std_id_elements ;
is_deeply( \@content , \@std_id_elements ,"check $std_id content (@content)");

is( $fused->file('a_string')->slurp , $root->grab_value('a_string')."\n",
    "check a_string content");
my $a_string_fhw = $fused->file('a_string')->openw ;
$a_string_fhw -> print("foo bar") ;
$a_string_fhw->close ;

is( $fused->file('a_string')->slurp , "foo bar\n", "check new a_string content");

$std_id->subdir('cd')->mkpath() ;
ok(1,"mkpath on cd dir done") ;
@content = sort map { $_->relative($std_id) ; } $std_id-> children ;
is_deeply( \@content ,  [ @std_id_elements, 'cd' ] ,"check $std_id new content (@content)");

$std_id->subdir('cd')->rmtree() ;
ok(1,"rmtree on cd dir done") ;
@content = sort map { $_->relative($std_id) ; } $std_id-> children ;
is_deeply( \@content ,  \@std_id_elements ,"check $std_id content after rmdir (@content)");

is( $fused->file('a_boolean')->slurp , "0\n", "check new a_boolean content");
my $a_boolean_fhw = $fused->file('a_boolean')->openw ;
$a_boolean_fhw -> print("1") ;
$a_boolean_fhw->close ;
is( $fused->file('a_boolean')->slurp , "1\n", "check new a_boolean content (set to 1)");

END {
    if ($pid) {
        # run this only in parent process
        # umount so child process will exit 
        system("fusermount -u $fused")  ;
    
        # inspired from perlipc man page
        my $child;
        while ( ($child = wait) > 0) {
            ok (1,"Process pid $child done");
        }
    }
    exit ;
}




memory_cycle_ok($model,"memory cycles");