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