lib/DX/Lib/FS.pm

   1 package DX::Lib::FS;
   2
   3 use DX::Lib::FS::Observation::PathStatus;
   4 use DX::Lib::FS::Action::CreateDirectory;
   5 use DX::Lib::FS::Action::CreateFile;
   6 use DX::Lib::FS::Action::SetPathMode;
   7 use File::Spec;
   8 use DX::SetOver;
   9 use Moo;
  10
  11 our @RULES = (
  12   [ path_status => [ qw(PS) ],
  13     [ member_of => 'PS', \'path_status' ] ],
  14   [ path => [ qw(PS P) ],
  15     [ prop => 'PS', \'path', 'P' ] ],
  16   [ info_prop => [ qw(PS N V) ],
  17     [ exists => [ qw(PSI) ],
  18       [ prop => 'PS', \'info', 'PSI' ],
  19       [ prop => 'PSI', 'N', 'V' ] ] ],
  20   [ mode => [ qw(PS M) ],
  21     [ info_prop => 'PS', \'mode', 'M' ] ],
  22   [ exists_path => [ qw(PS) ],
  23     [ info_prop => 'PS', \'is_directory', \1 ] ],
  24   [ exists_path => [ qw(PS) ],
  25     [ info_prop => 'PS', \'is_file', \1 ] ],
  26   [ is_directory => [ qw(PS) ],
  27     [ info_prop => 'PS', \'is_directory', \1 ] ],
  28   [ is_file => [ qw(PS) ],
  29     [ info_prop => 'PS', \'is_file', \1 ] ],
  30   [ path_status_at => [ 'PS', 'P' ],
  31     [ path_status => 'PS' ],
  32     [ path => qw(PS P) ],
  33     [ 'cut' ] ],
  34   [ path_status_at => [ 'PS', 'P' ],
  35     [ observe => [ 'P' ], sub {
  36         DX::Lib::FS::Observation::PathStatus->new(
  37           path => $_[0]
  38         )
  39       } ],
  40     [ path_status => 'PS' ],
  41     [ path => qw(PS P) ] ],
  42   [ directory_at => [ qw(PS P) ],
  43     [ path_status_at => qw(PS P) ],
  44     [ is_directory => 'PS' ] ],
  45   [ file_at => [ qw(PS P) ],
  46     [ path_status_at => qw(PS P) ],
  47     [ is_file => 'PS' ] ],
  48   [ is_directory => [ qw(PS) ],
  49     [ not => [ exists_path => 'PS' ] ],
  50     [ act => [ 'PS' ], sub {
  51         DX::Lib::FS::Action::CreateDirectory->new(
  52           path => $_[0]->path
  53         )
  54       } ] ],
  55   [ is_file => [ qw(PS) ],
  56     [ not => [ exists_path => 'PS' ] ],
  57     [ act => [ 'PS' ], sub {
  58         DX::Lib::FS::Action::CreateFile->new(
  59           path => $_[0]->path
  60         )
  61       } ] ],
  62   [ directory_in => [ qw(DirStatus DirName SubDirStatus) ],
  63     [ is_directory => qw(DirStatus) ],
  64     [ exists => [ qw(DirPath) ],
  65       [ path => qw(DirStatus DirPath) ],
  66       [ exists => [ qw(SubDirPath) ],
  67         [ catfile => qw(DirPath DirName SubDirPath) ],
  68         [ directory_at => qw(SubDirStatus SubDirPath) ] ] ] ],
  69   [ file_in => [ qw(DirStatus FileName FileStatus) ],
  70     [ is_directory => qw(DirStatus) ],
  71     [ exists => [ qw(DirPath) ],
  72       [ path => qw(DirStatus DirPath) ],
  73       [ exists => [ qw(FilePath) ],
  74         [ catfile => qw(DirPath FileName FilePath) ],
  75         [ file_at => qw(FileStatus FilePath) ] ] ] ],
  76   [ mode => [ qw(PS M) ],
  77     [ exists => [ qw(A) ],
  78       [ has_action => qw(PS A) ],
  79       [ does => 'A', \'DX::Lib::FS::Action::CreateDirectory' ],
  80       [ react => [ qw(PS M) ], sub {
  81           $_[0]->but(mode => $_[1]);
  82         } ] ],
  83       [ 'cut' ] ],
  84   [ mode => [ qw(PS M) ],
  85     [ exists => [ qw(A) ],
  86       [ has_action => qw(PS A) ],
  87       [ does => 'A', \'DX::Lib::FS::Action::CreateFile' ],
  88       [ react => [ qw(PS M) ], sub {
  89           $_[0]->but(mode => $_[1]);
  90         } ] ],
  91       [ 'cut' ] ],
  92   [ mode => [ qw(PS M) ],
  93     [ exists_path => qw(PS) ],
  94     [ not => [ info_prop => 'PS', \'mode', 'M' ] ],
  95     [ act => [ qw(PS M) ], sub {
  96        DX::Lib::FS::Action::SetPathMode->new(
  97          path_status => $_[0], mode => $_[1]
  98        )
  99     } ] ],
 100 );
 101
 102 sub load_into {
 103   my ($self, $solver) = @_;
 104   $solver->facts->{path_status} = DX::SetOver->new(over => 'path');
 105   $solver->add_predicate(
 106     catdir => [ qw(DirPath DirName SubDirPath) ],
 107       [ qw(+ + -) ] => sub {
 108         +(SubDirPath => [
 109            value => File::Spec->catdir($_{DirPath}, $_{DirName})
 110         ])
 111       },
 112       [ qw(- - +) ] => sub {
 113         my @split = File::Spec->splitdir($_{SubDirPath});
 114         my $last = pop @split;
 115         my $rest = File::Spec->catdir(@split);
 116         +(DirPath => [ value => $rest ], DirName => [ value => $last ])
 117       }
 118   );
 119   $solver->add_predicate(
 120     catfile => [ qw(DirPath FileName FilePath) ],
 121       [ qw(+ + -) ] => sub {
 122         my ($vol, $dir) = File::Spec->splitpath($_{DirPath}, 1);
 123         my $file_path = File::Spec->catpath($vol, $dir, $_{FileName});
 124         +(FilePath => [ value => $file_path ])
 125       },
 126       [ qw(- - +) ] => sub {
 127         my ($vol, $dir, $file) = File::Spec->splitpath($_{FilePath});
 128         my $dir_path = File::Spec->catpath($vol, $dir);
 129         +(DirPath => [ value => $dir_path ], FileName => [ value => $file ])
 130       }
 131   );
 132   $solver->add_rule(
 133     does => [ qw(Thing RoleName) ],
 134       [ constrain => [ qw(Thing RoleName) ], sub { $_[0]->DOES($_[1]) } ]
 135   );
 136   $solver->add_rule(@$_) for @RULES;
 137 }
 138
 139 1;