I implemented catdir. Use catdir FFS.

[scpubgit/DKit.git] / lib / DX / Lib / FS.pm

package DX::Lib::FS;

use DX::Lib::FS::Observation::PathStatus;
use DX::Lib::FS::Observation::EnvDir;
use DX::Lib::FS::Action::CreateDirectory;
use DX::Lib::FS::Action::CreateFile;
use DX::Lib::FS::Action::SetPathMode;
use DX::Lib::FS::Observation::FileContent;
use DX::Lib::FS::Action::RewriteFile;
use File::Spec;
use DX::SetOver;
use Moo;

our @RULES = (
  [ path_status => [ qw(PS) ],
    [ member_of => 'PS', \'path_status' ] ],

  [ _path_status_at => [ qw(PS P) ],
    [ path_status => 'PS' ],
    [ prop => PS => \'path' => 'P' ] ],

  [ path_status_at => [ qw(PS P) ],
    [ _path_status_at => qw(PS P) ],
    [ 'cut' ] ],

  [ path_status_at => [ 'PS', 'P' ],
    [ observe => [ 'P' ], sub {
        DX::Lib::FS::Observation::PathStatus->new(
          path => $_[0]
        )
      } ],
    [ _path_status_at => qw(PS P) ] ],

  [ ps_prop => [ 'P', 'Name', 'Value' ],
    [ path_status_at => qw(PS P) ],
    [ prop => qw(PS Name Value) ] ],

  [ ps_info_prop => [ 'P', 'Name', 'Value' ],
    [ ps_prop => 'P', \'info', 'PSI' ],
    [ prop => 'PSI', 'Name', 'Value' ] ],

  [ exists_path => [ qw(P) ],
    [ ps_prop => 'P' => \'info' => 'PSI' ] ],

  [ _is_directory => [ qw(P) ],
    [ ps_info_prop => 'P' => \'is_directory' => \1 ] ],

  [ is_directory => [ qw(P) ],
    [ _is_directory => 'P' ] ],

  [ _is_file => [ qw(P) ],
    [ ps_info_prop => 'P' => \'is_file' => \1 ] ],

  [ is_file => [ qw(P) ],
    [ _is_file => 'P' ] ],

  [ _mode => [ qw(P M) ],
    [ ps_info_prop => 'P' => \'mode' => 'M' ] ],

  [ mode => [ qw(P M) ],
    [ _mode => qw(P M) ] ],

  [ is_directory => [ 'Path' ],
    [ not => [ _is_directory => 'Path' ] ],
    [ act => [ 'Path' ], sub {
        DX::Lib::FS::Action::CreateDirectory->new(
          path => $_[0],
        )
      } ],
    [ _is_directory => 'Path' ] ],

  [ is_file => [ 'Path' ],
    [ not => [ _is_file => 'Path' ] ],
    [ act => [ 'Path' ], sub {
        DX::Lib::FS::Action::CreateFile->new(
          path => $_[0],
        )
      } ],
    [ _is_file => 'Path' ] ],

  [ _action_is_creating => [ qw(A) ],
    [ does => 'A', \'DX::Lib::FS::Action::CreateDirectory' ] ],

  [ _action_is_creating => [ qw(A) ],
    [ does => 'A', \'DX::Lib::FS::Action::CreateFile' ] ],
    
  [ mode => [ qw(P M) ],
    [ path_status_at => qw(PS P) ],
    [ has_action => qw(PS A) ],
    [ _action_is_creating => 'A' ],
    [ react => [ qw(PS M) ], sub {
        $_[0]->but(mode => $_[1]);
      } ],
    [ 'cut' ] ],

  [ mode => [ qw(P M) ],
    [ path_status_at => qw(PS P) ],
    [ not => [ _mode => qw(P M) ] ],
    [ act => [ qw(PS M) ], sub {
       DX::Lib::FS::Action::SetPathMode->new(
         path_status => $_[0], mode => $_[1]
       )
    } ],
    [ 'cut' ] ],

  [ file_content => [ qw(FC) ],
    [ member_of => 'FC', \'file_content' ] ],

  [ _file_content_at => [ qw(FC P) ],
    [ file_content => 'FC' ],
    [ prop => 'FC', \'path', 'P' ] ],

  [ file_content_at => [ qw(FC P) ],
    [ _file_content_at => qw(FC P) ],
    [ 'cut' ] ],

  [ file_content_at => [ qw(FC P) ],
    [ is_file => 'P' ],
    [ observe => [ 'P' ], sub {
        DX::Lib::FS::Observation::FileContent->new(
          path => $_[0]
        )
      } ],
    [ _file_content_at => qw(FC P) ] ],

  [ fc_prop => [ qw(P Name Value) ],
    [ file_content_at => qw(FC P) ],
    [ prop => qw(FC Name Value) ] ],

  [ file_data => [ qw(P D) ], [ fc_prop => 'P', \'data', 'D' ] ],

  [ _contains_line => [ qw(P L) ],
    [ is_file => 'P' ],
    [ fc_prop => 'P', \'lines', 'Lines' ],
    [ member_of => qw(L Lines) ] ],

  [ contains_line => [ qw(P L) ],
    [ _contains_line => qw(P L) ] ],

  [ _action_modifying_fc => [ 'A' ],
    [ does => 'A' => \'DX::Lib::FS::Action::CreateFile' ] ],

  [ _action_modifying_fc => [ 'A' ],
    [ does => 'A' => \'DX::Lib::FS::Action::RewriteFile' ] ],

  [ contains_line => [ qw(P L) ],
    [ not => [ _contains_line => qw(P L) ] ],
    [ file_content_at => qw(FC P) ],
    [ has_action => qw(FC A) ],
    [ _action_modifying_fc => 'A' ],
    [ react => [ qw(FC L) ], sub {
        $_[0]->but_add($_[1])
      } ],
    [ 'cut' ] ],

  [ contains_line => [ qw(P L) ],
    [ not => [ _contains_line => qw(P L) ] ],
    [ file_content_at => qw(FC P) ],
    [ act => [ qw(FC L) ], sub {
      DX::Lib::FS::Action::RewriteFile->new(
        from => $_[0],
      )->but_add($_[1])
    } ] ],

  [ not_contains_line => [ qw(P L) ],
    [ not => [ _contains_line => qw(P L) ] ] ],

  [ _arrange_removal_of => [ qw(FC L) ],
    [ has_action => qw(FC A) ],
    [ does => 'A' => \'DX::Lib::FS::Action::RewriteFile' ],
    [ react => [ qw(FC L) ], sub { $_[0]->but_remove($_[1]) } ] ],

  [ _arrange_removal_of => [ qw(FC L) ],
    [ act => [ qw(FC L) ], sub {
        DX::Lib::FS::Action::RewriteFile->new(
          from => $_[0],
        )->but_remove($_[1]);
      } ] ],

  [ not_contains_line => [ qw(P L) ],
    [ _contains_line => qw(P L) ],
    [ file_content_at => qw(FC P) ],
    [ _arrange_removal_of => qw(FC L) ],
    [ 'cut' ] ],

  [ file_in => [ qw(DirPath FileName FilePath) ],
    [ catfile => qw(DirPath FileName FilePath) ],
    [ is_directory => 'DirPath' ],
    [ is_file => 'FilePath' ] ],

  [ directory_in => [ qw(DirPath DirName SubdirPath) ],
    [ catdir => qw(DirPath DirName SubdirPath) ],
    [ is_directory => 'DirPath' ],
    [ is_directory => 'SubdirPath' ] ],

  [ env_dir => [ qw(ED) ],
    [ member_of => 'ED', \'env_dir' ] ],

  [ _env_dir_at => [ qw(ED P) ],
    [ env_dir => 'ED' ],
    [ prop => ED => \'path' => 'P' ] ],

  [ env_dir_at => [ qw(ED P) ],
    [ _env_dir_at => qw(ED P) ],
    [ 'cut' ] ],

  [ env_dir_at => [ 'ED', 'P' ],
    [ observe => [ 'P' ], sub {
        DX::Lib::FS::Observation::EnvDir->new(
          path => $_[0]
        )
      } ],
    [ _env_dir_at => qw(ED P) ] ],

  [ home_dir_on => [ qw(A D) ],
    [ path_on => 'A', \'HOME', 'P' ],
    [ env_dir_at => ED => 'P' ],
    [ prop => ED => \'value' => 'H' ],
    [ path_on => 'A', 'H', 'D' ] ],
);

sub load_into {
  my ($self, $solver) = @_;
  $solver->facts->{path_status} = DX::SetOver->new(over => 'path');
  $solver->facts->{file_content} = DX::SetOver->new(over => 'path');
  $solver->facts->{env_dir} = DX::SetOver->new(over => 'path');
  $solver->add_predicate(
    catdir => [ qw(DirPath DirName SubDirPath) ],
      [ qw(+ + -) ] => sub {
        +(SubDirPath => [
           value => File::Spec->catdir($_{DirPath}, $_{DirName})
        ])
      },
      [ qw(- - +) ] => sub {
        my @split = File::Spec->splitdir($_{SubDirPath});
        my $last = pop @split;
        my $rest = File::Spec->catdir(@split);
        +(DirPath => [ value => $rest ], DirName => [ value => $last ])
      }
  );
  $solver->add_predicate(
    catfile => [ qw(DirPath FileName FilePath) ],
      [ qw(+ + -) ] => sub {
        my ($vol, $dir) = File::Spec->splitpath($_{DirPath}, 1);
        my $file_path = File::Spec->catpath($vol, $dir, $_{FileName});
        +(FilePath => [ value => $file_path ])
      },
      [ qw(- - +) ] => sub {
        my ($vol, $dir, $file) = File::Spec->splitpath($_{FilePath});
        my $dir_path = File::Spec->catpath($vol, $dir);
        +(DirPath => [ value => $dir_path ], FileName => [ value => $file ])
      }
  );
  $solver->add_predicate(
    path_on => [ qw(On Path FullPath) ],
      [ qw(+ + -) ] => sub {
        (my $path = $_{Path}) =~ s/^(:!\/)/.\//;
        if ($_{On} eq '' or $_{On} eq 'localhost') {
          (FullPath => [ value => $path ])
        } else {
          (FullPath => [ value => join(':', $_{On}, $path) ])
        }
      },
      [ qw(- - +) ] => sub {
        if (my ($on, $path) = $_{FullPath} =~ /^([^\/]+):(.*)$/) {
          (On => [ value => $on ], Path => [ value => $path ]);
        } else {
          (On => [ value => 'localhost' ], Path => [ value => $_{FullPath} ]);
        }
      }
  );
  $solver->add_rule(
    does => [ qw(Thing RoleName) ],
      [ constrain => [ qw(Thing RoleName) ], sub { $_[0]->DOES($_[1]) } ]
  );
  $solver->add_rule(@$_) for @RULES;
}

1;