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 DX::Lib::FS::Observation::FileContent;
   8 use DX::Lib::FS::Action::RewriteFile;
   9 use File::Spec;
  10 use DX::SetOver;
  11 use Moo;
  12
  13 our @RULES = (
  14   [ path_status => [ qw(PS) ],
  15     [ member_of => 'PS', \'path_status' ] ],
  16   [ path => [ qw(PS P) ],
  17     [ prop => 'PS', \'path', 'P' ] ],
  18   [ info_prop => [ qw(PS N V) ],
  19     [ exists => [ qw(PSI) ],
  20       [ prop => 'PS', \'info', 'PSI' ],
  21       [ prop => 'PSI', 'N', 'V' ] ] ],
  22   [ mode => [ qw(PS M) ],
  23     [ info_prop => 'PS', \'mode', 'M' ] ],
  24   [ exists_path => [ qw(PS) ],
  25     [ info_prop => 'PS', \'is_directory', \1 ] ],
  26   [ exists_path => [ qw(PS) ],
  27     [ info_prop => 'PS', \'is_file', \1 ] ],
  28   [ is_directory => [ qw(PS) ],
  29     [ info_prop => 'PS', \'is_directory', \1 ] ],
  30   [ is_file => [ qw(PS) ],
  31     [ info_prop => 'PS', \'is_file', \1 ] ],
  32   [ path_status_at => [ 'PS', 'P' ],
  33     [ path_status => 'PS' ],
  34     [ path => qw(PS P) ],
  35     [ 'cut' ] ],
  36   [ path_status_at => [ 'PS', 'P' ],
  37     [ observe => [ 'P' ], sub {
  38         DX::Lib::FS::Observation::PathStatus->new(
  39           path => $_[0]
  40         )
  41       } ],
  42     [ path_status => 'PS' ],
  43     [ path => qw(PS P) ] ],
  44   [ directory_at => [ qw(PS P) ],
  45     [ path_status_at => qw(PS P) ],
  46     [ is_directory => 'PS' ] ],
  47   [ file_at => [ qw(PS P) ],
  48     [ path_status_at => qw(PS P) ],
  49     [ is_file => 'PS' ] ],
  50   [ is_directory => [ qw(PS) ],
  51     [ not => [ exists_path => 'PS' ] ],
  52     [ act => [ 'PS' ], sub {
  53         DX::Lib::FS::Action::CreateDirectory->new(
  54           path => $_[0]->path
  55         )
  56       } ] ],
  57   [ is_file => [ qw(PS) ],
  58     [ not => [ exists_path => 'PS' ] ],
  59     [ act => [ 'PS' ], sub {
  60         DX::Lib::FS::Action::CreateFile->new(
  61           path => $_[0]->path
  62         )
  63       } ] ],
  64   [ directory_in => [ qw(DirStatus DirName SubDirStatus) ],
  65     [ is_directory => qw(DirStatus) ],
  66     [ exists => [ qw(DirPath) ],
  67       [ path => qw(DirStatus DirPath) ],
  68       [ exists => [ qw(SubDirPath) ],
  69         [ catfile => qw(DirPath DirName SubDirPath) ],
  70         [ directory_at => qw(SubDirStatus SubDirPath) ] ] ] ],
  71   [ file_in => [ qw(DirStatus FileName FileStatus) ],
  72     [ is_directory => qw(DirStatus) ],
  73     [ exists => [ qw(DirPath) ],
  74       [ path => qw(DirStatus DirPath) ],
  75       [ exists => [ qw(FilePath) ],
  76         [ catfile => qw(DirPath FileName FilePath) ],
  77         [ file_at => qw(FileStatus FilePath) ] ] ] ],
  78   [ mode => [ qw(PS M) ],
  79     [ exists => [ qw(A) ],
  80       [ has_action => qw(PS A) ],
  81       [ does => 'A', \'DX::Lib::FS::Action::CreateDirectory' ],
  82       [ react => [ qw(PS M) ], sub {
  83           $_[0]->but(mode => $_[1]);
  84         } ] ],
  85       [ 'cut' ] ],
  86   [ mode => [ qw(PS M) ],
  87     [ exists => [ qw(A) ],
  88       [ has_action => qw(PS A) ],
  89       [ does => 'A', \'DX::Lib::FS::Action::CreateFile' ],
  90       [ react => [ qw(PS M) ], sub {
  91           $_[0]->but(mode => $_[1]);
  92         } ] ],
  93       [ 'cut' ] ],
  94   [ mode => [ qw(PS M) ],
  95     [ exists_path => qw(PS) ],
  96     [ not => [ info_prop => 'PS', \'mode', 'M' ] ],
  97     [ act => [ qw(PS M) ], sub {
  98        DX::Lib::FS::Action::SetPathMode->new(
  99          path_status => $_[0], mode => $_[1]
 100        )
 101     } ] ],
 102   [ file_content => [ qw(FC) ],
 103     [ member_of => 'FC', \'file_content' ] ],
 104   [ file_content_at => [ qw(FC P) ],
 105     [ file_content => 'FC' ],
 106     [ path => qw(FC P) ],
 107     [ 'cut' ] ],
 108   [ file_content_at => [ qw(FC P) ],
 109     [ observe => [ 'P' ], sub {
 110         DX::Lib::FS::Observation::FileContent->new(
 111           path => $_[0]
 112         )
 113       } ],
 114     [ file_content => 'FC' ],
 115     [ path => qw(FC P) ] ],
 116   [ file_data => [ qw(FC D) ], [ prop => 'FC', \'data', 'D' ] ],
 117   [ file_content_line => [ qw(FC L) ],
 118     [ exists => [ 'Lines' ],
 119       [ prop => 'FC' => \'lines' => 'Lines' ],
 120       [ member_of => 'L' => 'Lines' ] ] ],
 121   [ contains_line => [ qw(PS L) ],
 122     [ is_file => 'PS' ],
 123     [ exists => [ qw(FC P) ],
 124       [ path => qw(PS P) ],
 125       [ file_content_at => qw(FC P) ],
 126       [ file_content_line => qw(FC L) ] ] ],
 127   [ file_content_line => [ qw(FC L) ],
 128     [ not =>
 129       [ exists => [ 'Lines' ],
 130         [ prop => 'FC' => \'lines' => 'Lines' ],
 131         [ member_of => 'L' => 'Lines' ] ] ],
 132     [ exists => [ 'A' ],
 133       [ has_action => qw(FC A) ],
 134       [ does => 'A' => \'DX::Lib::FS::Action::CreateFile' ] ],
 135     [ react => [ qw(FC L) ], sub {
 136         $_[0]->but(data => $_[0]->data.$_[1]."\n")
 137       } ],
 138     [ 'cut' ] ],
 139   [ file_content_line => [ qw(FC L) ],
 140     [ not =>
 141       [ exists => [ 'Lines' ],
 142         [ prop => 'FC' => \'lines' => 'Lines' ],
 143         [ member_of => 'L' => 'Lines' ] ] ],
 144     [ exists => [ 'A' ],
 145       [ has_action => qw(FC A) ],
 146       [ does => 'A' => \'DX::Lib::FS::Action::RewriteFile' ] ],
 147     [ react => [ qw(FC L) ], sub { $_[0]->but_add($_[1]) } ],
 148     [ 'cut' ] ],
 149   [ file_content_line => [ qw(FC L) ],
 150     [ not =>
 151       [ exists => [ 'Lines' ],
 152         [ prop => 'FC' => \'lines' => 'Lines' ],
 153         [ member_of => 'L' => 'Lines' ] ] ],
 154     [ act => [ qw(FC L) ], sub {
 155         DX::Lib::FS::Action::RewriteFile->new(
 156           from => $_[0],
 157           add_lines => [ $_[1] ]
 158         );
 159       } ],
 160     [ 'cut' ] ],
 161   [ not_file_content_line => [ qw(FC L) ],
 162     [ not =>
 163       [ exists => [ 'Lines' ],
 164         [ prop => 'FC' => \'lines' => 'Lines' ],
 165         [ member_of => 'L' => 'Lines' ] ] ] ],
 166   [ not_contains_line => [ qw(PS L) ],
 167     [ is_file => 'PS' ],
 168     [ exists => [ qw(FC P) ],
 169       [ path => qw(PS P) ],
 170       [ file_content_at => qw(FC P) ],
 171       [ not_file_content_line => qw(FC L) ] ] ],
 172   [ not_file_content_line => [ qw(FC L) ],
 173     [ exists => [ 'Lines' ],
 174       [ prop => 'FC' => \'lines' => 'Lines' ],
 175       [ member_of => 'L' => 'Lines' ] ],
 176     [ exists => [ 'A' ],
 177       [ has_action => qw(FC A) ],
 178       [ does => 'A' => \'DX::Lib::FS::Action::RewriteFile' ] ],
 179     [ react => [ qw(FC L) ], sub { $_[0]->but_remove($_[1]) } ],
 180     [ 'cut' ] ],
 181   [ not_file_content_line => [ qw(FC L) ],
 182     [ exists => [ 'Lines' ],
 183       [ prop => 'FC' => \'lines' => 'Lines' ],
 184       [ member_of => 'L' => 'Lines' ] ],
 185     [ act => [ qw(FC L) ], sub {
 186         DX::Lib::FS::Action::RewriteFile->new(
 187           from => $_[0],
 188           remove_lines => { $_[1] => 1 }
 189         );
 190       } ],
 191     [ 'cut' ] ],
 192 );
 193
 194 sub load_into {
 195   my ($self, $solver) = @_;
 196   $solver->facts->{path_status} = DX::SetOver->new(over => 'path');
 197   $solver->facts->{file_content} = DX::SetOver->new(over => 'path');
 198   $solver->add_predicate(
 199     catdir => [ qw(DirPath DirName SubDirPath) ],
 200       [ qw(+ + -) ] => sub {
 201         +(SubDirPath => [
 202            value => File::Spec->catdir($_{DirPath}, $_{DirName})
 203         ])
 204       },
 205       [ qw(- - +) ] => sub {
 206         my @split = File::Spec->splitdir($_{SubDirPath});
 207         my $last = pop @split;
 208         my $rest = File::Spec->catdir(@split);
 209         +(DirPath => [ value => $rest ], DirName => [ value => $last ])
 210       }
 211   );
 212   $solver->add_predicate(
 213     catfile => [ qw(DirPath FileName FilePath) ],
 214       [ qw(+ + -) ] => sub {
 215         my ($vol, $dir) = File::Spec->splitpath($_{DirPath}, 1);
 216         my $file_path = File::Spec->catpath($vol, $dir, $_{FileName});
 217         +(FilePath => [ value => $file_path ])
 218       },
 219       [ qw(- - +) ] => sub {
 220         my ($vol, $dir, $file) = File::Spec->splitpath($_{FilePath});
 221         my $dir_path = File::Spec->catpath($vol, $dir);
 222         +(DirPath => [ value => $dir_path ], FileName => [ value => $file ])
 223       }
 224   );
 225   $solver->add_rule(
 226     does => [ qw(Thing RoleName) ],
 227       [ constrain => [ qw(Thing RoleName) ], sub { $_[0]->DOES($_[1]) } ]
 228   );
 229   $solver->add_rule(@$_) for @RULES;
 230 }
 231
 232 1;