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