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